DFInterfaceImpl.mesa
last edited by Levin on December 6, 1983 3:30 pm
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],
DFToolInternal
USING [
AcquireLog, DFTool, DFToolRecord, GetToolParameters, offScreenY, OpDefiner, Operation, OperationRecord, OpSpecificAction, OuterContainerWidth, Parameters, PrompterSeq, ReactToProfile, ReleaseLog],
DFUtilities USING [DateToRope],
Graphics USING [SetCP],
GraphicsOps USING [BitmapRef, BitmapRep, DrawBitmap],
IO USING [card, PutChar, PutF, PutFR, PutRope, rope, STREAM, time],
Labels USING [Create],
List USING [Assoc, PutAssoc],
Loader USING [BCDBuildTime],
Process USING [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, 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, Graphics, GraphicsOps, 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)
---- ---- ---- ---- ---- ---- ---- ----
PromptArray: TYPE = ARRAY [0..promptH) OF WORD;
promptW: NAT = 13;
promptH: NAT = 10;
prompt: GraphicsOps.BitmapRef =
NEW[GraphicsOps.BitmapRep ← [
base:
NEW [PromptArray ← [
001600B, 000700B, 00340B, 000160B, 177770B, 177770B, 000160B, 000340B, 000700B, 001600B]],
raster: (promptW + Basics.bitsPerWord - 1)/Basics.bitsPerWord,
width: promptW,
height: promptH
]];
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[]]];
};
---- ---- ---- ---- ---- ---- ---- ----
Interaction Stuff
---- ---- ---- ---- ---- ---- ---- ----
ResponseData: TYPE = RECORD [tool: DFTool, index: NAT];
OpsInteraction:
PUBLIC Ops.InteractionProc = {
tool: DFTool = NARROW[clientData];
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[tool.selectedOp.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 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 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 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 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] = {
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] = {
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] = {
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
Graphics.SetCP[context, tool.prompterSeq, 0];
GraphicsOps.DrawBitmap[
self: context, bitmap: prompt,
w: promptW, h: promptH,
xorigin: 0, yorigin: 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 = {
tool: DFTool = NARROW[clientData];
op: Tool.Operation = tool.selectedOp;
DoItEntry:
ENTRY
PROC [tool: DFTool] = {
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
};
IF op ~= NIL THEN DoItEntry[tool]
ELSE tool.feedback.PutRope["\NPlease select an operation first.\N"];
};
IdleNotifier: OpsQ.NotifierProc = {
IdleNotifierEntry:
ENTRY
PROC [tool: DFTool] = {
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 {
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: %d errors, %d warnings",
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];
tool.abortRequested ← TRUE;
IF mouseButton = blue THEN tool.opsQueue.Abort[];
ResponseSeen[tool]; -- wake up waiting operation, if any.
};
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.bottomMinHeight,
paint: FALSE
];
tool.height ← tool.inner.wy + op.optionsContainer.wh + tool.bottomMinHeight;
ViewerOps.SetOpenHeight[tool.outer, tool.height];
ViewerOps.ComputeColumn[ViewerOps.ViewerColumn[tool.outer]];
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"];
NewDFTool[iconic: TRUE];
END.