
<<ISTiogaInternImpl.mesa>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
    <<MKaplan, September 13, 1985 2:05:40 pm PDT>>
    <<>>
    DIRECTORY
        Atom USING [MakeAtom, GetPName--, PutPropOnList, PropList, DottedPair, DottedPairNode--],
        IO USING [GetBlock, GetIndex, SetIndex, STREAM, PutChar, ROS, RopeFromROS, --EndOfStream, PutF,-- PutFR, --PutChar,-- rope, int, 
        atom],
        Rope USING [ROPE, Find, Length, Substr, FromRefText, Concat, Cat, Fetch, Equal],
        ISTiogaIntern,
        ISMessage USING [--GetIndex, PutF, CloseTempFile, ReopenTempFile, GetTempFileChar,-- TiogaDeltaLevel, WriteTiogaRope, 
        WriteTiogaProp, WriteTiogaFormat],
        ISBinding USING [ObtainBinding, Handle, StackHandle, Anchor],
        ISToken USING [InitialInterscriptContext, EndInterscriptContext, EmbeddedInterscriptContext, ContentInterscriptContext, 
        BindingsInterscriptContext, TVHandle, CharactersTVHandle, NodeTVHandle, AtomTVHandle, IntegerTVHandle, InterscriptContext],
        ISNode USING [InternalizeProc, TiogaPrintProc, Handle, TagHandle, ContextHandle, ContextRecord, GetContext, SetContext, HasTag];


    ISTiogaInternImpl: CEDAR PROGRAM
    IMPORTS IO, ISBinding, ISMessage, Atom, Rope, --PriorityQueue, TiogaAccess, FS,-- ISNode
    EXPORTS ISTiogaIntern
    ~ BEGIN

        localBindingLimit: PUBLIC ISBinding.Anchor; --tells where top (innermost) stack frame ends--

        SetTiogaProps: PROC [bc: ISToken.BindingsInterscriptContext, tag: Rope.ROPE, node: ISNode.Handle, includeTag: BOOL _ FALSE] ~ {
            prefix: Rope.ROPE = Rope.Concat[tag, "."];
            FOR b: ISBinding.Handle _ NARROW[bc.bindings, ISBinding.StackHandle].top, b.previous UNTIL b=NIL DO {
                n: Rope.ROPE = Atom.GetPName[b.name];
                IF b=localBindingLimit THEN EXIT;
                IF Rope.Find[n, prefix]=0 THEN {
                    p: ATOM = IF includeTag THEN Atom.MakeAtom[n] ELSE Atom.MakeAtom[Rope.Substr[n, Rope.Length[prefix]+1]];
                    node.taggedBindingsList _ CONS[b, node.taggedBindingsList];
                    };
                };
                ENDLOOP;
            };

        ObtainTaggedBinding: PROC [tag: Rope.ROPE, name: Rope.ROPE, node: ISNode.Handle] RETURNS [ISToken.TVHandle] ~ {
            taggedName: ATOM _ Atom.MakeAtom[Rope.Cat[tag, ".", name]];
            FOR l: LIST OF ISBinding.Handle _ node.taggedBindingsList, l.rest UNTIL l=NIL DO
                IF l.first.name=taggedName THEN RETURN[l.first.value];
                ENDLOOP;
            RETURN[NIL];
            };

        PrintToken: PUBLIC PROC [t: ISToken.TVHandle] RETURNS [r: Rope.ROPE] ~ {
            WITH t SELECT FROM
                i: ISToken.IntegerTVHandle =>
                    r _ IO.PutFR[" %g ", IO.int[i.value]];
                a: ISToken.AtomTVHandle =>
                    r _ IO.PutFR[" %g ", IO.atom[a.value]];
                c: ISToken.CharactersTVHandle =>
                    r _ IO.PutFR[" <%g> ", IO.rope[RopeFromChars[c]]];
                n: ISToken.NodeTVHandle =>
                    r _ PrintNodeContents[NARROW[n.isnode]];
                ENDCASE => ERROR;
            };

        PrintNodeContents: PUBLIC PROC [n: ISNode.Handle, wrap: BOOL_TRUE] RETURNS [r: Rope.ROPE _ ""] ~ {
            IF n.primaryTag#NIL THEN r _ IO.PutFR["%g$ ", IO.atom[n.primaryTag]];
            FOR tl: ISNode.TagHandle _ n.tagThread, tl.next UNTIL tl=NIL DO
                IF tl.tag#n.primaryTag THEN r _ IO.PutFR["%g%g$ ", IO.rope[r], IO.atom[tl.tag]];
                ENDLOOP;
            FOR bl: LIST OF ISBinding.Handle _ n.taggedBindingsList, bl.rest UNTIL bl=NIL DO
                b: ISBinding.Handle _ bl.first;
                r _ IO.PutFR["%g%g=%g ", IO.rope[r], IO.atom[b.name], IO.rope[PrintToken[b.value]]];
                ENDLOOP;
            FOR ct: ISNode.ContextHandle _ n.contextThread, ct.next UNTIL ct=NIL DO
                WITH ct.context SELECT FROM
                    c: ISToken.ContentInterscriptContext =>
                        r _ IO.PutFR["%g%g ", IO.rope[r], IO.rope[PrintToken[c.content]]];
                    m: ISToken.EmbeddedInterscriptContext =>
                        r _ IO.PutFR["%g%g ", IO.rope[r], IO.rope[PrintNodeContents[NARROW[m.content.isnode]]]];
                    ENDCASE => ERROR;
                ENDLOOP;
            IF wrap THEN r _ IO.PutFR["{ %g }\n", IO.rope[r]];
            };

        WriteTiogaProps: PROC [node: ISNode.Handle] ~ {
            FOR l: LIST OF ISBinding.Handle _ node.taggedBindingsList, l.rest UNTIL l=NIL DO
                b: ISBinding.Handle _ l.first;
                n: Rope.ROPE = Atom.GetPName[b.name];
                p: ATOM _ IF Rope.Find[n, "PROPERTIES."]=0
                    THEN Atom.MakeAtom[Rope.Substr[n, Rope.Length["PROPERTIES."]]]
                    ELSE b.name;
                IF p=$Comment AND Rope.Equal[RopeFromChars[NARROW[b.value]], "TRUE"]
                    THEN ISMessage.WriteTiogaProp[prop: p, value: "TRUE"] --TiogaAccess treats Comment specially--
                    ELSE ISMessage.WriteTiogaProp[prop: p, value: PrintToken[b.value]];
                ENDLOOP;
            };

        <<Primary Tags:>>

        DefaultInternalizeProc: PUBLIC ISNode.InternalizeProc = {
            <<[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]>>
            <<This tag has no equivalent in Tioga.  Just put it on the Tioga node's property list, together with appropriate bindings.>>
            WITH interscriptContext SELECT FROM
                i: ISToken.InitialInterscriptContext =>
                    node.primaryTag _ node.tag;
                c: ISToken.ContentInterscriptContext => 
                    ISNode.SetContext[node, NIL, c];
                m: ISToken.EmbeddedInterscriptContext =>
                    ISNode.SetContext[node, NIL, m];
                b: ISToken.BindingsInterscriptContext =>
                    SetTiogaProps[b, Atom.GetPName[node.tag], node, TRUE];
                ENDCASE => NULL; --No special action on contents of Nodes of Wonder.--
            };

        DefaultPrintProc: PUBLIC ISNode.TiogaPrintProc = {
            <<[deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ 0]>>
            printedSubnode: BOOL _ FALSE;
            ISMessage.TiogaDeltaLevel[deltaLevel+1];  -- +1 because we're starting a new node--
            ISMessage.WriteTiogaRope[rope: IO.PutFR["[%g$ node]\n", IO.atom[IF node.primaryTag=NIL THEN $Anonymous ELSE node.primaryTag]], 
            lookChars: "e"];
            ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: IF node.tag=NIL THEN "Set" ELSE Atom.GetPName[node.tag]];
            WriteTiogaProps[node];
            IF node.contextThread#NIL THEN BEGIN
                FOR c: ISNode.ContextHandle _ node.contextThread, c.next UNTIL c=NIL DO
                    WITH c.context SELECT FROM
                        con: ISToken.ContentInterscriptContext => BEGIN
                            WriteContentNode: PROC [r: Rope.ROPE] ~ {
                                ISMessage.TiogaDeltaLevel[nests+1];
                                nests _ -1;
                                ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: "<Literal>"];
                                ISMessage.WriteTiogaRope[rope: r, lookChars: ""];
                                };
                            WITH con.content SELECT FROM
                                i: ISToken.IntegerTVHandle => {
                                    WriteContentNode[IO.PutFR["%g\n", IO.int[i.value]]];
                                    };
                                a: ISToken.AtomTVHandle => {
                                    WriteContentNode[IO.PutFR["%g\n", IO.atom[a.value]]];
                                    };
                                c: ISToken.CharactersTVHandle => {
                                    WriteContentNode[IO.PutFR["<%g>\n", IO.rope[RopeFromChars[c]]]];
                                    };
                                ENDCASE => ERROR;  -- Unsupported content object--
                            END;
                        emb: ISToken.EmbeddedInterscriptContext => 
                            WITH emb.content SELECT FROM
                                n: ISToken.NodeTVHandle => {
                                    node: ISNode.Handle _ NARROW[n.isnode, ISNode.Handle];
                                    nests _ -1 + node.printProc[nests, node];
                                    printedSubnode _ TRUE;
                                    };
                                ENDCASE => ERROR; --Only nodes in embedded contexts--
                        ENDCASE => NULL;
                    ENDLOOP;
                END;
            };

        InternalizeDocument: PUBLIC ISNode.InternalizeProc = {
            <<[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]>>
            WITH interscriptContext SELECT FROM
                c: ISToken.InitialInterscriptContext =>
                    node.primaryTag _ node.tag;
                m: ISToken.EmbeddedInterscriptContext => {
                    ISNode.SetContext[node, $Node, m];
                    };
                e: ISToken.EndInterscriptContext => BEGIN --Only look at first node.  Is this not fair?-
                    context: ISToken.InterscriptContext = ISNode.GetContext[node, $Node];
                    IF context=NIL THEN ERROR
                    ELSE WITH context SELECT FROM
                        m: ISToken.EmbeddedInterscriptContext => {
                            node: ISNode.Handle _ NARROW[m.content.isnode];
                            ISMessage.TiogaDeltaLevel[node.printProc[1, node]];
                            };
                        ENDCASE => ERROR;  --Document should only contain nodes--
                    END;
                ENDCASE => NULL;
            };

        unNests: INT _ 1;
        InternalizePara: PUBLIC ISNode.InternalizeProc = {
            <<[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]>>
            WITH interscriptContext SELECT FROM
                i: ISToken.InitialInterscriptContext =>
                    node.primaryTag _ node.tag;
                m: ISToken.EmbeddedInterscriptContext => {
                    ISNode.SetContext[node, NIL, m];
                    };
                e: ISToken.EndInterscriptContext => {
                    <<unNests _ unNests+1;>>
                    };
                ENDCASE => NULL;
            };

        PrintPara: PUBLIC ISNode.TiogaPrintProc = {
            <<[deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ 0]>>
            printedSubnode: BOOL _ FALSE;
            ISMessage.TiogaDeltaLevel[deltaLevel+1];  --+1 because we're starting a new node--
            WriteTiogaProps[node];
            ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: "PARA"];
            ISMessage.WriteTiogaFormat[node.format];
            IF node.contextThread#NIL THEN BEGIN
                FOR c: ISNode.ContextHandle _ node.contextThread, c.next UNTIL c=NIL DO
                    WITH c.context SELECT FROM
                        con: ISToken.EmbeddedInterscriptContext => BEGIN
                            WITH con.content SELECT FROM
                                n: ISToken.NodeTVHandle => {
                                    subnode: ISNode.Handle = NARROW[n.isnode];
                                    IF ISNode.HasTag[subnode, $CHARS] THEN {
                                        commentBinding: ISToken.TVHandle;
                                        IF printedSubnode
                                            THEN --Continuation text (non-standard tioga structure). Treat as first class subnode--
                                                nests _ -1 + subnode.printProc[nests, subnode]
                                            ELSE {
                                                commentBinding _ ObtainTaggedBinding["PROPERTIES", "Comment", node];
                                                ISMessage.WriteTiogaRope[rope: subnode.text,
                                                lookChars: subnode.looks,
                                                comment: IF commentBinding#NIL THEN TRUE ELSE FALSE];
                                                };
                                        }
                                    ELSE {
                                        nests _ -1 + subnode.printProc[nests, subnode];
                                        printedSubnode _ TRUE;
                                        };
                                    };
                                ENDCASE => ERROR;  -- Unsupported content object--
                            END;
                        ENDCASE => ERROR;
                    ENDLOOP;
                END;
            };

        InternalizeChars: PUBLIC ISNode.InternalizeProc = {
            <<[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]>>
            WITH interscriptContext SELECT FROM
                i: ISToken.InitialInterscriptContext => {
                    node.primaryTag _ node.tag;
                    node.text _ "";
                    };
                c: ISToken.ContentInterscriptContext => {
                    WITH c.content SELECT FROM
                        cv: ISToken.CharactersTVHandle => {
                            node.text _ Rope.Concat[node.text, RopeFromChars[cv]];
                            ISNode.SetContext[node, NIL, c];
                            };
                        ENDCASE => ERROR; --Only Characters should be content of CHARS$--
                    };
                e: ISToken.EndInterscriptContext => {
                    };
                ENDCASE => NULL;
            };

        PrintChars: PUBLIC ISNode.TiogaPrintProc = {
            <<[deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ 0]>>
            printedSubnode: BOOL _ FALSE;
            ISMessage.TiogaDeltaLevel[deltaLevel+1];  --+1 because we're starting a new node--
            ISMessage.WriteTiogaProp[prop: Atom.MakeAtom["ISTag"], value: "CHARS"];
            WriteTiogaProps[node];
            IF Rope.Length[node.text]=0 OR Rope.Fetch[node.text, Rope.Length[node.text]-1]#'\n
                THEN node.text _ Rope.Concat[node.text, "\n"]; --Tioga nodes end in newline--
            BEGIN
                commentBinding: ISToken.TVHandle = ObtainTaggedBinding["PROPERTIES", "Comment", node];
                ISMessage.WriteTiogaRope[rope: IO.PutFR["%g", IO.rope[node.text]], lookChars: "", comment: IF commentBinding#NIL THEN TRUE ELSE 
                FALSE];
                END;
            };


        <<Secondary Tags:>>
        <<>>
        InternalizeLooks: PUBLIC ISNode.InternalizeProc = {
            <<[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]>>
            WITH interscriptContext SELECT FROM
                bc: ISToken.BindingsInterscriptContext => {
                    FOR b: ISBinding.Handle _ NARROW[bc.bindings, ISBinding.StackHandle].top, b.previous UNTIL b=NIL DO {
                        n: Rope.ROPE = Atom.GetPName[b.name];
                        IF b=localBindingLimit THEN EXIT;
                        IF Rope.Find[n, "LOOKS"]=0 THEN {
                            l: Rope.ROPE = Rope.Substr[n, Rope.Length["LOOKS."]];
                            v: ATOM;
                            vtv: ISToken.TVHandle = b.value;
                            WITH vtv SELECT FROM
                                c: ISToken.AtomTVHandle =>
                                    v _ c.value;
                                ENDCASE => ERROR;
                            IF v = $TRUE THEN node.looks _ Rope.Concat[node.looks, l];
                            };
                        };
                        ENDLOOP;
                    };
                ENDCASE => ERROR; --This is a secondary tag, so should only get bindings--
            };

        InternalizeStyle: PUBLIC ISNode.InternalizeProc = {
            <<[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]>>
            WITH interscriptContext SELECT FROM
                b: ISToken.BindingsInterscriptContext => {
                    WITH ISBinding.ObtainBinding[Atom.MakeAtom["STYLE.FORMAT"], NARROW[b.bindings, ISBinding.StackHandle]] SELECT FROM
                        c: ISToken.CharactersTVHandle => {
                            node.format _ Atom.MakeAtom[RopeFromChars[c]];
                            };
                        ENDCASE => NULL;
                    };
                ENDCASE => ERROR; --This is a secondary tag, so should only get bindings--
            };

        InternalizeProperties: PUBLIC ISNode.InternalizeProc = {
            <<[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]>>
            WITH interscriptContext SELECT FROM
                bc: ISToken.BindingsInterscriptContext => SetTiogaProps[bc, "PROPERTIES", node, TRUE];
                ENDCASE => ERROR; --This is a secondary tag, so should only get bindings--
            };

        RopeFromChars: PROC [c: ISToken.CharactersTVHandle] RETURNS [r: Rope.ROPE] ~ {
            i: INT = IO.GetIndex[c.stream];
            charsStream: IO.STREAM _ IO.ROS[];
            t: REF TEXT = NEW[TEXT[c.length]];
            ignoreEOS: BOOL _ FALSE;
            charsRope: Rope.ROPE;
            IO.SetIndex[c.stream, c.startIndex];
            IF IO.GetBlock[c.stream, t, 0, c.length]#c.length THEN ERROR;
            charsRope _ Rope.FromRefText[t];
            FOR j: INT IN [0..Rope.Length[charsRope]) DO
                char: CHAR _ Rope.Fetch[charsRope, j];
                IF char='> THEN {
                    ignoreEOS _ NOT ignoreEOS;
                    IF ignoreEOS THEN LOOP;
                    };
                IO.PutChar[charsStream, char];
                ENDLOOP;
            r _ IO.RopeFromROS[charsStream];
            IO.SetIndex[c.stream, i];
            RETURN;
            };

        textContexts: ISNode.ContextHandle _ NIL;
        GetContexts: PROC [n: ISNode.Handle] ~ {
            FOR c: ISNode.ContextHandle _ n.contextThread, c.next UNTIL c=NIL DO
                IF c.type=$CharacterNode THEN textContexts _ NEW[ISNode.ContextRecord _ [context: c.context, next: textContexts]];
                ENDLOOP;
            };

        NextContext: PROC RETURNS [context: ISToken.InterscriptContext] ~ {
            IF textContexts=NIL THEN
                context _ NIL ELSE {
                context _ textContexts.context;
                textContexts _ textContexts.next;
                };
            RETURN;
            };
    END.