<<>>
    <<MakeDoReportOnViewers.Mesa>>
        <<Last tweaked by Mike Spreitzer on May 1, 1990 4:17:11 pm PDT>>
        <<Carl Hauser, April 11, 1985 3:43:34 pm PST>>
        <<Eduardo Pelegri-Llopart November 17, 1988 3:06:06 pm PST>>
        <<JKF January 11, 1989 10:32:14 am PST>>

    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];

    MakeDoReportOnViewers: CEDAR MONITOR
        IMPORTS Buttons, CommandTool, Containers, ImagerFont, IO, IOClasses, Labels, List, MakeDo, MakeDoBasics, MakeDoPrivate, 
        MessageWindow, MoreIOClasses, PBasics, Process, RefTab, Rope, SummonerMonitor, TypeScript, UserProfile, ViewerEvents, 
        ViewerIO, ViewerOps
        <<EXPORTS MakeDo, MakeDoBasics>>
        EXPORTS MakeDo
        <<INVARIANT>>
            <<The integrity of the aux box data structure.>>

    =
    BEGIN OPEN MakeDo, MakeDoPrivate, MakeDoBasics;

    ROPE: TYPE = Rope.ROPE;
    NodeRep: PUBLIC TYPE = MakeDoPrivate.NodeRep;
    ActionRep: PUBLIC TYPE = MakeDoPrivate.ActionRep;
    NodeClassRep: PUBLIC TYPE = MakeDoPrivate.NodeClassRep;
<<Viewer Manipulation>>
    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 _ 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];
            };

    Start[];

    END.