DIRECTORY
Basics USING [IsBound],
Buttons USING [Create],
CedarProcess USING [Process],
Commander USING [CommandObject, Handle],
Containers USING [ChildXBound, Create],
ImagerFont USING [Find, Font],
IO USING [PutF, PutFL, PutRope, STREAM, Value],
IOClasses USING [CreateDribbleOutputStream],
List USING [AList, Assoc, DotCons, PutAssoc],
MakeDo USING [ActionRep, EnumerateResults, NodeRep, UncurrentProducer],
MakeDoBasics USING [CheckIn, EndFork, Execution, InnerSuspectNodeChange, NeedToFinish, RegisterReporter, Reporter, ReporterRep, SetES],
MakeDoPrivate USING [ActionRep, AddFailedCmd, icons, NodeClassRep, NodeRep],
Menus USING [MouseButton],
MoreIOClasses USING [CreateBuffer, SendBuffer],
Process USING [Abort, Detach, InvalidProcess],
RefTab,
Rope USING [ROPE],
SimpleFeedback USING [Append, Blink],
SummonerMonitor USING [RegisterViewingClient, ServiceSpec, UnregisterViewingClient, ViewingClient, ViewingClientPrivate],
UserProfile USING [Boolean, CallWhenProfileChanges, ProfileChangeReason],
ViewerClasses USING [Viewer],
ViewerEvents USING [RegisterEventProc, ViewerEvent],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [CreateViewer, DestroyViewer, FindViewer, MoveViewer, PaintViewer];
CHTList: TYPE = RECORD [head, tail: CHList ¬ NIL];
CHList: TYPE = LIST OF Commander.Handle;
bufKey: ATOM = $MakeDoBuffer;
cKey: ATOM ~ $MakeDoForkedCommandContainer;
stopFont: ImagerFont.Font ¬ NIL;
auxBox: Viewer ¬ NIL;
auxHeight: INTEGER ¬ 60;
auxBoxBottom: INTEGER ¬ 0;
auxBoxList: CHTList ¬ [];
auxBoxOccupancy: NAT ¬ 0;
monitor: BOOL ¬ FALSE;
Buffer:
-- PUBLIC --
ENTRY
PROC [e: Execution] = {
ENABLE UNWIND => NULL;
ch: Commander.Handle ~ e.ch;
bufout: IO.STREAM = MoreIOClasses.CreateBuffer[];
ctr, stop, gush, abandon, ts: Viewer;
tsLeft: INTEGER;
this: CHList;
wasRight: BOOL;
view: ViewerExecutionViewer ¬ NEW [ViewerExecutionViewerRep];
IF wasRight ¬ (auxBox =
NIL
OR auxBox.destroyed)
THEN {
auxBoxOccupancy ¬ 0;
auxBox ¬ Containers.Create[info: [iconic: TRUE, name: "MakeDo", icon: icons[MIN[1, icons.length-1]], column: right]];
[] ¬ ViewerEvents.RegisterEventProc[DestroyGuard, destroy, auxBox, TRUE];
auxBoxBottom ¬ 0;
auxBoxList ¬ [];
};
view.ctr ¬ ctr ¬ Containers.Create[info: [parent: auxBox, wx: 0, wy: auxBoxBottom, ww: auxBox.cw, wh: auxHeight, border: FALSE, scrollable: FALSE], paint: FALSE];
Containers.ChildXBound[auxBox, ctr];
gush ¬ Buttons.Create[info: [parent: ctr, name: "?", wx: 0, wy: 0, ww: 18, wh: ctr.ch/3], proc: Gushit, clientData: e, font: stopFont, paint: FALSE];
stop ¬ Buttons.Create[info: [parent: ctr, name: "!", wx: 0, wy: gush.wh, ww: 18, wh: ctr.ch/3], proc: Stopit, clientData: e, font: stopFont, documentation: "ABORT this command execution", guarded: TRUE, paint: FALSE];
abandon ¬ Buttons.Create[info: [parent: ctr, name: "!!", wx: 0, wy: stop.wy+stop.wh, ww: 18, wh: (ctr.ch-stop.wy-stop.wh)], proc: Abandonit, clientData: e, font: stopFont, documentation: "Abandon this command execution", guarded: TRUE, paint: FALSE];
tsLeft ¬ stop.wx + stop.ww;
view.ts ¬ ts ¬ ViewerOps.CreateViewer[flavor: $Typescript,
info: [parent: ctr, wx: tsLeft, ww: ctr.cw-tsLeft, wy: 0, wh: ctr.ch],
paint: FALSE];
e.view ¬ view;
Containers.ChildXBound[ctr, ts];
auxBoxOccupancy ¬ auxBoxOccupancy + 1;
auxBox.icon ¬ icons[MIN[auxBoxOccupancy, icons.length-1]];
IF NOT auxBox.iconic THEN ViewerOps.PaintViewer[viewer: ctr, hint: all]
ELSE IF wasRight THEN NULL
ELSE ViewerOps.PaintViewer[viewer: auxBox, hint: all];
auxBoxBottom ¬ ctr.wy + ctr.wh;
e.bch ¬
NEW [Commander.CommandObject ¬ [
commandLine: "Shouldn't care",
propertyList: List.PutAssoc[cKey, ctr, List.PutAssoc[bufKey, bufout, CopyAList[ch.propertyList]]]
]];
[in: e.bch.in, out: e.bch.out] ¬ ViewerIO.CreateViewerStreams[name: "Jose Frink", viewer: ts];
e.bch.err ¬ e.bch.out ¬ IOClasses.CreateDribbleOutputStream[bufout, e.bch.out];
this ¬ LIST[e.bch];
IF auxBoxList.tail # NIL THEN auxBoxList.tail.rest ¬ this ELSE auxBoxList.head ¬ this;
auxBoxList.tail ¬ this;
e.es ¬ buffered;
};
CopyAList:
PROC [old: List.AList]
RETURNS [new: List.AList] ~ {
CopyAList copies the CONS cells of the list itself and also copies the DotCons cells which are the elements of the list. Because the DotCons cells are copied, one can change the key-value mappings in the new list without affecting the mappings in the old list. Because the CONS cells are copied, one can alter the list without affecting the old list.
tail: List.AList ¬ NIL;
new ¬ NIL;
UNTIL old =
NIL
DO
newItem: List.AList ¬ LIST[List.DotCons[key: old.first.key, val: old.first.val]];
IF tail = NIL THEN new ¬ newItem ELSE tail.rest ¬ newItem;
old ¬ old.rest;
tail ¬ newItem;
ENDLOOP;
ERROR CommanderOps.Failed["CommandTool.CopyAList is deimplemented"];
};
viewWithTS: SummonerMonitor.ViewingClient ~ NEW [SummonerMonitor.ViewingClientPrivate ← [
SupplyArgument: SupplyArgument,
NoteStart: NoteStart,
NoteStop: NoteStop
]];
SupplyArgument: PROC [vc: SummonerMonitor.ViewingClient, ss: SummonerMonitor.ServiceSpec] RETURNS [arg: ROPE ← NIL] ~ {
procRef: ProcRef ~ NEW [ProcRefRep ← [process: ss.process]];
e: Execution ~ NARROW[processToExecution.Fetch[procRef].val];
IF e#NIL THEN {
start: INT ~ e.a.cmd.SkipTo[0, " "];
arg ← e.a.cmd.Substr[start: start+1];
};
RETURN;
};
NoteStart: PROC [vc: SummonerMonitor.ViewingClient, ss: SummonerMonitor.ServiceSpec, CreateStatsViewer: PROC [viewerInit: ViewerClasses.ViewerRec ← [], paint: BOOL ← TRUE] RETURNS [statsViewer: Viewer]] RETURNS [key: REF ANY ← NIL] ~ {
procRef: ProcRef ~ NEW [ProcRefRep ← [process: ss.process]];
e: Execution ~ NARROW[processToExecution.Fetch[procRef].val];
IF e=NIL THEN RETURN [NIL];
{exView: ViewerExecutionViewer ~ NARROW[e.view];
IF (NOT e.forked) OR e.es#doing OR exView.sv#NIL THEN RETURN [NIL];
{ctr: Viewer ~ exView.ctr;
ts: Viewer ~ exView.ts;
exView.lab ← Labels.Create[info: [parent: ctr, wx: ts.wx, wy: 0, name: ss.server], paint: FALSE];
exView.sv ← CreateStatsViewer[[parent: ctr, wx: exView.lab.wx+exView.lab.ww, wy: 0, ww: ctr.cw-(exView.lab.wx+exView.lab.ww), wh: exView.lab.wh], FALSE];
Containers.ChildXBound[ctr, exView.sv];
ViewerOps.MoveViewer[ts, ts.wx, exView.lab.wh, ts.ww, auxHeight-exView.lab.wh, TRUE];
key ← e;
}}};
NoteStop: PROC [vc: SummonerMonitor.ViewingClient, key: REF ANY] ~ {
e: Execution ~ NARROW[key];
exView: ViewerExecutionViewer ~ NARROW[e.view];
ctr: Viewer ~ exView.ctr;
ts: Viewer ~ exView.ts;
IF NOT exView.sv.destroyed THEN ViewerOps.DestroyViewer[exView.sv, ts.destroyed];
IF NOT exView.lab.destroyed THEN ViewerOps.DestroyViewer[exView.lab, ts.destroyed];
IF NOT ts.destroyed THEN ViewerOps.MoveViewer[ts, ts.wx, 0, ts.ww, ctr.ch, TRUE];
exView.sv ← NIL;
};
Abandonit:
PROC [parent:
REF
ANY, clientData:
REF
ANY ¬
NIL, mouseButton: Menus.MouseButton ¬ red, shift:
BOOL ¬
FALSE, control:
BOOL ¬
FALSE]
--Buttons.ButtonProc-- ~ {
e: Execution ~ NARROW[clientData];
{OPEN e;
IF NeedToFinish[e]
THEN {
ENABLE
UNWIND => {
EndFork[e.resources];
Flush[e, TRUE, TRUE, a.cmd];
[] ¬ job.processes.Delete[process];
};
IF forked THEN Flush[e, TRUE, TRUE, a.cmd];
a.fails ¬ true;
AddFailedCmd[job, a];
EnumerateResults[a, InnerSuspectNodeChange];
CheckIn[job, goal, a, e.process];
SetES[e, final];
UncurrentProducer[goal];
SimpleFeedback.Append[$MakeDo, oneLiner, $info, "command execution abandoned" ];
}
ELSE SimpleFeedback.Append[$MakeDo, oneLiner, $info, "command execution already finishing"];
}};
Stopit:
PROC [parent:
REF
ANY, clientData:
REF
ANY ¬
NIL, mouseButton: Menus.MouseButton ¬ red, shift:
BOOL ¬
FALSE, control:
BOOL ¬
FALSE]
--Buttons.ButtonProc-- = {
e: Execution = NARROW[clientData];
message: ROPE ¬ "command execution ABORTed";
IF e.process #
NIL
AND e.process.status = busy
THEN
TRUSTED {Process.Abort[e.process.process !Process.InvalidProcess => {
message ¬
IF process#e.process.process THEN "Zowie! Bug 6 encountered!"
ELSE IF e.process.status=busy THEN "Wow! CedarProcess bug observed!"
ELSE "Already gone!";
CONTINUE;
}]}
ELSE message ¬
IF e.process =
NIL
THEN "Can't ABORT because it's not gotten started yet"
ELSE
SELECT e.process.status
FROM
done => "Can't ABORT because it's already done",
aborted => "Can't ABORT because it's already ABORTED",
debugging => "Won't ABORT because it's being debugged",
busy => "Wouldn't ABORT because it was not busy a few microseconds ago",
invalid => "Won't ABORT because it's invalid",
ENDCASE => "Won't ABORT because status unrecognized (I'm suffering software rot!)";
SimpleFeedback.Append[$MakeDo, oneLiner, $info, message];
RETURN};
Gushit:
PROC [parent:
REF
ANY, clientData:
REF
ANY ¬
NIL, mouseButton: Menus.MouseButton ¬ red, shift:
BOOL ¬
FALSE, control:
BOOL ¬
FALSE]
--Buttons.ButtonProc-- = {
button: Viewer ~ NARROW[parent];
e: Execution ~ NARROW[clientData];
e.gushMe ¬ TRUE;
ViewerOps.DestroyViewer[button];
};
DestroyGuard:
ENTRY
PROC [viewer: Viewer, event: ViewerEvents.ViewerEvent, before:
BOOL]
RETURNS [abort:
BOOL ¬
FALSE]
--ViewerEvents.EventProc-- = {
ENABLE UNWIND => NULL;
IF NOT before THEN ERROR;
IF viewer = auxBox
AND auxBoxList.head #
NIL
THEN {
SimpleFeedback.Append[$MakeDo, oneLiner, $info, "Can't delete 'cause still in use. Tried STOP! ? Tried abandoning?"];
SimpleFeedback.Blink[$MakeDo, $info];
abort ¬ TRUE;
};
};
Msg:
-- PUBLIC --
ENTRY
PROC [ch: Commander.Handle, format:
ROPE, v1, v2, v3, v4, v5:
IO.Value ¬ [null[]]] = {
ENABLE UNWIND => NULL;
ch.out.PutFL[format, LIST[v1, v2, v3, v4, v5]];
};
Flush:
-- PUBLIC --
ENTRY
PROC [e: Execution, long, abandon:
BOOL, asRope:
ROPE] = {
ENABLE UNWIND => NULL;
bch: Commander.Handle ~ e.bch;
ch: Commander.Handle ~ e.ch;
buffer: IO.STREAM = NARROW[List.Assoc[bufKey, bch.propertyList]];
exView: ViewerExecutionViewer ~ NARROW[e.view];
ctr: Viewer ~ exView.ctr;
last: CHList ¬ NIL;
IF abandon
THEN {
ch.out.PutF["%lAbandoning %g%l\n", [rope["be"]], [rope[asRope]], [rope["BE"]]];
MoreIOClasses.SendBuffer[buffer, ch.out, FALSE];
ch.out.PutRope["\n"];
}
ELSE IF long THEN MoreIOClasses.SendBuffer[buffer, ch.out, TRUE]
ELSE ch.out.PutF["%lDone with %g%l\n", [rope["e"]], [rope[asRope]], [rope["E"]]];
IF auxBox =
NIL
OR auxBox.destroyed
THEN {
auxBoxBottom ¬ 0;
auxBoxList ¬ [];
auxBoxOccupancy ¬ 0;
}
ELSE
FOR cur: CHList ¬ auxBoxList.head, cur.rest
WHILE cur #
NIL
DO
IF cur.first = bch
THEN {
auxBoxBottom ¬ ctr.wy;
IF last # NIL THEN last.rest ¬ cur.rest ELSE auxBoxList.head ¬ cur.rest;
IF cur = auxBoxList.tail
THEN {
IF cur.rest # NIL THEN ERROR;
auxBoxList.tail ¬ last;
};
ViewerOps.DestroyViewer[ctr, FALSE];
FOR rest: CHList ¬ cur.rest, rest.rest
WHILE rest #
NIL
DO
obch: Commander.Handle = rest.first;
ctr: Viewer = NARROW[List.Assoc[cKey, obch.propertyList]];
ViewerOps.MoveViewer[ctr, 0, auxBoxBottom, ctr.ww, ctr.wh, FALSE];
auxBoxBottom ¬ ctr.wy + ctr.wh;
ENDLOOP;
auxBoxOccupancy ¬ auxBoxOccupancy - 1;
auxBox.icon ¬ icons[MIN[auxBoxOccupancy, icons.length-1]];
ViewerOps.PaintViewer[auxBox, all];
EXIT;
};
last ¬ cur;
ENDLOOP;
};
TrackProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc-- = {
mon: BOOL ~ UserProfile.Boolean["MakeDo.MonitorSummoner", TRUE];
TRUSTED {Process.Detach[FORK SetMonitor[mon]]};
};
SetMonitor: ENTRY PROC [mon: BOOL] ~ {
ENABLE UNWIND => NULL;
IF mon=monitor THEN RETURN;
monitor ← mon;
IF NOT PBasics.IsBound[LOOPHOLE[SummonerMonitor.RegisterViewingClient]] THEN RETURN;
IF monitor THEN SummonerMonitor.RegisterViewingClient[viewWithTS]
ELSE SummonerMonitor.UnregisterViewingClient[viewWithTS];
};
Start:
PROC = {
IF NOT Basics.IsBound[LOOPHOLE[ViewerOps.FindViewer]] THEN RETURN;
stopFont ¬ ImagerFont.Find["Xerox/TiogaFonts/TimesRoman18"];
UserProfile.CallWhenProfileChanges[TrackProfile];
MakeDoBasics.RegisterReporter[$VIEWERS, reporterOnViewers];
};