DIRECTORY
Buttons USING [Create],
CedarProcess USING [Process],
Commander USING [CommandObject, Handle],
CommandTool USING [CopyAList],
Containers USING [ChildXBound, Create],
ImagerFont USING [Find, Font],
IO USING [PutF, PutRope, STREAM, Value],
IOClasses USING [CreateDribbleOutputStream],
Labels USING [Create],
List USING [Assoc, PutAssoc],
MakeDo USING [ActionRep, EnumerateResults, NodeRep, UncurrentProducer],
MakeDoBasics USING [CheckIn, EndFork, Execution, InnerSuspectNodeChange, NeedToFinish, processToExecution, ProcRef, ProcRefRep, RegisterReporter, Reporter, ReporterRep, SetES],
MakeDoPrivate USING [ActionRep, AddFailedCmd, icons, NodeClassRep, NodeRep],
Menus USING [MouseButton],
MessageWindow USING [Append, Blink],
MoreIOClasses USING [CreateBuffer, SendBuffer],
PBasics USING [IsBound],
Process USING [Abort, Detach, InvalidProcess],
RefTab,
Rope USING [ROPE, SkipTo, Substr],
SummonerMonitor USING [RegisterViewingClient, ServiceSpec, UnregisterViewingClient, ViewingClient, ViewingClientPrivate],
TypeScript USING [Create],
UserProfile USING [Boolean, CallWhenProfileChanges, ProfileChangeReason],
ViewerClasses USING [Viewer, ViewerRec],
ViewerEvents USING [RegisterEventProc, ViewerEvent],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [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 ← TypeScript.Create[
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, CommandTool.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;
};
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];
MessageWindow.Append[message: "command execution abandoned", clearFirst: TRUE];
}
ELSE MessageWindow.Append[message: "command execution already finishing", clearFirst: TRUE];
}};
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!)";
MessageWindow.Append[message: message, clearFirst: TRUE];
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 {
MessageWindow.Append["Can't delete 'cause still in use. Tried STOP! ? Tried abandoning?", TRUE];
MessageWindow.Blink[];
abort ← TRUE;
};
};
Msg:
-- PUBLIC --
ENTRY
PROC [ch: Commander.Handle, format:
ROPE, v1, v2, v3, v4, v5:
IO.Value ← [null[]]] = {
ENABLE UNWIND => NULL;
ch.out.PutF[format, 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 PBasics.IsBound[LOOPHOLE[ViewerOps.FindViewer]] THEN RETURN;
stopFont ← ImagerFont.Find["Xerox/TiogaFonts/TimesRoman18"];
UserProfile.CallWhenProfileChanges[TrackProfile];
MakeDoBasics.RegisterReporter[$VIEWERS, reporterOnViewers];
};