<<>> <> <> <> <> <> <> <> <> <> 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], <> <> ViewerClasses USING [Viewer], ViewerEvents USING [RegisterEventProc, ViewerEvent], ViewerIO USING [CreateViewerStreams], ViewerOps USING [CreateViewer, DestroyViewer, FindViewer, MoveViewer, PaintViewer]; MakeDoReportOnViewers: CEDAR MONITOR IMPORTS Basics, Buttons, Containers, ImagerFont, IO, IOClasses, List, MakeDo, MakeDoBasics, MakeDoPrivate, MoreIOClasses, Process, RefTab, SimpleFeedback, ViewerEvents, ViewerIO, ViewerOps <> EXPORTS MakeDo <> <> = BEGIN OPEN MakeDo, MakeDoPrivate, MakeDoBasics; ROPE: TYPE = Rope.ROPE; NodeRep: PUBLIC TYPE = MakeDoPrivate.NodeRep; ActionRep: PUBLIC TYPE = MakeDoPrivate.ActionRep; NodeClassRep: PUBLIC TYPE = MakeDoPrivate.NodeClassRep; <> reporterOnViewers: MakeDoBasics.Reporter ~ NEW [MakeDoBasics.ReporterRep ¬ [ destroyAuxBox: DestroyAuxBox, auxBoxDestroyed: AuxBoxDestroyed, buffer: Buffer, msg: Msg, flush: Flush ]]; Viewer: TYPE = ViewerClasses.Viewer; ViewerExecutionViewer: TYPE ~ REF ViewerExecutionViewerRep; ViewerExecutionViewerRep: TYPE ~ RECORD [ ctr: Viewer ¬ NIL, -- container -- ts: Viewer ¬ NIL, -- typescript -- sv: Viewer ¬ NIL, -- stats viewer -- lab: Viewer ¬ NIL -- stats viewer -- ]; DestroyAuxBox: -- PUBLIC -- PROC ~ { TRUSTED {Process.Detach[FORK ViewerOps.DestroyViewer[auxBox]]}; }; AuxBoxDestroyed: -- PUBLIC -- PROC RETURNS [BOOL] ~ { IF auxBox = NIL THEN RETURN [TRUE]; RETURN [auxBox.destroyed] }; 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] ~ { <> 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; <> }; <<>> <> <> <> <> <<]];>> <> <> <> <> <> <> <<};>> <> <<};>> <> <> <> <> <<{exView: ViewerExecutionViewer ~ NARROW[e.view];>> <> <<{ctr: Viewer ~ exView.ctr;>> <> <> <> <> <> <> <<}}};>> <> <> <> <> <> <> <> <> <> <<};>> 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; }; <> <> <> <<};>> <> < NULL;>> <> <> <> <> <> <<};>> Start: PROC = { IF NOT Basics.IsBound[LOOPHOLE[ViewerOps.FindViewer]] THEN RETURN; stopFont ¬ ImagerFont.Find["Xerox/TiogaFonts/TimesRoman18"]; <> MakeDoBasics.RegisterReporter[$VIEWERS, reporterOnViewers]; }; Start[]; END.