
    <<XNSPSCommanderImpl.mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Tim Diebert: April 10, 1987 10:49:08 am PDT>>

    DIRECTORY
        Ascii USING [BS, ControlA, ControlQ, ControlW, ControlX, CR, DEL, Digit, Letter, SP],
        BasicTime USING [TimeNotKnown],
        Convert USING [Error, IntFromRope, RopeFromInt],
        IO USING [EndOfStream, EraseChar, GetChar, PutChar, PutF, PutRope, STREAM],
        Rope USING [Compare, Concat, Fetch, FromChar, Length, ROPE, Run, Substr],
        XNSPSCommander;

    XNSPSCommanderImpl: CEDAR PROGRAM
        IMPORTS Ascii, BasicTime, Convert, IO, Rope
        EXPORTS XNSPSCommander
        = BEGIN

        ROPE: TYPE = Rope.ROPE;
        STREAM: TYPE = IO.STREAM;


    <<********        Input subroutines        ********>>

        Rubout: PUBLIC ERROR = CODE;

        GetID: PUBLIC PROC [in, out: STREAM, default: ROPE, init: ROPE _ NIL, echo: BOOL _ TRUE] RETURNS [id: ROPE, c: CHAR] = {
            OPEN Ascii;
            firstTime: BOOL _ init = NIL;
            EraseAll: PROC = {
                IF echo THEN
                    FOR i: INT DECREASING IN [0..id.Length[]) DO IO.EraseChar[out, id.Fetch[i]]; ENDLOOP;
                id _ NIL;
                };
            Done: PROC [c: CHAR] RETURNS [BOOL] = INLINE {
                IF firstTime THEN {
                    SELECT c FROM
                        ControlA, BS, ControlQ, ControlW, ControlX, CR, SP, DEL => NULL;
                        ENDCASE => EraseAll[];
                    firstTime _ FALSE;
                    };
                RETURN [c = SP OR c = CR OR c = '?]
                };
            id _ Rope.Concat[init, default];
            IF echo THEN IO.PutRope[out, default];
            c _ IO.GetChar[in];
            UNTIL Done[c] DO
                SELECT c FROM
                    DEL => ERROR Rubout;
                    ControlA, BS => {
                        len: INT _ id.Length[];
                        IF len > 0 THEN {
                            len _ len - 1;
                            IF echo THEN IO.EraseChar[out, id.Fetch[len]];
                            id _ id.Substr[len: len];
                            };
                        };
                    ControlW, ControlQ => {
                        <<text to be backed up is of the form ...<non-alpha><alpha><non-alpha>, the <alpha> and following <non-alpha> are to be removed.>>
                        alpha: BOOL _ FALSE;
                        FOR i: INT DECREASING IN [0..id.Length[]) DO
                            ch: CHAR = id.Fetch[i];
                            IF Ascii.Letter[ch] OR Ascii.Digit[ch] THEN alpha _ TRUE
                            ELSE IF alpha THEN {id _ id.Substr[len: i + 1]; EXIT};
                            IF echo THEN IO.EraseChar[out, ch];
                            REPEAT
                                FINISHED => id _ NIL;
                            ENDLOOP;
                        };
                    ControlX => EraseAll[];
                    ENDCASE => {
                        id _ Rope.Concat[id, Rope.FromChar[c]];
                        IF echo THEN IO.PutChar[out, c];
                        };
                c _ IO.GetChar[in];
                ENDLOOP;
            };

        commandList: XNSPSCommander.CommandList _ NIL;

        RegisterCommand: PUBLIC PROC [info: XNSPSCommander.CommandInfo] = {
            <<... registers the command so it can be found again.>>
            new: XNSPSCommander.CommandList = LIST[info];
            lag: XNSPSCommander.CommandList _ NIL;
            FOR each: XNSPSCommander.CommandList _ commandList, each.rest WHILE each # NIL DO
                full: ROPE _ each.first.fullName;
                SELECT Rope.Compare[info.fullName, full, FALSE] FROM
                    less => {
                        <<Insert new command>>
                        new.rest _ each;
                        EXIT;
                        };
                    equal => {
                        <<Replace old command>>
                        each.first _ info;
                        RETURN;
                        };
                    ENDCASE;
                lag _ each;
                ENDLOOP;
            IF lag = NIL THEN commandList _ new ELSE lag.rest _ new;
            };

        GetCommandList: PUBLIC PROC RETURNS [XNSPSCommander.CommandList] = {
            RETURN [commandList];
            };

        GetCommand: PUBLIC PROC [in, out: STREAM]
        RETURNS [found: XNSPSCommander.CommandInfo] = {
            <<May raise Rubout>>
            prompt: ROPE = "\n> ";
            BoolFalse: TYPE = BOOL _ FALSE;
            prefix: ROPE _ NIL;
            IO.PutRope[out, prompt];
            DO
                end: CHAR;
                matches: { none, one, many } _ none;
                uniqueLength: INT;
                [id: prefix, c: end] _ GetID[in: in, out: out, default: NIL, init: prefix];
                uniqueLength _ prefix.Length[];
                IF end = '? THEN IO.PutChar[out, '?];
                FOR each: XNSPSCommander.CommandList _ commandList, each.rest WHILE each # NIL DO
                    c: XNSPSCommander.CommandInfo = each.first;
                    fullName: ROPE = c.fullName;
                    IF Rope.Run[s1: fullName, s2: prefix, case: FALSE] = prefix.Length[]
                        THEN {
                            IF matches = none
                                THEN {
                                    matches _ one;
                                    uniqueLength _ Rope.Length[fullName];
                                    found _ c;
                                    IF end = '? THEN IO.PutRope[out, " ... one of:\n"];
                                    }
                                ELSE {
                                    stillMatches: INT =
                                        Rope.Run[s1: fullName, s2: found.fullName, case: FALSE];
                                    uniqueLength _ MIN[uniqueLength, stillMatches];
                                    matches _ many;
                                    IF end = '? THEN IO.PutRope[out, ", "];
                                    };
                            IF end = '? THEN IO.PutRope[out, fullName];
                            };
                    ENDLOOP;
                IF end = '? AND matches # none
                    THEN { IO.PutRope[out, prompt]; IO.PutRope[out, prefix] }
                    ELSE {
                        IF uniqueLength = prefix.Length[]
                            THEN {
                                SELECT matches FROM
                                    none => IO.PutRope[out, " ... command not found"];
                                    one => EXIT;
                                    many => IF uniqueLength # 0 THEN IO.PutRope[out, " ... ambiguous"];
                                    ENDCASE => ERROR;
                                IO.PutRope[out, prompt]; IO.PutRope[out, prefix];
                                }
                            ELSE {
                                extra: ROPE = Rope.Substr[
                                    found.fullName, prefix.Length[], uniqueLength-prefix.Length[]];
                                IO.PutRope[out, extra];
                                SELECT matches FROM
                                    one => EXIT;
                                    many => prefix _ Rope.Concat[prefix, extra];
                                    ENDCASE => ERROR;
                                };
                        };
                ENDLOOP;
            };

        GetArg: PUBLIC PROC [in, out: STREAM, prompt, default: ROPE, help: PROC]
        RETURNS [value: ROPE _ NIL] = {
            DO
                end: CHAR;
                IO.PutRope[out, prompt];
                IO.PutRope[out, value];
                [id: value, c: end] _ GetID[in: in, out: out, default: default, init: value];
                default _ NIL;
                IF end = '? THEN help[] ELSE EXIT;
                ENDLOOP;
            };

        Confirm: PUBLIC PROC[in, out: STREAM] RETURNS [BOOL] = {
            DO c: CHAR = IO.GetChar[in];
                SELECT c FROM
                    'y, 'Y, Ascii.CR => { IO.PutRope[out, "yes"]; RETURN [TRUE] };
                    'n, 'N => { IO.PutRope[out, "no"]; RETURN [FALSE] };
                    Ascii.DEL => ERROR Rubout[];
                    ENDCASE =>
                        IO.PutRope[out, "?\nConfirm by typing \"Y\" or CR, deny by typing \"N\", abort by typing DEL: "];
                ENDLOOP;
            };


        GetNumber: PUBLIC PROC [in, out: STREAM, default: INT, max: INT _ LAST[INT], prompt, help: ROPE] RETURNS [size: INT _ 0] = {
            Help: PROC = { IO.PutRope[out, help] };
            sizeRope: ROPE _ Convert.RopeFromInt[default];
            DO
                ok: BOOL _ TRUE;
                size _ 0;
                sizeRope _ GetArg[ in: in, out: out, prompt: prompt, default: sizeRope, help: Help];
                size _ Convert.IntFromRope[sizeRope ! Convert.Error => { ok _ FALSE; CONTINUE } ];
                IF ~ok THEN { IO.PutRope[out, " ... not a number"]; LOOP };
                IF size <= max
                    THEN RETURN
                    ELSE IO.PutF[out, " ... number should be less than %g", [integer[max]] ];
                ENDLOOP;
            };

        ForceExit: ERROR = CODE;

        DoCommand: PROC [in, out: STREAM, c: XNSPSCommander.CommandInfo] RETURNS [exit: BOOL _ FALSE, overwritten: BOOL _ FALSE] = {
            ENABLE {
                Rubout => {
                    IO.PutRope[out, " XXX"];
                    GO TO leave
                    };
                <<FS.Error => {>>
                    <<IO.PutRope[out, " ... \n  "];>>
                    <<IO.PutRope[out, >>
                        <<IF error.explanation.Length[] # 0>>
                            <<THEN error.explanation>>
                            <<ELSE "FS.Error without a message: consult an expert"];>>
                    <<GO TO leave>>
                    <<};>>
                BasicTime.TimeNotKnown => {
                    IO.PutRope[out, " ... I can't do that without knowing the current time."];
                    GO TO leave
                    };
                ForceExit => {
                    exit _ TRUE;
                    GO TO leave
                    };
                <<Overwritten => {>>
                    <<overwritten _ TRUE;>>
                    <<GO TO leave>>
                    <<};>>
                };
            c.commandProc[in, out];
            EXITS leave => {};
            };


        TalkToUser: PUBLIC PROC[in, out: STREAM] = {
            IO.PutRope[out, "\n\nType \"?\" at any time if you need help.\n"];
            DO
                ENABLE {
                    ABORTED => EXIT;
                    Rubout => { IO.PutRope[out, " XXX"]; LOOP };
                    };
                c: XNSPSCommander.CommandInfo = GetCommand[in: in, out: out
                ! IO.EndOfStream => EXIT];
                exit, overwritten: BOOL;
                [exit, overwritten] _ DoCommand[in, out, c];
                IF exit THEN EXIT;
                ENDLOOP;
            };

        QuitCommand: PROC [in, out: STREAM] = {
            IO.PutRope[out, "\nAre you sure? "];
            IF Confirm[in, out] THEN ERROR ForceExit;
            };

        RegisterCommand[[QuitCommand, "Quit"]];

    END.