<<>>
    <<IOEditedStreamImpl.mesa>>
        <<Copyright Ó 1985, 1986, 1991 by Xerox Corporation.  All rights reserved.>>
        <<MBrown on December 9, 1983 11:24 am>>
    <<Russ Atkinson (RRA) February 2, 1985 1:54:31 pm PST>>
        <<Doug Wyatt, December 11, 1986 10:46:07 pm PST>>
        <<JKF August 29, 1988 8:55:36 am PDT>>
        <<Eduardo Pelegri-Llopart December 5, 1988 9:28:49 am PST>>
        <<Michael Plass, August 6, 1991 12:13 pm PDT>>

    <<Things to consider:>>
        <<Edited stream backup does not allow backup past ready chars, should it?>>
        <<SetEcho with stream in the backed-up state should be some sort of error?>>
        <<Break out separate proc to read up to activation, return buffer length.>>

    DIRECTORY
        Ascii,
        Atom,
        Basics,
        EditedStream,
        IO,
        IOUtils,
        Rope,
        RefText, 
        RuntimeError USING [BoundsFault];

    IOEditedStreamImpl: CEDAR PROGRAM  
        IMPORTS Basics, IO, IOUtils, RefText, Rope, RuntimeError
        EXPORTS EditedStream
        SHARES IO --for representation of StreamProcs
        = BEGIN

        STREAM: TYPE = IO.STREAM;
        ROPE: TYPE = Rope.ROPE;
        StreamProcs: TYPE = IO.StreamProcs;
        TypeOfSetEcho: TYPE = PROC [self: STREAM, echoTo: STREAM];
        TypeOfGetEcho: TYPE = PROC [self: STREAM] RETURNS [oldEcho: STREAM];
        DeliverWhenProc: TYPE = EditedStream.DeliverWhenProc;
        TypeOfGetDeliverWhen: TYPE = PROC [self: STREAM] RETURNS [proc: DeliverWhenProc, context: REF ANY];
        TypeOfSetDeliverWhen: TYPE = PROC [self: STREAM, proc: DeliverWhenProc, context: REF ANY Ź NIL];
        TypeOfAppendBufferChars: TYPE = PROC [stream: STREAM, chars: ROPE];
        TypeOfUnAppendBufferChars: TYPE = PROC [stream: STREAM, nChars: NAT];
        TypeOfSetMode: TYPE = PROC [stream: STREAM, stuff: ROPE, pendingDelete: BOOL,
            echoAsterisks: BOOL];

        InlineLookupProc: PROC [self: STREAM, operation: ATOM] RETURNS [proc: REF ANY]
            = --INLINE-- {
            FOR l: Atom.PropList Ź self.streamProcs.propList, l.rest UNTIL l = NIL DO
                IF l.first.key = operation THEN RETURN[l.first.val]; 
                ENDLOOP;
            };

        GetDeliverWhen: PUBLIC PROC [self: STREAM] RETURNS [proc: DeliverWhenProc, context: REF ANY] = {
            p: REF ANY = InlineLookupProc[self, $GetDeliverWhen];
            IF p # NIL THEN { [proc, context] Ź (NARROW[p, REF TypeOfGetDeliverWhen])­ [self];
                RETURN }
            ELSE ERROR IO.Error[$NotImplementedForThisStream, self];
            };

        SetDeliverWhen: PUBLIC PROC [self: STREAM, proc: DeliverWhenProc, context: REF ANY] = {
            p: REF ANY = InlineLookupProc[self, $SetDeliverWhen];
            IF p # NIL THEN { (NARROW[p, REF TypeOfSetDeliverWhen])­ [self, proc, context];
                RETURN }
            ELSE ERROR IO.Error[$NotImplementedForThisStream, self];
            };

        AppendBufferChars: PUBLIC PROC [stream: STREAM, chars: ROPE] = {
            p: REF ANY = InlineLookupProc[stream, $AppendBufferChars];
            IF p # NIL THEN { (NARROW[p, REF TypeOfAppendBufferChars])­ [stream, chars];
                RETURN }
            ELSE ERROR IO.Error[$NotImplementedForThisStream, stream];
            };

        UnAppendBufferChars: PUBLIC PROC [stream: STREAM, nChars: NAT] = {
            p: REF ANY = InlineLookupProc[stream, $UnAppendBufferChars];
            IF p # NIL THEN { (NARROW[p, REF TypeOfUnAppendBufferChars])­ [stream, nChars];
                RETURN }
            ELSE ERROR IO.Error[$NotImplementedForThisStream, stream];
            };

        SetMode: PUBLIC PROC [stream: STREAM, stuff: ROPE, pendingDelete: BOOL,
            echoAsterisks: BOOL] = {
            p: REF ANY = InlineLookupProc[stream, $SetMode];
            IF p # NIL THEN { (NARROW[p, REF TypeOfSetMode])­ [stream, stuff, pendingDelete, echoAsterisks];
                RETURN }
            ELSE ERROR IO.Error[$NotImplementedForThisStream, stream];
            };

    <<Edited Input Stream>>
        EditedStreamData: TYPE = REF EditedStreamRecord;
        EditedStreamRecord: TYPE = RECORD[
            ready: REF TEXT,
            readyPos: INT Ź 0, -- ready[readyPos .. ready.length) are the already-activated characters
            buffer: REF TEXT,
            echoStream: STREAM Ź NIL,
            deliverWhen: DeliverWhenProc,
            context: REF ANY,
            echoAsterisks: BOOL Ź FALSE,
            pendingDelete: BOOL Ź FALSE
            ];
        EditedStreamProcs: REF StreamProcs;

        IsACR: PUBLIC DeliverWhenProc = {
            RETURN [appendChar: TRUE, activate: (char = IO.CR) OR (char = IO.LF)]
            };

        IsANL: PUBLIC DeliverWhenProc = {
            RETURN [appendChar: TRUE, activate: (char = IO.CR) OR (char = IO.LF)]
            };


        Create: PUBLIC PROC [in: STREAM, echoTo: STREAM, deliverWhen: DeliverWhenProc, context: REF ANY]
            RETURNS [STREAM] = {
            h: STREAM Ź IO.CreateStream[
                streamProcs: EditedStreamProcs,
                streamData:  NEW[EditedStreamRecord Ź [ 
                    buffer: NEW[TEXT[256]],
                    ready: NEW[TEXT[256]],
                    deliverWhen: deliverWhen, context: context]],
                backingStream: in
                ];
            SetEcho[in, NIL]; 
            SetEcho[h, echoTo]; 
            RETURN [h]
            };

        EditedStreamAppendBufferChars: PROC [stream: STREAM, chars: ROPE] = {
            data: EditedStreamData = NARROW[stream.streamData];
            Append1: PROC [c: CHAR] RETURNS [quit: BOOL] = {
                AppendBufferChar[data, c]; RETURN [quit: FALSE] };
            [] Ź chars.Map[action: Append1];
            };

        AppendBufferChar: PROC [data: EditedStreamData, char: CHAR] = --INLINE-- {
            data.buffer Ź RefText.InlineAppendChar[data.buffer, char];
            IF data.echoStream # NIL THEN {
                IF data.echoAsterisks AND char > IO.SP THEN data.echoStream.PutChar['*]
                ELSE data.echoStream.PutChar[char];
                };
            };

        EditedStreamUnAppendBufferChars: PUBLIC PROC [stream: STREAM, nChars: NAT] = {
            data: EditedStreamData = NARROW[stream.streamData];
            FOR i: NAT IN [0 .. MIN[nChars, data.buffer.length]) DO
                UnAppendBufferChar[data]
                ENDLOOP;
            };

        UnAppendBufferChar: PROC [data: EditedStreamData] = --INLINE-- {
            IF data.echoStream # NIL THEN {
                char: CHAR = data.buffer[data.buffer.length - 1];
                IF data.echoAsterisks AND char > IO.SP THEN data.echoStream.EraseChar['*]
                ELSE data.echoStream.EraseChar[char]
                };
            data.buffer.length Ź data.buffer.length - 1;
            };

        EditedStreamSetMode: PROC [stream: STREAM, stuff: ROPE, pendingDelete: BOOL,
            echoAsterisks: BOOL]  = {
            data: EditedStreamData = NARROW[stream.streamData];
            data.buffer.length Ź 0;
            data.readyPos Ź data.ready.length;
            data.pendingDelete Ź pendingDelete;
            data.echoAsterisks Ź echoAsterisks;
            AppendBufferChars[stream, stuff];
            };

        EditedStreamGetDeliverWhen: PROC [self: STREAM] RETURNS [proc: DeliverWhenProc, context: REF ANY] = {
            data: EditedStreamData = NARROW[self.streamData];
            RETURN [data.deliverWhen, data.context];
            };

        EditedStreamSetDeliverWhen: PROC [self: STREAM, proc: DeliverWhenProc, context: REF ANY] = {
            data: EditedStreamData = NARROW[self.streamData];
            data.deliverWhen Ź proc;  data.context Ź context;
            };

        EditedStreamGetChar: PROC [self: STREAM] RETURNS [char: CHAR] = {
            data: EditedStreamData = NARROW[self.streamData];
            IsEditCommand: PROC [char: CHAR] RETURNS [BOOL] = {
                RETURN [SELECT char FROM
                    Ascii.DEL, Ascii.ControlA, Ascii.BS, Ascii.ControlW, Ascii.ControlQ => TRUE,
                    ENDCASE => FALSE];
                };
            BackChar: PROC = {
                <<erases last character, if any , in buffer>>
                IF data.buffer.length > 0 THEN {
                    UnAppendBufferChar[data];
                    }
                };
            BackWord: PROC = {
                <<erases last "word" (consecutive run of letters and numbers), if any, in buffer>>
                alphaSeen: BOOL Ź FALSE;
                UNTIL data.buffer.length = 0 DO
                    SELECT data.buffer[data.buffer.length - 1] FROM
                        IN ['A..'Z], IN ['a..'z], IN ['0..'9] => alphaSeen Ź TRUE;
                        ENDCASE => IF alphaSeen THEN EXIT;
                    UnAppendBufferChar[data];
                    ENDLOOP;
                };
            BackLine: PROC = {
                <<erases buffer back to (not including) previous CR, if any>>
                UNTIL data.buffer.length = 0 DO
                    c: CHAR ~ data.buffer[data.buffer.length - 1];
                    IF (c = IO.CR) OR (c = IO.LF) THEN EXIT;
                    UnAppendBufferChar[data];
                    ENDLOOP;
                };
            DO
                IF data.readyPos < data.ready.length THEN {
                    char Ź data.ready[data.readyPos];
                    data.readyPos Ź data.readyPos + 1;
                    RETURN [char];
                    };
                {
                    appendChar, activate: BOOL;
                    char Ź self.backingStream.GetChar[ ! IO.EndOfStream =>
                        IF data.buffer.length = 0 THEN REJECT ELSE GOTO activateBuffer];
                    [appendChar: appendChar, activate: activate] Ź
                        data.deliverWhen[char, data.buffer, self, data.context];
                    IF data.pendingDelete THEN {
                        data.pendingDelete Ź FALSE;
                        IF NOT activate AND appendChar AND NOT IsEditCommand[char] THEN
                            UnAppendBufferChars[self, data.buffer.length];
                        };
                    IF appendChar THEN {
                        SELECT char FROM
                            Ascii.DEL => { ENABLE UNWIND => data.buffer.length Ź 0;
                                ERROR IO.Rubout[self];
                                };
                            Ascii.ControlA, Ascii.BS => BackChar[];
                            Ascii.ControlW => BackWord[];
                            Ascii.ControlQ => BackLine[];
                            Ascii.ESC => IF data.buffer.length = 0 THEN {
                                FOR i: NAT IN [0..data.ready.length-1) DO
                                    AppendBufferChar[data, data.ready[i]];
                                    ENDLOOP
                                };
                            ENDCASE => AppendBufferChar[data, char];
                        };
                    IF activate THEN GOTO activateBuffer;
                    EXITS activateBuffer => {
                        data.ready.length Ź 0;
                        data.ready Ź RefText.Append[data.ready, data.buffer];
                        data.readyPos Ź 0;
                        data.buffer.length Ź 0;
                        data.echoAsterisks Ź FALSE;
                        }
                    }
                ENDLOOP;
            };

        EditedStreamEndOf: PROC [self: STREAM] RETURNS [BOOL] = {
            data: EditedStreamData = NARROW[self.streamData];
            RETURN[data.readyPos = data.ready.length AND self.backingStream.EndOf[]]; 
            };

        EditedStreamCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = {
            data: EditedStreamData = NARROW[self.streamData];
            IF data.readyPos < data.ready.length THEN RETURN [data.ready.length-data.readyPos];
            RETURN[self.backingStream.CharsAvail[wait]];
            };

        EditedStreamBackup: PROC [self: STREAM, char: CHAR] = {
            <<looks wrong ... why can't you backup past ready chars?>>
            data: EditedStreamData = NARROW[self.streamData];
            IF data.readyPos = 0 OR data.ready[data.readyPos - 1] # char THEN
                IO.Error[$IllegalBackup, self];
            data.readyPos Ź data.readyPos - 1;
            };

        EditedStreamSetEcho: PROC [self: STREAM, echoTo: STREAM] = {
            data: EditedStreamData = NARROW[self.streamData];
            data.echoStream Ź echoTo;
            };

        EditedStreamGetEcho: PROC [self: STREAM] RETURNS [STREAM] = {
            data: EditedStreamData = NARROW[self.streamData];
            RETURN [data.echoStream];
            };

        EditedStreamReset: PROC [self: STREAM] = {
            data: EditedStreamData = NARROW[self.streamData];
            data.buffer.length Ź 0;
            data.ready.length Ź 0;
            data.readyPos Ź 0;
            self.backingStream.Reset[];
            IF data.echoStream # NIL THEN data.echoStream.Reset[];
            };

    <<Default SetEcho implementation>>
    <<>>
        SetEchoData: TYPE = REF SetEchoRecord;
        SetEchoRecord: TYPE = RECORD [echoStream: STREAM, buffer: REF TEXT];
        setEchoProcs: REF StreamProcs;

        SetEcho: PUBLIC PROC [self: STREAM, echoTo: STREAM] = {
            origSelf: STREAM Ź self;
            DO
                proc: REF ANY Ź InlineLookupProc[self, $SetEcho];
                IF proc # NIL THEN {
                    (NARROW[proc, REF TypeOfSetEcho])­ [self, echoTo];
                    RETURN;
                    }
                ELSE IF self.backingStream # NIL THEN self Ź self.backingStream
                ELSE EXIT;
                ENDLOOP;
            <<Default implementation: ambush the stream (it will be un-ambushed when self.SetEcho[NIL] is performed).>>
            IF echoTo = NIL THEN RETURN;
            IOUtils.AmbushStream[
                self: origSelf,
                streamProcs: setEchoProcs,
                streamData: NEW[SetEchoRecord Ź [echoStream: NIL, buffer: RefText.New[8]]]];
            DefaultSetEchoSetEcho[origSelf, echoTo]; 
            };

        GetEcho: PUBLIC PROC [self: STREAM] RETURNS [oldEcho: STREAM] = {
            origSelf: STREAM Ź self;
            DO
                proc: REF ANY Ź InlineLookupProc[self, $GetEcho];
                IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfGetEcho])­ [self] ]
                ELSE IF self.backingStream # NIL THEN self Ź self.backingStream
                ELSE EXIT;
                ENDLOOP;
            RETURN [NIL];
            };

        DefaultSetEchoSetEcho: PROC [self: STREAM, echoTo: STREAM] = {
            data: SetEchoData = NARROW[self.streamData];
            data.echoStream Ź echoTo;
            IF echoTo = NIL AND data.buffer.length = 0 THEN IOUtils.UnAmbushStream[self];
            };

        DefaultSetEchoGetEcho: PROC [self: STREAM] RETURNS [oldEcho: STREAM] = {
            data: SetEchoData = NARROW[self.streamData];
            RETURN[data.echoStream];
            };

        DefaultSetEchoBackup: PROC [self: STREAM, char: CHAR] = {
            <<To prevent backed-up chars from being echoed twice (see SetEchoGetChar below).>>
            data: SetEchoData = NARROW[self.streamData];
            data.buffer Ź RefText.InlineAppendChar[data.buffer, char !
                RuntimeError.BoundsFault => ERROR IO.Error[$BufferOverflow, self]];
            };

        DefaultSetEchoGetChar: PROC [self: STREAM] RETURNS [char: CHAR] = {
            data: SetEchoData = NARROW[self.streamData];
            IF data.buffer.length > 0 THEN {
                data.buffer.length Ź data.buffer.length - 1;
                char Ź data.buffer[data.buffer.length];
                RETURN[char];
                };
            char Ź self.backingStream.GetChar[];
            IF data.echoStream # NIL THEN data.echoStream.PutChar[char];
            };

        DefaultSetEchoGetBlock: PROC [self: STREAM, block: REF TEXT, startIndex: NAT, count: NAT] RETURNS [nBytesRead: NAT] = {
            data: SetEchoData = NARROW[self.streamData];
            nBytesRead Ź 0;
            WHILE data.buffer.length > 0 DO
                IF count = 0 OR startIndex >= block.maxLength THEN RETURN [nBytesRead];
                data.buffer.length Ź data.buffer.length - 1;
                block[startIndex] Ź data.buffer[data.buffer.length];
                startIndex Ź startIndex + 1;
                count Ź count - 1;
                nBytesRead Ź nBytesRead + 1;
                ENDLOOP;
            nBytesRead Ź nBytesRead + self.backingStream.GetBlock[block, startIndex, count];
            IF data.echoStream # NIL THEN data.echoStream.PutBlock[block, startIndex, block.length-startIndex];
            RETURN [nBytesRead];
            };

        DefaultSetEchoUnsafeGetBlock: UNSAFE PROC [self: STREAM, block: IO.UnsafeBlock] RETURNS [nBytesRead: INT Ź 0] = UNCHECKED {
            data: SetEchoData = NARROW[self.streamData];
            IF Basics.NonNegative[block.startIndex]>NAT.LAST 
            OR data.buffer.length>(NAT.LAST-block.startIndex) THEN {
                offset: INT ~ block.startIndex/Basics.charsPerWord;
                block.base Ź block.base+offset;
                block.startIndex Ź block.startIndex-offset*Basics.charsPerWord;
                };
            [] Ź Basics.NonNegative[block.count];
            WHILE data.buffer.length > 0 DO
                IF block.count = 0 THEN RETURN [nBytesRead];
                data.buffer.length Ź data.buffer.length - 1;
                LOOPHOLE[block.base, LONG POINTER TO Basics.RawChars][block.startIndex] Ź data.buffer[data.buffer.length];
                block.startIndex Ź block.startIndex + 1;
                block.count Ź block.count - 1;
                nBytesRead Ź nBytesRead + 1;
                ENDLOOP;
            block.count Ź self.backingStream.UnsafeGetBlock[block];
            IF data.echoStream # NIL THEN data.echoStream.UnsafePutBlock[block];
            RETURN [nBytesRead + block.count];
            };

        DefaultSetEchoEndOf: PROC [self: STREAM] RETURNS [BOOL] = { 
            data: SetEchoData = NARROW[self.streamData];
            RETURN[data.buffer.length = 0 AND self.backingStream.EndOf[]];
            };

        DefaultSetEchoCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = {
            data: SetEchoData = NARROW[self.streamData];
            IF data.buffer.length > 0 THEN RETURN [data.buffer.length];
            RETURN[self.backingStream.CharsAvail[wait]];
            };

        DefaultSetEchoReset:  PROC [self: STREAM] = {
            data: SetEchoData = NARROW[self.streamData];
            data.buffer.length Ź 0;
            self.backingStream.Reset[];
            };

    <<Implementing a stream class>>
        AddStreamProcs: PUBLIC PROC [
            to: REF IO.StreamProcs,
            setEcho: PROC [self: STREAM, echoTo: STREAM],
            getEcho: PROC [self: STREAM] RETURNS [oldEcho: STREAM]
            ]
            RETURNS [REF IO.StreamProcs] = {
            IF setEcho # NIL THEN
                IOUtils.StoreProc[to, $SetEcho, NEW[TypeOfSetEcho Ź setEcho]];
            IF getEcho # NIL THEN
                IOUtils.StoreProc[to, $GetEcho, NEW[TypeOfGetEcho Ź getEcho]];
            RETURN [to];
            };

    <<Module Initialization>>
        EditedStreamProcs Ź AddStreamProcs[to: IO.CreateStreamProcs[
            variety: $input, class: $Edited,
            getChar: EditedStreamGetChar,
            endOf: EditedStreamEndOf,
            charsAvail: EditedStreamCharsAvail,
            backup: EditedStreamBackup,
            reset: EditedStreamReset],
            setEcho: EditedStreamSetEcho,
            getEcho: EditedStreamGetEcho];
        IOUtils.StoreProc[EditedStreamProcs,
            $GetDeliverWhen, NEW[TypeOfGetDeliverWhen Ź EditedStreamGetDeliverWhen]];
        IOUtils.StoreProc[EditedStreamProcs,
            $SetDeliverWhen, NEW[TypeOfSetDeliverWhen Ź EditedStreamSetDeliverWhen]];
        IOUtils.StoreProc[EditedStreamProcs,
            $AppendBufferChars, NEW[TypeOfAppendBufferChars Ź EditedStreamAppendBufferChars]];
        IOUtils.StoreProc[EditedStreamProcs,
            $UnAppendBufferChars, NEW[TypeOfUnAppendBufferChars Ź EditedStreamUnAppendBufferChars]];
        IOUtils.StoreProc[EditedStreamProcs,
            $SetMode, NEW[TypeOfSetMode Ź EditedStreamSetMode]];
        setEchoProcs Ź AddStreamProcs[to: IO.CreateStreamProcs[
            variety: $inputOutput, class: $SetEcho,
            getChar: DefaultSetEchoGetChar,
            getBlock: DefaultSetEchoGetBlock,
            unsafeGetBlock: DefaultSetEchoUnsafeGetBlock,
            endOf: DefaultSetEchoEndOf,
            charsAvail: DefaultSetEchoCharsAvail,
            backup: DefaultSetEchoBackup,
            reset: DefaultSetEchoReset],
            setEcho: DefaultSetEchoSetEcho,
            getEcho: DefaultSetEchoGetEcho];
    END.