
    <<File: FeedbackImpl.mesa>>
    <<Last edited by: Eric Bier on March 3, 1987 4:33:26 pm PST>>
    <<Contents: Routines for handling user error messages throughout Gargoyle.>>
        <<Pier, October 24, 1986 2:00:58 pm PDT>>
    <<>>
    DIRECTORY
        AtomButtonsTypes, Feedback, IO, Labels, MessageWindow, Process, Rope, ViewerClasses, ViewerIO, ViewerOps;

    FeedbackImpl: CEDAR PROGRAM
        IMPORTS IO, Labels, MessageWindow, Process, Rope, ViewerIO, ViewerOps
        EXPORTS Feedback = BEGIN

    Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE;

        MsgType: TYPE = Feedback.MsgType;
        Viewer: TYPE = ViewerClasses.Viewer;

    gScripts: LIST OF Script;
    Script: TYPE = REF ScriptObj;
    ScriptObj: TYPE = RECORD [
        viewer: Viewer,
        stream: IO.STREAM,
        atomName: ATOM
        ];
    FeedbackData: TYPE = REF FeedbackDataObj;
    FeedbackDataObj: TYPE = AtomButtonsTypes.FeedbackDataObj;
    typeAll: BOOL _ FALSE;

    <<IF feedback#NIL THEN PutF[feedback, oneLiner, "Gargoyle Typescript of %t", [time[BasicTime.Now[]]] ];>>
    <<ELSE IF feedback#NIL THEN Append[feedback, "Gargoyle Typescript already exists", oneLiner];>>

    FindScript: PROC [atomName: ATOM] RETURNS [script: Script _ NIL] = {
        FOR list: LIST OF Script _ gScripts, list.rest UNTIL list = NIL DO
            IF list.first.atomName = atomName THEN RETURN[list.first];
            ENDLOOP;
        };

    OpenTypescript: PUBLIC PROC [headerText: Rope.ROPE, atomName: ATOM, openHeight: NAT _ 120] RETURNS [alreadyExists: BOOL, 
    typescript: Viewer] = {
        script: Script _ FindScript[atomName];
        newStream: IO.STREAM;
        IF script=NIL OR script.viewer.destroyed THEN {
            typescript _ ViewerOps.CreateViewer[
                flavor: $TypeScript,
                info: [name: headerText, menu: NIL, data: NIL, iconic: TRUE, column: right, scrollable: TRUE, icon: unInit], paint: FALSE];
            ViewerOps.SetOpenHeight[typescript, openHeight];
            ViewerOps.OpenIcon[icon: typescript, closeOthers: FALSE, bottom: TRUE, paint: TRUE];
            [, newStream] _ ViewerIO.CreateViewerStreams[headerText, typescript, NIL, TRUE];
            };
        IF script=NIL THEN {
            newScript: Script _ NEW[ScriptObj _ [typescript, newStream, atomName]];
            gScripts _ CONS[newScript, gScripts];
            }
        ELSE IF script.viewer.destroyed THEN {
            script^ _ [typescript, newStream, atomName];
            };
        };

    GetTypescriptStream: PUBLIC PROC [atomName: ATOM] RETURNS [IO.STREAM] = {
        script: Script _ FindScript[atomName];
        IF script = NIL THEN RETURN[NIL];
        RETURN[script.stream];
        };

    RegisterFeedback: PUBLIC PROC [label: Viewer, atomName: ATOM] RETURNS [feedback: FeedbackData] = {
        feedback _ NEW[FeedbackDataObj _ [label, atomName]];
        };

    Append: PUBLIC PROC [feedback: FeedbackData, msg: Rope.ROPE, msgType: MsgType] = {
        AppendHerald[feedback, msg, msgType];
        AppendTypescript[feedback, msg, msgType];
        };

    AppendRaw: PUBLIC PROC [atomName: ATOM, msg: Rope.ROPE, msgType: MsgType] = {
        AppendHeraldRaw[atomName, msg, msgType];
        AppendTypescriptRaw[atomName, msg, msgType];
        };

    AppendHerald: PUBLIC PROC [feedback: FeedbackData, msg: Rope.ROPE, msgType: MsgType] = {
        clearHerald: BOOL _ msgType = oneLiner OR msgType = begin;
        addCR: BOOL _ msgType = oneLiner OR msgType = end;
        IF feedback = NIL THEN RETURN; -- this should only happen while the viewer is being created.
        BEGIN
            oldRope: Rope.ROPE _ NARROW[feedback.label.class.get[feedback.label]];
                IF Rope.Equal[msg, oldRope, FALSE] THEN RETURN; -- don't repeat messages
                IF clearHerald THEN Labels.Set[feedback.label, msg] ELSE Labels.Set[feedback.label, Rope.Concat[oldRope, msg]];
            END;
        IF typeAll THEN AppendTypescript[feedback, msg, msgType];
        };

    LastRope: PROC [ropes: LIST OF Rope.ROPE] RETURNS [last: Rope.ROPE] = {
        IF ropes = NIL THEN RETURN[NIL];
        FOR list: LIST OF Rope.ROPE _ ropes, list.rest UNTIL list = NIL DO
            last _ list.first;
            ENDLOOP;
        };

    AppendHeraldRaw: PUBLIC PROC [atomName: ATOM, msg: Rope.ROPE, msgType: MsgType] = {
        clearHerald: BOOL _ msgType = oneLiner OR msgType = begin;
        addCR: BOOL _ msgType = oneLiner OR msgType = end;
        oldRope: Rope.ROPE _ LastRope[MessageWindow.GetHistory[]];
        IF Rope.Equal[msg, oldRope, FALSE] THEN RETURN; -- don't repeat messages
        IF clearHerald THEN {
            MessageWindow.Clear[];
            MessageWindow.Append[msg];
            }
        ELSE MessageWindow.Append[msg];
        IF typeAll THEN AppendTypescriptRaw[atomName, msg, msgType];
        };


    Eq: PROC [x, y: Script] RETURNS[BOOL] = {RETURN[x = y]};

    DRemove: PUBLIC PROC [ref: Script, list: LIST OF Script] RETURNS[LIST OF Script] =  {
        l, l1: LIST OF Script _ NIL;
        l _ list;
        UNTIL l = NIL DO
            IF Eq[l.first, ref] THEN {
                IF l1 = NIL THEN RETURN[l.rest]; -- ref was first object on list
                l1.rest _ l.rest;
                RETURN[list];
                };
            l1 _ l;
            l _ l.rest;
            ENDLOOP;
        RETURN [list];
        }; -- of Dremove;

    AppendTypescript: PUBLIC PROC [feedback: FeedbackData, msg: Rope.ROPE, msgType: MsgType] = {
        clearHerald: BOOL _ msgType = oneLiner OR msgType = begin;
        addCR: BOOL _ msgType = oneLiner OR msgType = end;
        script: Script _ FindScript[feedback.atomName];
        stream: IO.STREAM;
        stream _ IF script = NIL THEN NIL ELSE script.stream;
        IF stream#NIL THEN { -- there is (was) a typescript
            ENABLE IO.Error => {
                IF ec#StreamClosed THEN {
                    IF feedback#NIL THEN {
                        Append[feedback, ". . . Serious typescript IO Error", oneLiner];
                        Blink[feedback];
                        };
                    };
                gScripts _ DRemove[script, gScripts];
                CONTINUE;
                };
            stream.PutF[msg]; -- try writing to typescript
            IF addCR THEN stream.PutChar[IO.CR];
            };
        };

    AppendTypescriptRaw: PUBLIC PROC [atomName: ATOM, msg: Rope.ROPE, msgType: MsgType] = {
        clearHerald: BOOL _ msgType = oneLiner OR msgType = begin;
        addCR: BOOL _ msgType = oneLiner OR msgType = end;
        script: Script _ FindScript[atomName];
        stream: IO.STREAM;
        stream _ IF script = NIL THEN NIL ELSE script.stream;
        IF stream#NIL THEN { -- there is (was) a typescript
            ENABLE IO.Error => {
                IF ec#StreamClosed THEN {
                    MessageWindow.Append[". . . Serious typescript IO Error"];
                    MessageWindow.Blink[];
                    };
                gScripts _ DRemove[script, gScripts];
                CONTINUE;
                };
            stream.PutF[msg]; -- try writing to typescript
            IF addCR THEN stream.PutChar[IO.CR];
            };
        };


    ClearHerald: PUBLIC PROC [feedback: FeedbackData] = {
        <<Remove any messages from the herald.>>
        IF feedback#NIL THEN Labels.Set[feedback.label, ""];
        };
    ClearHeraldRaw: PUBLIC PROC [atomName: ATOM] = {
        <<Remove any messages from the Message Window.>>
        MessageWindow.Clear[];
        };


    PutF: PUBLIC PROC [feedback: FeedbackData, msgType: MsgType, format: Rope.ROPE _ NIL, v1, v2, v3, v4, v5: IO.Value _ [null[]] ] = {
        msg: Rope.ROPE _ IO.PutFR[format, v1, v2, v3, v4, v5];
        Append[feedback, msg, msgType];
        };

    PutFRaw: PUBLIC PROC [atomName: ATOM, msgType: MsgType, format: Rope.ROPE _ NIL, v1, v2, v3, v4, v5: IO.Value _ [null[]] ] = {
        msg: Rope.ROPE _ IO.PutFR[format, v1, v2, v3, v4, v5];
        AppendRaw[atomName, msg, msgType];
        };

    PutFHerald: PUBLIC PROC [feedback: FeedbackData, msgType: MsgType, format: Rope.ROPE _ NIL, v1, v2, v3, v4, v5: IO.Value _ [null[]] 
    ] = {
        msg: Rope.ROPE _ IO.PutFR[format, v1, v2, v3, v4, v5];
        AppendHerald[feedback, msg, msgType];
        };

    PutFHeraldRaw: PUBLIC PROC [atomName: ATOM, msgType: MsgType, format: Rope.ROPE _ NIL, v1, v2, v3, v4, v5: IO.Value _ [null[]] ] = {
        msg: Rope.ROPE _ IO.PutFR[format, v1, v2, v3, v4, v5];
        AppendHeraldRaw[atomName, msg, msgType];
        };

    PutFTypescript: PUBLIC PROC [feedback: FeedbackData, msgType: MsgType, format: Rope.ROPE _ NIL, v1, v2, v3, v4, v5: IO.Value _ 
    [null[]] ]  = {
        msg: Rope.ROPE _ IO.PutFR[format, v1, v2, v3, v4, v5];
        AppendTypescript[feedback, msg, msgType];
        };

    PutFTypescriptRaw: PUBLIC PROC [atomName: ATOM, msgType: MsgType, format: Rope.ROPE _ NIL, v1, v2, v3, v4, v5: IO.Value _ [null[]] 
    ]  = {
        msg: Rope.ROPE _ IO.PutFR[format, v1, v2, v3, v4, v5];
        AppendTypescriptRaw[atomName, msg, msgType];
        };

    Blink: PUBLIC PROC [feedback: FeedbackData] = {
        IF feedback#NIL THEN {
            Labels.SetDisplayStyle[feedback.label, $WhiteOnBlack];
            Process.Pause[Process.MsecToTicks[150]];
            Labels.SetDisplayStyle[feedback.label, $BlackOnWhite];
            Process.Pause[Process.MsecToTicks[150]];
            Labels.SetDisplayStyle[feedback.label, $WhiteOnBlack];
            Process.Pause[Process.MsecToTicks[150]];
            Labels.SetDisplayStyle[feedback.label, $BlackOnWhite];
            };
        };

    BlinkRaw: PUBLIC PROC [atomName: ATOM] = {
        MessageWindow.Blink[];
        };

    END.