DFInterfaceImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
last edited by Levin on December 19, 1983 4:31 pm
Last Edited by: Spreitzer, May 21, 1985 10:37:01 am PDT
Doug Wyatt, May 16, 1986 5:14:35 pm PDT
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],
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;
-- ---- ---- ---- ---- ---- ---- ----
Global "Variables" (constant after init)
-- ---- ---- ---- ---- ---- ---- ----
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.";
-- ---- ---- ---- ---- ---- ---- ----
Configuration Parameters (private)
-- ---- ---- ---- ---- ---- ---- ----
maxOps: NAT = 10;
minFeedbackLines: NAT = 5;
interactionQuestionLines: NAT = 3;
-- ---- ---- ---- ---- ---- ---- ----
Tool Construction
-- ---- ---- ---- ---- ---- ---- ----
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];
};
-- ---- ---- ---- ---- ---- ---- ----
Interaction Stuff
-- ---- ---- ---- ---- ---- ---- ----
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];
};
-- ---- ---- ---- ---- ---- ---- ----
Button Action Procedures
-- ---- ---- ---- ---- ---- ---- ----
DoIt: Buttons.ButtonProc = {
Note: runs synchronously with Viewers' notifier to ensure atomicity with `SelectOperation'.
tool: DFTool = NARROW[clientData];
op: Tool.Operation = tool.selectedOp;
IF op ~= NIL THEN TRUSTED {Process.Detach[FORK DoItEntry[tool, op]]}
ELSE tool.feedback.PutRope["\NPlease select an operation first.\N"];
};
DoItEntry: ENTRY PROC [tool: DFTool, op: Tool.Operation] = {
Note: used to run synchronously with Viewers' notifier to ensure atomicity with `SelectOperation', but that's (a) impossible now because we don't want to wedge Viewers' notifier while waiting for DF-file to be saved, and (b) not needed, because we'll never reference tool.selectedOp --- we've got it sampled in op.
ENABLE UNWIND => NULL;
IF tool.startTime = BasicTime.nullGMT THEN {
herald: ROPE;
tool.startTime ← BasicTime.Now[];
herald ← IO.PutFR["\N%g at %t\N", IO.rope[op.definer.opAlias], IO.time[tool.startTime]];
tool.log ← Tool.AcquireLog[];
PostProgressMessage[tool, IO.PutFR["\NRunning at %t . . .", IO.time[tool.startTime]]];
tool.feedback.PutRope[herald];
IF tool.log ~= NIL THEN tool.log.PutRope[herald];
tool.unusualEnd ← NIL;
};
op.definer.proc[$doOp, op];
clean-up code appears in IdleNotifier
};
IdleNotifier: OpsQ.NotifierProc = {
IdleNotifierEntry: ENTRY PROC [tool: DFTool] = {
ENABLE UNWIND => NULL;
IF tool.opsQueue.Empty[] THEN {
Tool is really idle; any pending call of DoIt is hanging on the monitor.
msg: ROPE ← NIL;
tool.feedback.PutF["Time: %r\N",
IO.card[BasicTime.Period[from: tool.startTime, to: BasicTime.Now[]]]
];
Tool.ReleaseLog[tool.log];
IF tool.unusualEnd ~= NIL THEN {
OpIdToAlias: PROC [opID: OpsQ.RequestedOp] RETURNS [ROPE] = {
opTable: REF Tool.OpTable = tool.parameters.opTable;
FOR i: NAT IN [0..opTable.nOps) DO
IF opTable.ops[i].opID = opID THEN RETURN[opTable.ops[i].opAlias];
ENDLOOP;
RETURN["???"]
};
msg ← msg.Concat["The following terminated unusually:"];
FOR list: LIST OF REF OpsQ.OpTerminationInteraction ← tool.unusualEnd, list.rest UNTIL list = NIL DO
done: REF OpsQ.OpTerminationInteraction = list.first;
msg ← msg.Concat[
IO.PutFR["\N %g of %g: %d errors, %d warnings",
IO.rope[OpIdToAlias[done.op]], IO.rope[done.dfFile],
IO.card[done.errors], IO.card[done.warnings]]
];
ENDLOOP;
tool.unusualEnd ← NIL;
};
PostProgressMessage[tool, msg.Concat[idleMessage]];
tool.recursionDepth ← -1;
tool.abortRequested ← FALSE;
tool.log ← NIL;
tool.startTime ← BasicTime.nullGMT; -- indicate tool is idle
};
};
IdleNotifierEntry[NARROW[clientData]]
};
DoHelp: Buttons.ButtonProc = {
tool: DFTool = NARROW[clientData];
IF tool.selectedOp ~= NIL THEN tool.selectedOp.definer.proc[$doHelp, tool.selectedOp]
ELSE tool.feedback.PutRope["\NPlease select an operation first.\N"];
};
DoCommandLine: Buttons.ButtonProc = {
tool: DFTool = NARROW[clientData];
IF tool.selectedOp ~= NIL THEN tool.selectedOp.definer.proc[$makeCommandLine, tool.selectedOp]
ELSE tool.feedback.PutRope["\NPlease select an operation first.\N"];
};
AbortOperation: Buttons.ButtonProc = {
tool: DFTool = NARROW[clientData];
AbortOperationEntry: ENTRY PROC [tool: DFTool] = {
ENABLE UNWIND => NULL;
IF tool.startTime = BasicTime.nullGMT THEN RETURN; -- tool is idle
tool.abortRequested ← TRUE;
IF mouseButton = blue THEN tool.opsQueue.Abort[];
ResponseSeenInternal[tool]; -- wake up waiting operation, if any.
};
AbortOperationEntry[tool];
};
MakeDFTool: Buttons.ButtonProc = {
tool: DFTool = NARROW[clientData];
MakeDFToolInner: PROC = {NewDFTool[iconic: FALSE]};
ProcessProps.AddPropList[
List.PutAssoc[
key: $WorkingDirectory,
val: ViewerTools.GetContents[tool.wDir],
aList: NIL
],
MakeDFToolInner];
};
SelectOperation: Buttons.ButtonProc = {
Note: runs synchronously with Viewers' notifier to ensure atomicity with `DoIt'.
op: Tool.Operation = NARROW[clientData];
tool: DFTool = op.tool;
SelectOperationEntry: ENTRY PROC [tool: DFTool] = {
ENABLE UNWIND => NULL;
selected: Tool.Operation = tool.selectedOp;
IF selected = op THEN RETURN;
Get old options out of sight.
IF selected ~= NIL THEN {
ViewerOps.MoveViewer[
viewer: selected.optionsContainer,
x: 0, y: Tool.offScreenY,
w: selected.optionsContainer.ww, h: selected.optionsContainer.wh,
paint: FALSE
];
Buttons.SetDisplayStyle[selected.button, $BlackOnWhite];
};
tool.selectedOp ← op;
Buttons.SetDisplayStyle[op.button, $WhiteOnBlack];
Move typescript to proper place considering new options.
ViewerOps.MoveViewer[
viewer: tool.bottom,
x: 0, y: op.optionsContainer.wh,
w: tool.bottom.ww, h: tool.bottom.wy + tool.bottom.wh - op.optionsContainer.wh,
paint: FALSE
];
tool.height ← tool.inner.wy + op.optionsContainer.wh + tool.bottomMinHeight;
ViewerOps.SetOpenHeight[tool.outer, tool.height];
IF NOT tool.outer.iconic THEN ViewerOps.ComputeColumn[tool.outer.column];
Move new options into place (and paint).
ViewerOps.MoveViewer[
viewer: op.optionsContainer,
x: 0, y: 0,
w: op.optionsContainer.ww, h: op.optionsContainer.wh
];
};
SelectOperationEntry[tool];
};
SelectDFNames: Buttons.ButtonProc = {
Note: runs synchronously with Viewers' notifier to ensure than manipulation of `tool.dfNames' is atomic.
tool: DFTool = NARROW[clientData];
selection: REF ViewerTools.SelPosRec ← NIL;
SELECT TRUE FROM
mouseButton = blue => ViewerTools.SetContents[tool.dfNames, NIL];
ViewerTools.GetSelectedViewer[] = tool.dfNames => {
dfNames was previously selected, so we iterate through the prefixes.
NextName: PROC [this: ROPE, list: LIST OF ROPE] RETURNS [next: ROPE ← NIL] = {
IF list = NIL THEN RETURN;
FOR l: LIST OF ROPE ← list, l.rest UNTIL l = NIL DO
IF this.Equal[l.first, FALSE] THEN RETURN[IF l.rest = NIL THEN list.first ELSE l.rest.first]
ENDLOOP;
RETURN[list.first]
};
contents: ROPE ← ViewerTools.GetContents[tool.dfNames];
ViewerTools.SetContents[tool.dfNames,
contents ← NextName[contents, tool.parameters.dfNamePrefixes]];
selection ← NEW[ViewerTools.SelPosRec ← [start: contents.Length[], length: 0]];
};
ENDCASE;
ViewerTools.SetSelection[tool.dfNames, selection];
};
SelectWorkingDirectory: Buttons.ButtonProc = {
Note: runs synchronously with Viewers' notifier to ensure than manipulation of 'tool.wDir' is atomic.
tool: DFTool = NARROW[clientData];
IF mouseButton = blue THEN ViewerTools.SetContents[tool.wDir, NIL];
ViewerTools.SetSelection[tool.wDir, NIL];
};
-- ---- ---- ---- ---- ---- ---- ----
Initialization
-- ---- ---- ---- ---- ---- ---- ----
ViewerOps.RegisterViewerClass[$DFPrompter, dfPrompter];
UserProfile.CallWhenProfileChanges[Tool.ReactToProfile];
Commander.Register[key: "DFTool", proc: DFToolCommand, doc: "User interface to DF files"];
Commander.Register[key: "DeleteDFTools", proc: DeleteToolsCommand, doc: "Deletes all DFTools"];
END.