<> <> <> <> <> DIRECTORY Ascii USING [SP], Basics USING [bitsPerWord], BasicTime USING [Now, nullGMT, Period], Buttons USING [Button, ButtonProc, Create, SetDisplayStyle], Commander USING [CommandProc, Register], Containers USING [ChildXBound, ChildYBound, Container, Create], DFOperations USING [ChoiceInteraction, ChoiceResponse, Choices, DFInfoInteraction, FileInteraction, InfoInteraction, InteractionProc, YesNoInteraction, YesNoResponse], DFOperationsQueue USING [Abort, Create, Empty, NotifierProc, OpTerminationInteraction, RequestedOp], DFToolInternal USING [AcquireLog, DFTool, DFToolRecord, GetToolParameters, offScreenY, OpDefiner, Operation, OperationRecord, OpSpecificAction, OpTable, OuterContainerWidth, Parameters, PrompterSeq, ReactToProfile, ReleaseLog], DFUtilities USING [DateToRope], ImagerBackdoor USING [DrawBits], IO USING [card, PutChar, PutF, PutFR, PutRope, rope, STREAM, time], Labels USING [Create], List USING [Assoc, PutAssoc], Loader USING [BCDBuildTime], Process USING [Detach, MsecToTicks, SetTimeout], ProcessProps USING [AddPropList, GetPropList], Rope USING [Cat, Concat, Equal, Length, ROPE], Rules USING [Create, Rule], TypeScript USING [Create], UserProfile USING [CallWhenProfileChanges], VFonts USING [StringWidth], ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec], ViewerIO USING [CreateViewerStreams], ViewerOps USING [ComputeColumn, CreateViewer, DestroyViewer, EnumerateViewers, MoveViewer, OpenIcon, PaintViewer, RegisterViewerClass, SetOpenHeight, ViewerColumn], ViewerTools USING [GetContents, GetSelectedViewer, InhibitUserEdits, MakeNewTextViewer, SelPosRec, SetContents, SetSelection]; DFInterfaceImpl: CEDAR MONITOR LOCKS tool.LOCK USING tool: DFTool IMPORTS BasicTime, Buttons, Commander, Containers, DFOperationsQueue, DFToolInternal, DFUtilities, ImagerBackdoor, IO, Labels, List, Loader, Process, ProcessProps, Rope, Rules, TypeScript, UserProfile, VFonts, ViewerIO, ViewerOps, ViewerTools EXPORTS DFToolInternal = BEGIN OPEN Ops: DFOperations, OpsQ: DFOperationsQueue, Tool: DFToolInternal, Utils: DFUtilities; ROPE: TYPE = Rope.ROPE; <<>> DFTool: TYPE = Tool.DFTool; <<-- ---- ---- ---- ---- ---- ---- ---->> <> <<-- ---- ---- ---- ---- ---- ---- ---->> promptW: NAT = 13; promptH: NAT = 10; promptWpl: NAT ~ (promptW + Basics.bitsPerWord - 1)/Basics.bitsPerWord; PromptArray: TYPE = ARRAY [0..promptWpl*promptH) OF WORD; prompt: REF PromptArray ~ NEW[PromptArray _ [001600B, 000700B, 00340B, 000160B, 177770B, 177770B, 000160B, 000340B, 000700B, 001600B]]; dfPrompter: ViewerClasses.ViewerClass = NEW[ViewerClasses.ViewerClassRec _ [paint: PaintPrompter]]; idleMessage: ROPE = "\NIdle."; <<-- ---- ---- ---- ---- ---- ---- ---->> <> <<-- ---- ---- ---- ---- ---- ---- ---->> maxOps: NAT = 10; minFeedbackLines: NAT = 5; interactionQuestionLines: NAT = 3; <<-- ---- ---- ---- ---- ---- ---- ---->> <> <<-- ---- ---- ---- ---- ---- ---- ---->> DFToolCommand: Commander.CommandProc = {NewDFTool[iconic: TRUE]}; NewDFTool: PROC [iconic: BOOL] = { parameters: Tool.Parameters = Tool.GetToolParameters[]; tool: DFTool = NEW[Tool.DFToolRecord _ [parameters: parameters]]; firstOp: Tool.Operation _ NIL; AddSeparatingRule: PROC = { rule: Rules.Rule = Rules.Create[info: [ wx: 0, wy: tool.height, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: 1, parent: tool.outer ]]; Containers.ChildXBound[tool.outer, rule]; -- constrain rule to be width of parent tool.height _ tool.height + parameters.entryVSpace; -- spacing after rule }; BuildActions: PROC = { prev, rule: ViewerClasses.Viewer; heightForLabel: INT = tool.height; IF ~parameters.compactLayout THEN tool.height _ heightForLabel + parameters.entryHeight + parameters.entryVSpace; prev _ Buttons.Create[ info: [name: "Do It", wx: parameters.entryHSpace, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: TRUE ], proc: DoIt, fork: FALSE, clientData: tool, guarded: FALSE, font: parameters.font ]; prev _ Buttons.Create[ info: [name: "Help", wx: prev.wx + prev.ww + parameters.entryHSpace, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: TRUE ], proc: DoHelp, fork: FALSE, clientData: tool, guarded: FALSE, font: parameters.font ]; prev _ Buttons.Create[ info: [name: "Command Line", wx: prev.wx + prev.ww + parameters.entryHSpace, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: TRUE ], proc: DoCommandLine, fork: FALSE, clientData: tool, guarded: FALSE, font: parameters.font ]; prev _ Buttons.Create[ info: [name: "Stop!", wx: prev.wx + prev.ww + 2*parameters.entryHSpace, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: TRUE ], proc: AbortOperation, clientData: tool, guarded: FALSE, font: parameters.boldFont ]; IF ~parameters.compactLayout THEN { actionLabel: ROPE = "Action for Selected Operation"; [] _ Labels.Create[ info: [name: actionLabel, wx: (prev.wx + prev.ww + parameters.entryHSpace - VFonts.StringWidth[actionLabel])/2, wy: heightForLabel, wh: parameters.entryHeight, parent: tool.outer, border: FALSE ], font: parameters.boldFont ]; }; rule _ Rules.Create[info: [ wx: prev.wx + prev.ww + parameters.entryHSpace, wy: 0, ww: 1, wh: tool.height + parameters.entryHeight + parameters.entryVSpace, parent: tool.outer ]]; prev _ Buttons.Create[ info: [name: "New Tool", wx: rule.wx + rule.ww + 2*parameters.entryHSpace, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: TRUE ], proc: MakeDFTool, clientData: tool, guarded: FALSE, font: parameters.font ]; IF ~parameters.compactLayout THEN { miscLabel: ROPE = "Miscellaneous"; [] _ Labels.Create[ info: [name: miscLabel, wx: rule.wx + (Tool.OuterContainerWidth[tool] - rule.wx - VFonts.StringWidth[miscLabel])/2, wy: heightForLabel, wh: parameters.entryHeight, parent: tool.outer, border: FALSE ], font: parameters.boldFont ]; }; tool.height _ tool.height + parameters.entryHeight + parameters.entryVSpace; }; BuildOperations: PROC RETURNS [firstOp: Tool.Operation _ NIL] = { wDir: ROPE _ NARROW[List.Assoc[key: $WorkingDirectory, aList: ProcessProps.GetPropList[]]]; prev: ViewerClasses.Viewer; prevX: INT _ parameters.entryHSpace; IF wDir.Length[] = 0 THEN wDir _ "///"; tool.opsQueue _ OpsQ.Create[idleNotifier: IdleNotifier, clientData: tool]; tool.inner _ Containers.Create[info: [ wx: 0, wy: 0, -- to be recomputed by MoveViewer later ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: 9999, -- arbitrary; Containers.ChildYBound overrides parent: tool.outer, border: FALSE, scrollable: FALSE ]]; Containers.ChildXBound[container: tool.outer, child: tool.inner]; Containers.ChildYBound[container: tool.outer, child: tool.inner]; IF ~parameters.compactLayout THEN { operationsLabel: ROPE = "Operations (select one)"; [] _ Labels.Create[ info: [name: operationsLabel, wx: (Tool.OuterContainerWidth[tool] - VFonts.StringWidth[operationsLabel])/2, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: FALSE ], font: parameters.boldFont ]; tool.height _ tool.height + parameters.entryHeight + parameters.entryVSpace; }; FOR i: NAT IN [0..parameters.opTable.nOps) DO opDefiner: REF Tool.OpDefiner = parameters.opTable.ops[i]; IF opDefiner.userClass <= tool.parameters.userClass THEN { op: Tool.Operation = NEW[Tool.OperationRecord _ [tool: tool, definer: opDefiner]]; op.button _ Buttons.Create[ info: [name: opDefiner.opAlias, wx: prevX, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: TRUE ], proc: SelectOperation, fork: FALSE, clientData: op, font: parameters.font ]; IF op.button.wx + op.button.ww > Tool.OuterContainerWidth[tool] THEN ViewerOps.MoveViewer[ viewer: op.button, x: (prevX _ parameters.entryHSpace), y: (tool.height _ tool.height + parameters.entryHeight + parameters.entryVSpace), w: op.button.ww, h: op.button.wh, paint: FALSE ]; opDefiner.proc[$createOptions, op]; prevX _ parameters.entryHSpace + op.button.wx + op.button.ww; IF firstOp = NIL THEN firstOp _ op; }; ENDLOOP; tool.height _ tool.height + parameters.entryHeight + parameters.entryVSpace; prev _ Buttons.Create[ info: [name: "DF file(s):", wx: parameters.entryHSpace, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: FALSE ], proc: SelectDFNames, fork: FALSE, clientData: tool, font: parameters.font ]; tool.dfNames _ ViewerTools.MakeNewTextViewer[info: [ wx: prev.wx + prev.ww + parameters.entryHSpace, wy: tool.height, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: parameters.entryHeight, data: IF tool.parameters.dfNamePrefixes = NIL THEN NIL ELSE tool.parameters.dfNamePrefixes.first, parent: tool.outer, scrollable: TRUE, border: FALSE ]]; Containers.ChildXBound[container: tool.outer, child: tool.dfNames]; tool.height _ tool.height + parameters.entryHeight + parameters.entryVSpace; prev _ Buttons.Create[ info: [name: "Working Directory:", wx: parameters.entryHSpace, wy: tool.height, wh: parameters.entryHeight, parent: tool.outer, border: FALSE ], proc: SelectWorkingDirectory, fork: FALSE, clientData: tool, font: parameters.font ]; tool.wDir _ ViewerTools.MakeNewTextViewer[info: [ wx: prev.wx + prev.ww + parameters.entryHSpace, wy: tool.height, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: parameters.entryHeight, data: wDir, parent: tool.outer, scrollable: TRUE, border: FALSE ]]; Containers.ChildXBound[container: tool.outer, child: tool.dfNames]; tool.height _ tool.height + parameters.entryHeight + parameters.entryVSpace; AddSeparatingRule[]; ViewerOps.MoveViewer[ viewer: tool.inner, x: tool.inner.wx, y: tool.height, w: tool.inner.ww, h: tool.inner.wh, paint: FALSE ]; }; BuildInteraction: PROC = { h, ih: INT _ 0; v: ViewerClasses.Viewer; tool.bottom _ Containers.Create[info: [ wx: 0, wy: 0, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: 9999, -- arbitrary; Containers.ChildYBound overrides parent: tool.inner, border: FALSE, scrollable: FALSE ]]; Containers.ChildXBound[container: tool.inner, child: tool.bottom]; Containers.ChildYBound[container: tool.inner, child: tool.bottom]; v _ Rules.Create[info: [ wy: h, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: 1, parent: tool.bottom ]]; Containers.ChildXBound[tool.bottom, v]; -- constrain rule to be width of parent h _ h + parameters.entryVSpace; IF ~parameters.compactLayout THEN { interactionLabel: ROPE = "Confirmation Area"; [] _ Labels.Create[ info: [name: interactionLabel, wx: (Tool.OuterContainerWidth[tool] - VFonts.StringWidth[interactionLabel])/2, wy: h, wh: parameters.entryHeight, parent: tool.bottom, border: FALSE ], font: parameters.boldFont ]; h _ h + parameters.entryHeight + parameters.entryVSpace; }; tool.interaction _ Containers.Create[info: [ wx: 0, wy: h, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: 0, -- will be established by MoveViewer, later parent: tool.bottom, border: FALSE, scrollable: FALSE ]]; Containers.ChildXBound[container: tool.bottom, child: tool.interaction]; tool.question _ ViewerTools.MakeNewTextViewer[info: [ wx: 0, wy: ih, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: interactionQuestionLines*parameters.entryHeight, data: idleMessage, parent: tool.interaction, scrollable: TRUE, border: FALSE ]]; Containers.ChildXBound[container: tool.interaction, child: tool.question]; ViewerTools.InhibitUserEdits[tool.question]; ih _ ih + interactionQuestionLines*parameters.entryHeight + parameters.entryVSpace; v _ Buttons.Create[ info: [name: "Auto-Confirm", wx: parameters.entryHSpace, wy: ih, wh: parameters.entryHeight, parent: tool.interaction, border: TRUE ], proc: AutoConfirmButton, fork: FALSE, -- for atomic update/test of tool.autoConfirm clientData: tool, font: parameters.font ]; v _ tool.prompter _ ViewerOps.CreateViewer[ flavor: $DFPrompter, info: [ wx: v.wx + v.ww + parameters.entryHSpace, wy: ih + (IF parameters.entryHeight > promptH THEN (parameters.entryHeight - promptH)/2 ELSE 0), ww: promptW+Tool.PrompterSeq.LAST, wh: promptH, data: tool, parent: tool.interaction, scrollable: FALSE, border: FALSE ] ]; TRUSTED{Process.SetTimeout[@tool.responseMade, Process.MsecToTicks[90]]}; tool.choicesX _ v.wx + v.ww + parameters.entryHSpace; tool.choicesY _ ih + (IF parameters.entryHeight < promptH THEN (promptH - parameters.entryHeight)/2 ELSE 0); ih _ ih + MAX[parameters.entryHeight, promptH]; ViewerOps.MoveViewer[ viewer: tool.interaction, x: tool.interaction.wx, y: tool.interaction.wy, w: tool.interaction.ww, h: ih, paint: FALSE ]; h _ h + ih + parameters.entryVSpace; v _ Rules.Create[info: [ wy: h, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: 1, parent: tool.bottom ]]; Containers.ChildXBound[tool.bottom, v]; -- constrain rule to be width of parent h _ h + parameters.entryVSpace; IF ~parameters.compactLayout THEN { feedbackLabel: ROPE = "Session Log"; [] _ Labels.Create[ info: [name: feedbackLabel, wx: (Tool.OuterContainerWidth[tool] - VFonts.StringWidth[feedbackLabel])/2, wy: h, wh: parameters.entryHeight, parent: tool.bottom, border: FALSE ], font: parameters.boldFont ]; h _ h + parameters.entryHeight + parameters.entryVSpace; }; v _ TypeScript.Create[info: [ wx: 0, wy: h, ww: 9999, -- arbitrary; Containers.ChildXBound overrides wh: 9999, -- arbitrary; Containers.ChildYBound overrides parent: tool.bottom, border: FALSE ]]; ViewerTools.InhibitUserEdits[v]; Containers.ChildXBound[container: tool.bottom, child: v]; Containers.ChildYBound[container: tool.bottom, child: v]; tool.bottomMinHeight _ h _ h + minFeedbackLines*parameters.entryHeight + parameters.entryVSpace; tool.feedback _ ViewerIO.CreateViewerStreams[name: NIL, viewer: v].out; tool.height _ tool.height + h; }; <<***Main Body of NewDFTool***>> tool.outer _ Containers.Create[ info: [name: "DF Tool", iconic: TRUE, column: right, scrollable: FALSE], paint: iconic -- if ~iconic, we keep the icon from appearing at all ]; tool.height _ parameters.entryVSpace; BuildActions[]; AddSeparatingRule[]; firstOp _ BuildOperations[]; BuildInteraction[]; ViewerOps.SetOpenHeight[tool.outer, tool.height]; IF firstOp ~= NIL THEN SelectOperation[parent: firstOp.button, clientData: firstOp]; IF ~iconic THEN ViewerOps.OpenIcon[icon: tool.outer, bottom: FALSE]; tool.feedback.PutF["DFTool of %t\N", IO.time[Loader.BCDBuildTime[]]]; tool.feedback.PutF["Session began at %t\N", IO.time[BasicTime.Now[]]]; }; DeleteToolsCommand: Commander.CommandProc = { action: PROC [v: ViewerClasses.Viewer] RETURNS [continue: BOOL _ TRUE] = { IF Rope.Equal[v.name, "DF Tool"] THEN ViewerOps.DestroyViewer[v]; }; ViewerOps.EnumerateViewers[action]; }; <<-- ---- ---- ---- ---- ---- ---- ---->> <> <<-- ---- ---- ---- ---- ---- ---- ---->> ResponseData: TYPE = RECORD [tool: DFTool, index: NAT]; OpsInteraction: PUBLIC Ops.InteractionProc = { op: Tool.Operation = NARROW[clientData]; tool: DFTool = op.tool; buttonList: LIST OF Buttons.Button _ NIL; MakeChoiceButtons: PROC [tool: DFTool, choices: REF Ops.Choices] = { x: INT _ tool.choicesX; last: LIST OF Buttons.Button _ NIL; FOR i: NAT IN [0..choices.length) DO button: Buttons.Button _ Buttons.Create[ info: [name: choices[i], wx: x, wy: tool.choicesY, wh: tool.parameters.entryHeight, parent: tool.interaction, border: TRUE ], proc: ResponseButtonHit, clientData: NEW[ResponseData _ [tool: tool, index: i]], font: tool.parameters.font, paint: FALSE ]; buttonL: LIST OF Buttons.Button = CONS[button, NIL]; x _ button.wx + button.ww + tool.parameters.entryHSpace; IF last = NIL THEN buttonList _ buttonL ELSE last.rest _ buttonL; last _ buttonL; ENDLOOP; }; DestroyChoiceButtons: PROC [tool: DFTool] = { FOR l: LIST OF Buttons.Button _ buttonList, l.rest UNTIL l = NIL DO ViewerOps.DestroyViewer[viewer: l.first, paint: FALSE]; ENDLOOP; }; IF ~tool.abortRequested THEN { WITH interaction SELECT FROM info: REF Ops.InfoInteraction => { THROUGH [0..2*tool.recursionDepth) DO tool.feedback.PutChar[Ascii.SP]; ENDLOOP; tool.feedback.PutF["%g%g\N", IO.rope[ SELECT info.class FROM warning => "Warning: ", error => "Error: ", abort => "Abort: ", ENDCASE => NIL ], IO.rope[info.message] ]; }; info: REF Ops.DFInfoInteraction => { GetMessage: PROC RETURNS [ROPE] = { RETURN[ IF info.message = NIL THEN info.dfFile ELSE IO.PutFR["%g (%g)", IO.rope[info.dfFile], IO.rope[info.message]] ] }; SELECT info.action FROM $start => { IF (tool.recursionDepth _ tool.recursionDepth.SUCC) = 0 THEN PostProgressMessage[tool, Rope.Cat["\NWorking on ", info.dfFile, " . . ."]]; THROUGH [0..2*tool.recursionDepth) DO tool.feedback.PutChar[Ascii.SP]; ENDLOOP; tool.feedback.PutF["%g: %g\N", IO.rope[op.definer.opAlias], IO.rope[GetMessage[]] ]; }; $end => { THROUGH [0..2*tool.recursionDepth) DO tool.feedback.PutChar[Ascii.SP]; ENDLOOP; tool.feedback.PutF["End: %g\N", IO.rope[GetMessage[]]]; tool.recursionDepth _ tool.recursionDepth.PRED; }; $abort => { tool.feedback.PutF["Aborted: %g\N", IO.rope[GetMessage[]]]; tool.recursionDepth _ -1; }; ENDCASE; }; done: REF OpsQ.OpTerminationInteraction => { trouble: BOOL = done.errors + done.warnings ~= 0; tool.feedback.PutF["%d files %g%g\N", IO.card[done.filesActedUpon], IO.rope[ SELECT done.op FROM bringOver => "retrieved", sModel => "stored", verify => "checked", ENDCASE => NIL ], IO.rope[ IF trouble THEN IO.PutFR[" (with %d errors, %d warnings)", IO.card[done.errors], IO.card[done.warnings]] ELSE ", no errors" ] ]; IF trouble THEN tool.unusualEnd _ CONS[done, tool.unusualEnd]; }; file: REF Ops.FileInteraction => { THROUGH [0..2*tool.recursionDepth) DO tool.feedback.PutChar[Ascii.SP]; ENDLOOP; tool.feedback.PutF["%g %g %g {%g}%g\N", IO.rope[file.localFile], IO.rope[ SELECT file.action FROM $fetch => "<--", $store => "-->", $check => "<-->", ENDCASE => NIL], IO.rope[file.remoteFile], IO.rope[Utils.DateToRope[[$explicit, file.date]]], IO.rope[ IF file.dateFormat = $explicit THEN NIL ELSE IO.PutFR[" ('%g')", SELECT file.dateFormat FROM $greaterThan => [character['>]], $notEqual => [rope["~="]], ENDCASE => [null[]] ] ] ]; }; yn: REF Ops.YesNoInteraction => { oldContents: ROPE = ViewerTools.GetContents[tool.question]; choices: REF Ops.Choices _ NIL; yes: BOOL; IF ~yn.blunder AND tool.autoConfirm THEN RETURN; choices _ NEW[Ops.Choices[2]]; choices[0] _ "Yes"; choices[1] _ "No"; ViewerTools.SetContents[viewer: tool.question, contents: yn.message, paint: FALSE]; MakeChoiceButtons[tool, choices]; ViewerOps.PaintViewer[tool.interaction, $all]; yes _ WaitForResponse[tool] = 0; DestroyChoiceButtons[tool]; ViewerTools.SetContents[viewer: tool.question, contents: oldContents, paint: FALSE]; ViewerOps.PaintViewer[tool.interaction, $all]; IF ~yn.blunder AND tool.autoConfirm THEN RETURN; RETURN[response: NEW[Ops.YesNoResponse _ [yes]]] }; choice: REF Ops.ChoiceInteraction => { oldContents: ROPE = ViewerTools.GetContents[tool.question]; x: INT _ tool.choicesX; last: LIST OF Buttons.Button _ NIL; value: NAT; IF ~choice.blunder AND tool.autoConfirm THEN RETURN; ViewerTools.SetContents[viewer: tool.question, contents: choice.message, paint: FALSE]; MakeChoiceButtons[tool, choice.choices]; ViewerOps.PaintViewer[tool.interaction, $all]; value _ WaitForResponse[tool]; DestroyChoiceButtons[tool]; ViewerTools.SetContents[viewer: tool.question, contents: oldContents, paint: FALSE]; ViewerOps.PaintViewer[tool.interaction, $all]; IF ~choice.blunder AND tool.autoConfirm THEN RETURN; RETURN[response: NEW[Ops.ChoiceResponse _ [value]]] }; ENDCASE; }; IF tool.abortRequested THEN { abort _ TRUE; abortMessageForLog _ "(user generated)"; tool.abortRequested _ FALSE; }; }; ResponseButtonHit: Buttons.ButtonProc = { responseData: REF ResponseData = NARROW[clientData]; tool: DFTool = responseData.tool; ResponseSeen[tool, responseData.index]; }; AutoConfirmButton: Buttons.ButtonProc = { tool: DFTool = NARROW[clientData]; IF (tool.autoConfirm _ ~tool.autoConfirm) THEN { Buttons.SetDisplayStyle[NARROW[parent], $WhiteOnBlack]; ResponseSeen[tool]; } ELSE Buttons.SetDisplayStyle[NARROW[parent], $BlackOnWhite]; }; ResponseSeen: ENTRY PROC [tool: DFTool, value: NAT _ NAT.LAST] = { ENABLE UNWIND => NULL; ResponseSeenInternal[tool, value]; }; ResponseSeenInternal: INTERNAL PROC [tool: DFTool, value: NAT _ NAT.LAST] = { tool.responseValue _ value; tool.responseSeen _ TRUE; BROADCAST tool.responseMade; -- wakes up both prompter and main operation }; WaitForResponse: PROC [tool: DFTool] RETURNS [value: NAT] = { p: PROCESS; WaitForResponseEntry: ENTRY PROC [tool: DFTool] = { ENABLE UNWIND => NULL; tool.responseSeen _ FALSE; p _ FORK PrompterProcess[tool]; UNTIL tool.responseSeen DO WAIT tool.responseMade; ENDLOOP; value _ tool.responseValue; }; WaitForResponseEntry[tool]; TRUSTED{JOIN p}; }; PrompterProcess: PROC [tool: DFTool] = { Done: ENTRY PROC [tool: DFTool] RETURNS [BOOL] = { ENABLE UNWIND => NULL; WAIT tool.responseMade; RETURN[tool.responseSeen] }; UNTIL Done[tool] DO ViewerOps.PaintViewer[tool.prompter, all]; ENDLOOP; ViewerOps.PaintViewer[tool.prompter, all]; -- clears prompter entirely }; PaintPrompter: ViewerClasses.PaintProc = { tool: DFTool = NARROW[self.data]; IF ~tool.responseSeen THEN { -- strictly speaking, should be inside the monitor ImagerBackdoor.DrawBits[context: context, base: LOOPHOLE[prompt], wordsPerLine: promptWpl, fMin: 0, sMin: 0, fSize: promptW, sSize: promptH, tx: tool.prompterSeq, ty: promptH]; tool.prompterSeq _ (tool.prompterSeq + 2) MOD Tool.PrompterSeq.LAST.SUCC; }; }; PostProgressMessage: PROC [tool: DFTool, r: ROPE] = { ViewerTools.SetContents[tool.question, r]; }; <<-- ---- ---- ---- ---- ---- ---- ---->> <