
    <<UnparserBufferImpl.mesa >>
        <<Gnelson, December 6, 1983 2:05 am>>
        <<Mike Spreitzer July 30, 1986 9:11:52 pm PDT>>

    DIRECTORY Atom, IO, Rope, TiogaAccess, UnparserBuffer; 

    UnparserBufferImpl: CEDAR PROGRAM
        IMPORTS Atom, IO, Rope, TiogaAccess
        EXPORTS UnparserBuffer
        = BEGIN OPEN UnparserBuffer;

        Privates: TYPE = REF PrivateParts;
        PrivateParts: PUBLIC TYPE = RECORD [
            n: NAT _ 0,    --size of queues and stack
            bl, cl, br, cr, sr, srx: NAT--[0 .. n)-- _ 0,
            buff: Seq _ NIL,
                <<buff.c & buff.changes is circular buffer with pointers [cl .. cr).>>
                <<changes[i] is the tioga changes between c[i-1] and c[i].>>
                <<buff.bs is circular buffer with pointers [bl .. br).>>
                <<buff.s is stack with sr elts in it.>>
            bufferWidth: NAT _ 0,    --sum of widths of chars in c
            hasAlways: BOOL _ FALSE,
            leftBroke: BOOL _ FALSE,
                <<TRUE iff an object has (recursively) broken since last setb removed from buffer or its latest breakpoint removed from buffer, 
                whichever is later.>>
            indentation: NAT _ 0,
            depth: NAT _ 0,
                <<Used only when output is a TiogaAccess.Writer; this tracks the depth of the current node in the Writer.  0 corresponds to no 
                indentation.>>
            leftLooks: TiogaAccess.Looks _ ALL[FALSE],
            leftCharProps, leftNodeProps: PropList _ NIL,
            leftNodeFormat, leftNodeComment: ATOM _ NIL
            ];

        Seq: TYPE = REF Sequence;
        Sequence: TYPE = RECORD [elts: SEQUENCE length: NAT OF Element];

        Element: TYPE = RECORD [
            c: CHAR,
            changes: Changes _ NIL,
            s: INTEGER,
                <<The indentations of the setbs that have been removed from the buffer but whose matching endbs have not yet been processed are 
                stored in s[0], s[1], ... s[sr-1].  Furthermore, for i < srx, the setb whose indentation is stored in s[i] has been 
                broken; for srx <= i < sr, s[i] is the indentation of a setb on the "current line" that may or may not be broken.>>
            bs: BStuff
            ];

        Changes: TYPE = REF ChangesPrivate;
        ChangesPrivate: TYPE = RECORD [
            
            charProps, nodeProps: PropList _ NIL,
            nodeFormat, nodeComment: ATOM _ NIL
            ];

        clearProps: PropList = LIST[NIL];

        BStuff: TYPE = RECORD [
            type: {setb, breakpoint},
            <<The following are only relevent for breakpoints:>>
                cond: BreakCondition,
                offset: INTEGER,
                sepChars, sepWidth: NAT,
            p: NAT    --index in c of following buffer char
            ];

        biggestN: CARDINAL = LAST[NAT];

        NewInittedHandle: PUBLIC PROC [publics: PublicParts] RETURNS [h: Handle] = {
            h _ NEW [PublicParts _ publics];
            IF h.spacers = NIL THEN h.spacers _ LIST[IO.SP];
            h.ps _ CreatePrivates[h.margin];
            };

        CreatePrivates: PUBLIC PROC [margin: INTEGER _ 80] RETURNS [ps: Privates] = {
        ps _ NEW [PrivateParts _ [buff: NEW [Sequence[margin+3]] ]];
            };

        Init: PUBLIC PROC [h: Handle] = {
            h.ps.bufferWidth _ h.ps.bl _ h.ps.cl _ h.ps.br _ h.ps.cr _ h.ps.sr _ h.ps.srx _ h.ps.indentation _ 0;
            Setb[h]};

        BCount: PROC [h: Handle] RETURNS [nb: NAT] = {
            nb _ IF h.ps.br >= h.ps.bl THEN h.ps.br - h.ps.bl ELSE (h.ps.n - h.ps.bl + h.ps.br)};

        CCount: PROC [h: Handle] RETURNS [nc: NAT] = {
            nc _ IF h.ps.cr >= h.ps.cl THEN h.ps.cr - h.ps.cl ELSE (h.ps.n - h.ps.cl + h.ps.cr)};

        Ensure: PROC [h: Handle, m: NAT] = INLINE {
            IF h.ps.n >= m THEN RETURN;
            IF h.ps.n = biggestN THEN ERROR;
            Enlarge[h, MIN[biggestN, CARDINAL[m]+m/2]]};

        Enlarge: PROC [h: Handle, m: NAT] = {
            news: Seq = NEW [Sequence[m]];
            oldCL: NAT = h.ps.cl;
            nb, nc: NAT _ 0;
            FOR ci: NAT _ h.ps.cl, Right[h, ci] WHILE ci # h.ps.cr DO
                news[nc].c _ h.ps.buff[ci].c;
                news[nc].changes _ h.ps.buff[ci].changes;
                nc _ nc + 1;
                ENDLOOP;
            h.ps.cl _ 0; h.ps.cr _ nc;
            FOR bi: NAT _ h.ps.bl, Right[h, bi] WHILE bi # h.ps.br DO
                news[nb].bs _ h.ps.buff[bi].bs;
                news[nb].bs.p _ IF h.ps.buff[bi].bs.p >= oldCL THEN h.ps.buff[bi].bs.p - oldCL ELSE (h.ps.n - oldCL + h.ps.buff[bi].bs.p);
                nb _ nb + 1;
                ENDLOOP;
            h.ps.bl _ 0; h.ps.br _ nb;
            FOR i: NAT IN [0 .. h.ps.sr) DO news[i].s _ h.ps.buff[i].s ENDLOOP;
            h.ps.buff _ news;
            h.ps.n _ m;
            };

        Right: PROC [h: Handle, m: NAT] RETURNS [NAT] = INLINE
            {RETURN [IF m + 1 # h.ps.n THEN m + 1 ELSE 0]};

        RightL: PROC [h: Handle, m, l: NAT] RETURNS [NAT] = INLINE
            {cm2: CARDINAL _ CARDINAL[m] + l;
            IF cm2 >= h.ps.n THEN cm2 _ cm2 - h.ps.n;
            RETURN [cm2]};

        Left: PROC [h: Handle, m: NAT] RETURNS [NAT] = INLINE
            {RETURN [(IF m = 0 THEN h.ps.n ELSE m) - 1]};

        Setb: PUBLIC PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
            IF bl = br AND cl = cr
                THEN {
                    Ensure[h, sr+2];
                    buff[sr].s _ indentation;
                    sr _ sr + 1}
                ELSE {
                    Ensure[h, BCount[h]+2];
                    buff[br].bs _ [setb, width, 0, 0, 0, cr];
                    br _ Right[h, br]}
            }};

        Endb: PUBLIC PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
            brl: NAT;
            WHILE bl # br AND buff[brl _ Left[h, br]].bs.type = breakpoint DO br _ brl ENDLOOP;
            IF bl # br THEN br _ Left[h, br]
            ELSE {
                WHILE cl # cr DO OutputChar[h] ENDLOOP;
                IF sr = 0 THEN ERROR -- Endb with no matching Setb
                ELSE {
                    IF srx = sr THEN {
                        srx _ srx - 1;
                        leftBroke _ TRUE};
                    sr _ sr - 1};
                }}};

        OutputChar: PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
            IF buff[cl].changes # NIL THEN OutputChanges[h, buff[cl].changes];
            WITH h.output SELECT FROM
                so: BufferOutput.stream => {
                    IO.PutChar[so.stream, buff[cl].c]};
                ao: BufferOutput.access => {
                    TiogaAccess.Put[ao.access, [
                        charSet: 0,
                        char: buff[cl].c,
                        looks: leftLooks,
                        comment: FALSE,
                        endOfNode: FALSE,
                        deltaLevel: 0,
                        propList: leftCharProps
                        ]]};
                ENDCASE => ERROR;
            indentation _ indentation + width[buff[cl].c];
            bufferWidth _ bufferWidth - width[buff[cl].c];
            cl _ Right[h, cl];
            IF cl = cr AND buff[cr].changes # NIL THEN {OutputChanges[h, buff[cr].changes]; buff[cr].changes _ NIL}}};

        OutputChanges: PROC [h: Handle, changes: Changes] = {
            ps: Privates = h.ps; {OPEN ps, h;
            WITH h.output SELECT FROM
                so: BufferOutput.stream => {
                    IF changes.
                    IF changes.charProps # NIL THEN IO.PutF[so.stream, "%p", [refAny[Newize[changes.charProps]]]];
                    IF changes.nodeProps # NIL THEN IO.PutF[so.stream, "%n", [refAny[Newize[changes.nodeProps]]]];
                    IF changes.nodeFormat # NIL THEN IO.PutF[so.stream, "%n", [atom[changes.nodeFormat]]];
                    IF changes.nodeComment # NIL THEN IO.PutF[so.stream, "%n", [boolean[changes.nodeComment = $TRUE]]];
                    };
                ao: BufferOutput.access => {
                    IF changes.
                    IF changes.charProps # NIL THEN leftCharProps _ Newize[changes.charProps];
                    IF changes.nodeProps # NIL THEN leftNodeProps _ Newize[changes.nodeProps];
                    IF changes.nodeFormat # NIL THEN leftNodeFormat _ changes.nodeFormat;
                    IF changes.nodeComment # NIL THEN leftNodeComment _ changes.nodeComment;
                    };
                ENDCASE => ERROR;
            }};

        Newize: PROC [props: PropList] RETURNS [new: PropList] = INLINE {
            new _ IF props # clearProps THEN props ELSE NIL};

        Oldize: PROC [props: PropList] RETURNS [new: PropList] = INLINE {
            new _ IF props # NIL THEN props ELSE clearProps};

        OutputLooks: PROC [h: Handle, looks: Rope.ROPE] = {
            WITH h.output SELECT FROM
                so: BufferOutput.stream => IO.PutF[so.stream, "%l", [rope[looks]]];
                ao: BufferOutput.access => h.ps.leftLooks _ ChangeLooks[h.ps.leftLooks, looks];
                ENDCASE => ERROR};

        ChangeLooks: PROC [old: TiogaAccess.Looks, delta: Rope.ROPE] RETURNS [new: TiogaAccess.Looks] =
            {new _ old;
                FOR i: INT IN [0 .. delta.Length[]) DO
                    c: CHAR = delta.Fetch[i];
                    look: TiogaAccess.Look = SELECT c FROM
                        IN ['a .. 'a + 32) => c,
                        IN ['A .. 'A + 32) => c - 'A + 'a,
                        '  => FIRST[TiogaAccess.Look],
                        ENDCASE => ERROR;
                    SELECT TRUE FROM
                        c = '  => new _ ALL[FALSE];
                        c = look => new[look] _ TRUE;
                        ENDCASE => new[look] _ FALSE;
                    ENDLOOP};

        Bp: PUBLIC PROC [h: Handle, cond: BreakCondition, offset: INTEGER, sep: ROPE] = {
            ps: Privates = h.ps; {OPEN ps, h;
            sepChars, sepWidth: NAT _ 0;
            bp: NAT = cr;
            IF cond = always THEN hasAlways _ TRUE ELSE {
                Ensure[h, CCount[h] + (sepChars _ sep.Length[])];
                FOR i: NAT IN [0 .. sepChars) DO
                    ch: CHAR = sep.Fetch[i];
                    buff[cr].c _ ch;
                    cr _ Right[h, cr];
                    buff[cr].changes _ NIL;
                    sepWidth _ sepWidth + width[ch];
                    ENDLOOP;
                bufferWidth _ bufferWidth + sepWidth;
                };
            Ensure[h, BCount[h]+2];
            buff[br].bs _ [breakpoint, cond, offset, sepChars, sepWidth, bp];
            br _ Right[h, br];
            LeftLoop[h]}};

        Charb: PUBLIC PROC [h: Handle, ch: CHAR] = {ps: Privates = h.ps; {OPEN ps, h;
            Ensure[h, CCount[h]+2];
            buff[cr].c _ ch;
            cr _ Right[h, cr];
            buff[cr].changes _ NIL;
            bufferWidth _ bufferWidth + width[ch];
            LeftLoop[h]}};

        Looksb: PUBLIC PROC [h: Handle, looks: Rope.ROPE] = {
            ps: Privates = h.ps; {OPEN ps, h;
            SELECT TRUE FROM
                cl = cr => OutputChanges[h, NEW [ChangesPrivate _ [looks]]];
                ENDCASE => {
                    IF buff[cr].changes = NIL THEN buff[cr].changes _ NEW [ChangesPrivate _ []];
                    buff[cr].changes.
                    };
            }};

        CharPropsb: PUBLIC PROC [h: Handle, props: PropList] = {
            ps: Privates = h.ps; {OPEN ps, h;
            op: PropList = Oldize[props];
            SELECT TRUE FROM
                cl = cr => OutputChanges[h, NEW [ChangesPrivate _ [charProps: op]]];
                ENDCASE => {
                    IF buff[cr].changes = NIL THEN buff[cr].changes _ NEW [ChangesPrivate _ []];
                    buff[cr].changes.charProps _ op;
                    };
            }};

        NodeFormatb: PUBLIC PROC [h: Handle, format: ATOM] = {
            ps: Privates = h.ps; {OPEN ps, h;
            SELECT TRUE FROM
                cl = cr => OutputChanges[h, NEW[ChangesPrivate _ [nodeFormat: format]]];
                ENDCASE => {
                    IF buff[cr].changes = NIL THEN buff[cr].changes _ NEW [ChangesPrivate _ []];
                    buff[cr].changes.nodeFormat _ format;
                    };
            }};

        NodePropsb: PUBLIC PROC [h: Handle, props: PropList] = {
            ps: Privates = h.ps; {OPEN ps, h;
            op: PropList = Oldize[props];
            SELECT TRUE FROM
                cl = cr => OutputChanges[h, NEW [ChangesPrivate _ [nodeProps: op]]];
                ENDCASE => {
                    IF buff[cr].changes = NIL THEN buff[cr].changes _ NEW [ChangesPrivate _ []];
                    buff[cr].changes.nodeProps _ op;
                    };
            }};

        NodeCommentb: PUBLIC PROC [h: Handle, comment: BOOL] = {
            ps: Privates = h.ps; {OPEN ps, h;
            atom: ATOM = IF comment THEN $TRUE ELSE $FALSE;
            SELECT TRUE FROM
                cl=cr => OutputChanges[h, NEW[ChangesPrivate _ [nodeComment: atom]]];
                ENDCASE => {
                    IF buff[cr].changes = NIL THEN buff[cr].changes _ NEW [ChangesPrivate _ []];
                    buff[cr].changes.nodeComment _ atom;
                    };
            }};

        Ropeb: PUBLIC PROC [h: Handle, r: Rope.ROPE] = {
            FOR i: INT IN [0 .. Rope.Length[r]) DO Charb[h, Rope.Fetch[r, i]] ENDLOOP};

        Atomb: PUBLIC PROC [h: Handle, a: ATOM] = {Ropeb[h, Atom.GetPName[a]]};

        LeftLoop: PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
            DO
                IF cl # cr AND (bl = br OR buff[bl].bs.p # cl) THEN OutputChar[h]
                ELSE IF NOT (bl # br AND (cl = cr OR buff[bl].bs.p = cl)) THEN EXIT
                ELSE IF buff[bl].bs.type = setb THEN {
                    Ensure[h, sr+2];
                    buff[sr].s _ indentation;
                    sr _ sr + 1;
                    bl _ Right[h, bl];
                    leftBroke _ FALSE}
                ELSE IF
                    indentation + bufferWidth > margin OR
                    (SELECT buff[bl].bs.cond FROM width => FALSE, united => srx = sr OR hasAlways, lookLeft => leftBroke, always => TRUE, ENDCASE => 
                    ERROR)
                    THEN {
                        Breakline[h, buff[sr-1].s + buff[bl].bs.offset];
                        srx _ sr;
                        bufferWidth _ bufferWidth - buff[bl].bs.sepWidth;
                        cl _ RightL[h, cl, buff[bl].bs.sepChars];
                        IF br = (bl _ Right[h, bl]) THEN hasAlways _ FALSE;
                        leftBroke _ FALSE}
                ELSE IF Right[h, bl] # br AND buff[Right[h, bl]].bs.type = breakpoint AND buff[bl].bs.cond # united THEN {bl _ Right[h, bl]; 
                leftBroke _ FALSE}
                ELSE EXIT;
                ENDLOOP;
            IF hasAlways THEN ERROR;
            }};

        Breakline: PROC [h: Handle, indent: INTEGER] = {
            ps: Privates = h.ps; {OPEN ps, h;
            goalIndent: INTEGER = indent;
            WITH h.output SELECT FROM
                so: BufferOutput.stream
                => {IO.PutChar[so.stream, IO.CR];
                    FOR sl: LIST OF CHAR _ h.spacers, sl.rest WHILE indent # 0 DO
                        rep: INTEGER _ indent/h.width[sl.first];
                        THROUGH [0 .. rep) DO IO.PutChar[so.stream, sl.first] ENDLOOP;
                        indent _ indent - rep * h.width[sl.first];
                        ENDLOOP;
                    };
                ao: BufferOutput.access
                => {
                    deltaLevel: INTEGER = MIN[1, indent/ao.nestWidth - depth];
                    TiogaAccess.Put[ao.access, [
                        charSet: 0,
                        char: FIRST[CHAR],
                        looks: ALL[FALSE],
                        format: leftNodeFormat,
                        comment: leftNodeComment = $TRUE,
                        endOfNode: TRUE,
                        deltaLevel: deltaLevel,
                        propList: leftNodeProps
                        ]];
                    depth _ depth + deltaLevel;
                    indent _ indent - depth * ao.nestWidth;
                    FOR sl: LIST OF CHAR _ h.spacers, sl.rest WHILE indent # 0 DO
                        rep: INTEGER _ indent/h.width[sl.first];
                        THROUGH [0 .. rep) DO
                            TiogaAccess.Put[ao.access, [
                                charSet: 0,
                                char: sl.first,
                                looks: leftLooks,
                                format: NIL,
                                comment: FALSE,
                                endOfNode: FALSE,
                                deltaLevel: 0,
                                propList: leftCharProps
                                ]];
                            ENDLOOP;
                        indent _ indent - rep * h.width[sl.first];
                        ENDLOOP;
                    };
                ENDCASE => ERROR;
            indentation _ goalIndent}};

        END.