<<>>
<<StructuredStreamsImpl.Mesa>>
<<Copyright Ó 1992 by Xerox Corporation.  All rights reserved.>>
    <<Mike Spreitzer July 30, 1986 9:22:31 pm PDT>>
    <<Last tweaked by Mike Spreitzer on January 10, 1992 3:18 pm PST>>
    <<JKF October 18, 1988 8:30:44 am PDT>>
    <<Willie-s, January 16, 1992 6:11 pm PST>>
    <<Michael Plass, May 21, 1992 9:43 am PDT>>

    DIRECTORY Atom, IO, IOUtils, Rope, RuntimeError, StructuredStreams, UnparserBuffer;

    StructuredStreamsImpl: CEDAR PROGRAM
        IMPORTS IO, IOUtils, Rope, RuntimeError, UnparserBuffer
        EXPORTS StructuredStreams
        SHARES IO =

    BEGIN

    ROPE: TYPE = Rope.ROPE;
    PropList: TYPE = Atom.PropList;

    SSData: TYPE = REF SSDataRec;
    SSDataRec: TYPE = RECORD [
        ubh: UnparserBuffer.Handle,
        idx: INT ¬ 0];

    used: CARDINAL ¬ 0;
    SSProcs: REF IO.StreamProcs ¬ IO.CreateStreamProcs[
        variety: output,
        class: $StructuredStream,
        putChar: PutChar,
        putBlock: PutBlock,
        flush: Flush,
        getIndex: GetIndex,
        close: Close];

    pfProcs: IOUtils.PFProcs = IOUtils.CopyPFProcs[NIL];

    Create: PUBLIC PROC [onTopOf: UnparserBuffer.Handle] RETURNS [ss: IO.STREAM] ~ {
        ssd: SSData ~ NEW [SSDataRec ¬ [ubh: onTopOf]];
        ss ¬ IO.CreateStream[streamProcs: SSProcs, streamData: ssd];
        [] ¬ IOUtils.SetPFProcs[ss, pfProcs];
        RETURN};

    IsAnSS: PUBLIC PROC [s: IO.STREAM] RETURNS [BOOLEAN]
         ~ {RETURN [s.streamProcs.class = $StructuredStream]};

    GetHandle: PUBLIC PROC [ss: IO.STREAM] RETURNS [UnparserBuffer.Handle] =
        BEGIN
        IF ss.streamData = NIL THEN RETURN [NIL];
        WITH ss.streamData SELECT FROM
            ssd: SSData => RETURN [ssd.ubh];
            ENDCASE => RETURN [NIL];
        END;

    Strip: PUBLIC PROC [ss: IO.STREAM] RETURNS [IO.STREAM] =
        BEGIN
        IF ss.streamData = NIL THEN RETURN [ss];
        WITH ss.streamData SELECT FROM
            ssd: SSData => WITH ssd.ubh.output SELECT FROM
                so: UnparserBuffer.BufferOutput.stream => RETURN [so.stream];
                ENDCASE => ERROR;
            ENDCASE => RETURN [ss];
        END;

    CloseThrough: PUBLIC PROC [self: IO.STREAM] =
        BEGIN
        IF NOT IsAnSS[self] THEN self.Close[]
        ELSE {
            ssd: SSData = NARROW[self.streamData];
            self.Close[];
            WITH ssd.ubh.output SELECT FROM
                so: UnparserBuffer.BufferOutput.stream => so.stream.Close[];
                ENDCASE => ERROR;
            };
        END;

    Begin: PUBLIC PROC [ss: IO.STREAM] = {
        IF IsAnSS[ss] THEN NARROW[ss.streamData, SSData].ubh.Setb[];
        };

    End: PUBLIC PROC [ss: IO.STREAM] = {
        IF IsAnSS[ss] THEN NARROW[ss.streamData, SSData].ubh.Endb[];
        };

    XBp: PUBLIC PROC [ss: IO.STREAM, cond: UnparserBuffer.XBreakCondition, offset: INTEGER, sep: ROPE ¬ NIL] = {
        IF IsAnSS[ss] THEN {
            ssd: SSData ¬ NARROW[ss.streamData];
            UnparserBuffer.XBp[ssd.ubh, cond, offset, sep];
            IF cond=always THEN ssd.idx ¬ ssd.idx+1 ELSE ssd.idx ¬ ssd.idx + sep.Length;
            }
        ELSE IF cond=always THEN ss.PutChar['\n]
        ELSE ss.PutRope[sep];
        };

    Bp: PUBLIC PROC [ss: IO.STREAM, cond: UnparserBuffer.BreakCondition, offset: INTEGER, sep: ROPE ¬ NIL] = {
        IF IsAnSS[ss] THEN {
            ssd: SSData ¬ NARROW[ss.streamData];
            ssd.ubh.Bp[cond, offset, sep];
            IF cond=always THEN ssd.idx ¬ ssd.idx+1 ELSE ssd.idx ¬ ssd.idx + sep.Length;
            }
        ELSE IF cond=always THEN ss.PutChar['\n]
        ELSE ss.PutRope[sep];
        };

    ChangeMargin: PUBLIC PROC [ss: IO.STREAM, newMargin: INTEGER ¬ 69] = {
        IF IsAnSS[ss] THEN
            BEGIN
            ssd: SSData ~ NARROW[ss.streamData];
            ssd.ubh.margin ¬ newMargin;
            END;
        };

    PutChar: PROC [self: IO.STREAM, char: CHAR] = {
        ssd: SSData = NARROW[self.streamData];
        IF char = '\r OR char = '\l THEN ssd.ubh.Newlineb[0]
        ELSE ssd.ubh.Charb[char];
        ssd.idx ¬ ssd.idx + 1;
        };

    PutBlock: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex, count: NAT] ~ {
        ssd: SSData = NARROW[self.streamData];
        limit: NAT;
        IF count=0 THEN RETURN;
        IF startIndex >= block.length THEN ERROR RuntimeError.BoundsFault[];
        count ¬ MIN[count, block.length-startIndex];
        IF count=0 THEN RETURN;
        limit ¬ startIndex+count;
        WHILE startIndex < limit DO
            FOR i: NAT ¬ startIndex, i.SUCC WHILE i < limit DO
                c: CHAR ~ block[i];
                IF c = '\l OR c = '\r THEN {
                    IF i > startIndex THEN UnparserBuffer.Textb[ssd.ubh, block, startIndex, i-startIndex];
                    ssd.ubh.Newlineb[0];
                    startIndex ¬ i+1;
                    EXIT};
                REPEAT FINISHED => {
                    UnparserBuffer.Textb[ssd.ubh, block, startIndex, limit-startIndex];
                    startIndex ¬ limit};
                ENDLOOP;
            ENDLOOP;
        ssd.idx ¬ ssd.idx + count;
        RETURN};

    PrintLFormat: PROC [stream: IO.STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR] --IOUtils.PFCodeProc-- = {
        ssd: SSData = NARROW[stream.streamData];
        WITH val SELECT FROM
            x: rope IO.Value => ssd.ubh.Looksb[x.value];
            ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
        };

    PrintPFormat: PROC [stream: IO.STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR] --IOUtils.PFCodeProc-- = {
        ssd: SSData = NARROW[stream.streamData];
        WITH val SELECT FROM
            x: refAny IO.Value => TRUSTED {
                mv: REF ANY = LOOPHOLE[x.value];
                IF mv = NIL OR ISTYPE[mv, PropList] THEN ssd.ubh.CharPropsb[NARROW[mv]] ELSE ERROR IO.Error[PFTypeMismatch, stream];
                };
            x: cardinal IO.Value => IF x.value IN UnparserBuffer.CharSet
                THEN UnparserBuffer.CharSetb[ssd.ubh, x.value]
                ELSE IO.Error[PFUnprintableValue, stream];
            ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
        };

    PrintNFormat: PROC [stream: IO.STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR] --IOUtils.PFCodeProc-- = {
        ssd: SSData = NARROW[stream.streamData];
        WITH val SELECT FROM
            x: refAny IO.Value => TRUSTED {
                mv: REF ANY = LOOPHOLE[x.value];
                IF mv = NIL OR ISTYPE[mv, PropList] THEN ssd.ubh.NodePropsb[NARROW[mv]] ELSE ERROR IO.Error[PFTypeMismatch, stream];
                };
            x: boolean IO.Value => ssd.ubh.NodeCommentb[x.value];
            x: atom IO.Value => ssd.ubh.NodeFormatb[x.value];
            ENDCASE => ERROR IO.Error[PFTypeMismatch, stream];
        };

    Flush: PROC [self: IO.STREAM] ~ {
        ssd: SSData ~ NARROW[self.streamData];
        WITH ssd.ubh.output SELECT FROM
            so: UnparserBuffer.BufferOutput.stream => so.stream.Flush[];
            ENDCASE => ERROR;
        RETURN};

    GetIndex: PROC [self: IO.STREAM] RETURNS [INT] ~ {
        ssd: SSData ~ NARROW[self.streamData];
        RETURN [ssd.idx]};

    Close: PROC [self: IO.STREAM, abort: BOOL ¬ FALSE] =
        BEGIN
        IOUtils.AmbushStream[self: self, streamProcs: IOUtils.closedStreamProcs, streamData: NIL];
        END;

    Start: PROC = {
        [] ¬ IOUtils.SetPFCodeProc[pfProcs, 'l, PrintLFormat];
        [] ¬ IOUtils.SetPFCodeProc[pfProcs, 'p, PrintPFormat];
        [] ¬ IOUtils.SetPFCodeProc[pfProcs, 'n, PrintNFormat];
        };

    Start[];

    END.