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; }; DefaultInternalizeProc: PUBLIC ISNode.InternalizeProc = { 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 = { 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: ""]; 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 = { 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 = { WITH interscriptContext SELECT FROM i: ISToken.InitialInterscriptContext => node.primaryTag _ node.tag; m: ISToken.EmbeddedInterscriptContext => { ISNode.SetContext[node, NIL, m]; }; e: ISToken.EndInterscriptContext => { }; ENDCASE => NULL; }; PrintPara: PUBLIC ISNode.TiogaPrintProc = { 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 = { 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 = { 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; }; InternalizeLooks: PUBLIC ISNode.InternalizeProc = { 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 = { 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 = { 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. ήISTiogaInternImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. MKaplan, September 13, 1985 2:05:40 pm PDT Primary Tags: [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. [deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ 0] [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext] [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext] unNests _ unNests+1; [deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ 0] [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext] [deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ 0] Secondary Tags: [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext] [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext] [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext] ΚA˜šœ™Icodešœ Οmœ1™Kšžœ˜ —šžœ žœžœ˜DKšžœ2Ÿ(˜^Kšžœ?˜C—Kšžœ˜—K˜—K˜K™ K˜šœžœ˜9KšΠckE™EK™xšžœžœž˜#˜'K˜—šœ(˜(Kšœžœ˜ —˜(Kšœžœ˜ —šœ(˜(Kšœ0žœ˜6—KšžœžœŸ5˜F—Kšœ˜—K˜•StartOfExpansionD -- [deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ -1]šœžœ˜2Kš€?™?Kšœžœžœ˜Kšœ*Ÿ)˜SKš œžœžœžœžœžœ žœ$˜Kš œ>žœ žœžœžœ˜wK˜šžœžœžœž˜$šžœ6žœžœž˜Gšžœ žœž˜šœ*ž˜/š£œžœ žœ˜)K˜#K˜ KšœK˜KKšœ1˜1K˜—šžœ žœž˜šœ˜Kšœžœžœ˜4Kšœ˜—šœ˜Kšœžœžœ˜5K˜—šœ"˜"Kšœžœžœ˜@K˜—KšžœžœŸ˜2—Kšžœ˜—˜+šžœ žœž˜˜Kšœžœ˜6Kšœ)˜)Kšœžœ˜K˜—KšžœžœŸ#˜5——Kšžœžœ˜—Kšžœ˜—Kšžœ˜—K˜—K˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜6Kš€E™Ešžœžœž˜#˜'K˜—šœ*˜*Kšœ"˜"K˜—šœ$žœŸ.˜XKšœE˜EKšžœ žœžœž˜šžœžœ žœž˜šœ*˜*Kšœžœ˜/Kšœ3˜3K˜—KšžœžœŸ&˜9—Kšžœ˜—Kšžœžœ˜—K˜—K˜Kšœ žœ˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜2Kš€E™Ešžœžœž˜#˜'K˜—šœ*˜*Kšœžœ˜ Kšœ˜—šœ%˜%K™Kšœ˜—Kšžœžœ˜—K˜K˜—–D -- [deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ -1]šœ žœ˜+Kš€?™?Kšœžœžœ˜Kšœ*Ÿ(˜RK˜K˜FK˜(šžœžœžœž˜$šžœ6žœžœž˜Gšžœ žœž˜šœ+ž˜0šžœ žœž˜˜Kšœžœ ˜*šžœžœ˜(K˜!šžœ˜šžœŸR˜WKšœ.˜.—šžœ˜K˜DKš œPžœžœžœžœžœžœ˜|K˜——K˜—šžœ˜Kšœ/˜/Kšœžœ˜K˜—K˜—KšžœžœŸ˜2—Kšžœ˜—Kšžœžœ˜—Kšžœ˜—Kšžœ˜—K˜—K˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜3Kš€E™Ešžœžœž˜#šœ)˜)K˜Kšœ˜Kšœ˜—šœ)˜)šžœ žœž˜šœ#˜#Kšœ6˜6Kšœžœ˜ K˜—KšžœžœŸ/˜A—Kšœ˜—šœ%˜%K˜—Kšžœžœ˜—K˜K˜—–D -- [deltaLevel: INT, node: ISNode.Handle] RETURNS [nests: INT _ -1]šœ žœ˜,Kš€?™?Kšœžœžœ˜Kšœ*Ÿ(˜RK˜GK˜šžœžœ4˜RKšžœ+Ÿ˜M—šž˜KšœV˜VKšœžœ žœ+žœžœžœžœžœžœ˜‡Kšžœ˜—K˜—K˜K˜K–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]™K™šœžœ˜3Kš€E™Ešžœžœž˜#˜+š žœžœ5žœžœžœ˜eKšœžœ˜%Kšžœžœžœ˜!šžœžœ˜!Kšœžœ)˜5Kšœžœ˜Kšœ ˜ šžœžœž˜šœ˜Kšœ ˜ —Kšžœžœ˜—Kšžœ žœ)˜:Kšœ˜—K˜Kšžœ˜—K˜—KšžœžœŸ8˜J—K˜—K˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜3Kš€E™Ešžœžœž˜#˜*šžœ8žœ%žœž˜ršœ"˜"Kšœ.˜.K˜—Kšžœžœ˜—K˜—KšžœžœŸ8˜J—K˜—K˜šœžœ˜8Kš€E™Ešžœžœž˜#KšœPžœ˜VKšžœžœŸ9˜J—K˜—K˜š£ œžœ!žœ žœ˜NKšœžœžœ˜Kš œ žœžœžœžœ˜"Kš œžœžœžœžœ ˜"Kšœ žœžœ˜Kšœžœ˜Kšžœ"˜$Kšžœžœ-žœžœ˜=Kšœ ˜ šžœžœžœž˜,Kšœžœ˜&šžœ žœ˜Kšœ žœ ˜Kšžœ žœžœ˜K˜—Kšžœ˜Kšžœ˜—Kšœžœ˜ Kšžœ˜Kšžœ˜K˜—K˜Kšœ%ž˜)š£ œžœ˜(šžœ3žœžœž˜DKšžœžœžœB˜rKšžœ˜—K˜—K˜š£ œžœžœ*˜Cšžœžœž˜Kšœ žœžœ˜Kšœ˜Kšœ!˜!K˜—Kšž˜K˜——šžœ˜K˜—K˜—…—.B;