DIRECTORY
Atom USING [MakeAtom, GetPName, PutPropOnList, PropList, DottedPair, DottedPairNode],
FS USING [StreamOpen],
IO USING [GetBlock, GetIndex, SetIndex, STREAM, EndOfStream, rope, PutF, PutChar, int, atom],
Rope USING [ROPE, Find, Length, Substr, FromRefText, Equal, Concat, Fetch],
PriorityQueue USING [Create, Insert, Remove, Empty, Ref, SortPred],
TiogaAccess USING [Looks, Create, TiogaChar, Writer, WriteFile, Put, GetInternalProp, Reset],
ISMessage USING [GetIndex, PutF, CloseTempFile, ReopenTempFile, GetTempFileChar],
ISBinding USING [ObtainBinding, Handle, StackHandle, Anchor],
ISToken USING [InitialInterscriptContext, EmbeddedInterscriptContext, EndInterscriptContext, ContentInterscriptContext, BindingsInterscriptContext, TVHandle, CharactersTVHandle, --NodeTVHandle,-- AtomTVHandle, InterscriptContext],
ISNode USING [InternalizeProc, HasTag, --SetContext, GetContext,-- Handle, ContextHandle, ContextRecord];


ISImplProcs: CEDAR PROGRAM
IMPORTS ISBinding, IO, ISMessage, Atom, Rope, PriorityQueue, ISNode, TiogaAccess, FS
~ BEGIN

localBindingLimit: PUBLIC ISBinding.Anchor;

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]]];
v: Rope.ROPE;
vtv: ISToken.TVHandle = b.value;
WITH vtv SELECT FROM
c: ISToken.CharactersTVHandle =>
v _ RopeFromChars[c];
ENDCASE => ERROR;
BEGIN
tc: TiogaControl _ NEW[TiogaControlRec _ [property[prop: NARROW[p], value: NARROW[v]]]];
prop: Atom.DottedPair _ NEW[Atom.DottedPairNode _ [key: NEW[INT _ node.textIndex], val: tc]];
PriorityQueue.Insert[tiogaControlInfo, prop];
END;
};
};
ENDLOOP;

};

DefaultInternalizeProc: PUBLIC ISNode.InternalizeProc = {
WITH interscriptContext SELECT FROM
ic: ISToken.InitialInterscriptContext => {
TerminatePreviousNode[-(unNests-1)];
unNests _ 0;
BEGIN
tc: TiogaControl _ NEW[TiogaControlRec _ [looks[lookChars: (charsNodeLooks _ "e")]]];
look: Atom.DottedPair _ NEW[Atom.DottedPairNode _ [key: NEW[INT _ ISMessage.GetIndex[]], val: tc]];
PriorityQueue.Insert[tiogaControlInfo, look];
END;
ISMessage.PutF["[%g$ node]\n", IO.atom[IF node.tag=NIL THEN $Anonymous ELSE node.tag]];
node.textIndex _ ISMessage.GetIndex[]-1;
};
bc: ISToken.BindingsInterscriptContext =>
SetTiogaProps[bc, Atom.GetPName[node.tag], node, TRUE];
ec: ISToken.EndInterscriptContext => BEGIN
tc: TiogaControl _ NEW[TiogaControlRec _ [property[prop: $ISWonderNode, value: Atom.GetPName[node.tag]]]];
prop: Atom.DottedPair _ NEW[Atom.DottedPairNode _ [key: NEW[INT _ node.textIndex], val: tc]];
PriorityQueue.Insert[tiogaControlInfo, prop];
unNests _ unNests+1;
END;
ENDCASE => NULL; --No special action on contents of Nodes of Wonder.--
};

TempFilePred: PriorityQueue.SortPred = {
RETURN[NARROW[NARROW[x, Atom.DottedPair].key, REF INT]^ < NARROW[NARROW[y, Atom.DottedPair].key, REF INT]^]; 
};
tiogaControlInfo: PriorityQueue.Ref = PriorityQueue.Create[TempFilePred];
TiogaControlType: TYPE ~ {looks, nest, style, property};
TiogaControlRec: TYPE ~ RECORD[
body: SELECT type: TiogaControlType FROM
looks => [lookChars: Rope.ROPE],
nest => [deltaLevel: INT],
style => [format: ATOM],
property => [prop: ATOM, value: Rope.ROPE],
ENDCASE _ NULL];
TiogaControl: TYPE ~ REF TiogaControlRec;
LooksTiogaControl: TYPE ~ REF looks TiogaControlRec;
NestTiogaControl: TYPE ~ REF nest TiogaControlRec;
StyleTiogaControl: TYPE ~ REF style TiogaControlRec;
PropertyTiogaControl: TYPE ~ REF property TiogaControlRec;

InternalizeDocument: PUBLIC ISNode.InternalizeProc = {
WITH interscriptContext SELECT FROM
e: ISToken.EndInterscriptContext => BEGIN
TerminatePreviousNode[-1];
PrintTiogaFile[];
END;
ENDCASE => NULL;
};

unNests: INT _ 1;
InternalizePara: PUBLIC ISNode.InternalizeProc = {
WITH interscriptContext SELECT FROM
i: ISToken.InitialInterscriptContext => {
TerminatePreviousNode[-(unNests-1)];
unNests _ 0;
};
nc: ISToken.EmbeddedInterscriptContext => {
n: ISNode.Handle _ NARROW[nc.content.isnode];
IF ISNode.HasTag[n, $CHARS] THEN node.textIndex _ n.textIndex;
};
e: ISToken.EndInterscriptContext => {
unNests _ unNests+1;
};
ENDCASE => NULL;
};

charsNodeText: Rope.ROPE;
lastLooks: Rope.ROPE _ "";
charsNodeLooks: Rope.ROPE;
InternalizeChars: PUBLIC ISNode.InternalizeProc = {
WITH interscriptContext SELECT FROM
i: ISToken.InitialInterscriptContext => {
charsNodeText _ "";
lastLooks _ charsNodeLooks;
charsNodeLooks _ "";
node.lastNodeEnd _ ISMessage.GetIndex[]-1;
node.parent _ NARROW[i.parent];
};
c: ISToken.ContentInterscriptContext => {
WITH c.content SELECT FROM
cv: ISToken.CharactersTVHandle => {
charsNodeText _ Rope.Concat[charsNodeText, RopeFromChars[cv]];
};
ENDCASE => ERROR;
};
e: ISToken.EndInterscriptContext => {
IF unNests#0 THEN TerminatePreviousNode[IF node.parent.tag=$PARA THEN -unNests ELSE -(unNests-1)];
IF NOT Rope.Equal[charsNodeLooks, lastLooks] THEN {
tc: TiogaControl _ NEW[TiogaControlRec _ [looks[lookChars: charsNodeLooks]]];
look: Atom.DottedPair _ NEW[Atom.DottedPairNode _ [key: NEW[INT _ ISMessage.GetIndex[]], val: tc]];
PriorityQueue.Insert[tiogaControlInfo, look];
};
ISMessage.PutF["%g", IO.rope[charsNodeText]];
node.textIndex _ ISMessage.GetIndex[]-1;
IF node.parent.tag#$PARA THEN unNests _ 1;
};
ENDCASE => NULL;
};

TerminatePreviousNode: PROC [deltaLevel: INT] ~ {
TerminateNodeAt[ISMessage.GetIndex[]-1, deltaLevel];
};

TerminateNodeAt: PROC [index: INT, deltaLevel: INT] ~ {
eop: Atom.DottedPair;
tc: TiogaControl _ NEW[TiogaControlRec _ [nest[deltaLevel: deltaLevel]]];
eop _ NEW[Atom.DottedPairNode _ [key: NEW[INT _ index], val: tc]];
PriorityQueue.Insert[tiogaControlInfo, eop];
};

RopeFromChars: PROC [c: ISToken.CharactersTVHandle] RETURNS [r: Rope.ROPE] ~ {
i: INT = IO.GetIndex[c.stream];
t: REF TEXT = NEW[TEXT[c.length]];
IO.SetIndex[c.stream, c.startIndex];
IF IO.GetBlock[c.stream, t, 0, c.length]#c.length THEN ERROR;
r _ Rope.FromRefText[t];
IO.SetIndex[c.stream, i];
RETURN;
};

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, "LOOK"]=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 charsNodeLooks _ Rope.Concat[charsNodeLooks, l];
};
};
ENDLOOP;
};
ENDCASE => ERROR;
};

InternalizeStyle: PUBLIC ISNode.InternalizeProc = {
WITH interscriptContext SELECT FROM
b: ISToken.BindingsInterscriptContext => {
WITH ISBinding.ObtainBinding[Atom.MakeAtom["STYLE.FORMAT"], NARROW[b.bindings]] SELECT FROM
a: ISToken.AtomTVHandle => {
tc: TiogaControl _ NEW[TiogaControlRec _ [style[format: a.value]]];
style: Atom.DottedPair _ NEW[Atom.DottedPairNode _ [key: NEW[INT _ node.textIndex], val: tc]];
PriorityQueue.Insert[tiogaControlInfo, style];
};
ENDCASE => ERROR;
};
ENDCASE => NULL;
};

InternalizeProperties: PUBLIC ISNode.InternalizeProc = {
WITH interscriptContext SELECT FROM
bc: ISToken.BindingsInterscriptContext => SetTiogaProps[bc, "PROPERTIES", node];
ENDCASE => ERROR;
};

PrintTiogaFile: PROC ~ {
tempFileIndex: INT _ 0;
out: TiogaAccess.Writer _ TiogaAccess.Create[];
nullTiogaChar: TiogaAccess.TiogaChar = [
charSet: 0,
char: 'x,
looks: ALL[FALSE],
format: NIL,
comment: FALSE,
endOfNode: FALSE,
deltaLevel: 0,
propList: NIL
];
tiogaChar: TiogaAccess.TiogaChar _ nullTiogaChar;
i: Atom.DottedPair _ NARROW[PriorityQueue.Remove[tiogaControlInfo]];
controlIndex: INT;
dump: IO.STREAM _ FS.StreamOpen["ISTest.dump", $create];
looks: TiogaAccess.Looks;

WriteTiogaChar: PROC ~ {
tiogaChar.looks _ looks;
tiogaChar.char _ ISMessage.GetTempFileChar[];
IF tiogaChar.char='> THEN 
IF ISMessage.GetTempFileChar[]='> THEN tempFileIndex _ tempFileIndex+1
ELSE ERROR; --any other '> should be an end of IS string, and should not be there--
IO.PutChar[dump, tiogaChar.char];
TiogaAccess.Put[out, tiogaChar];
tiogaChar _ nullTiogaChar;
tempFileIndex _ tempFileIndex+1;
};

TiogaAccess.Reset[out];
ISMessage.CloseTempFile[];
ISMessage.ReopenTempFile[];
WHILE i#NIL DO {
controlIndex _ NARROW[i.key, REF INT]^;
IO.PutF[dump,"(controlIndex=%g)",IO.int[controlIndex]];
WHILE tempFileIndex < controlIndex DO 
WriteTiogaChar[
! IO.EndOfStream => ERROR --tiogaControlInfo should be empty before EOF--];
ENDLOOP;
DO {
WITH NARROW[i.val, TiogaControl] SELECT FROM
l: LooksTiogaControl =>  {
looks _ ALL[FALSE];
FOR j: INT IN [0..Rope.Length[l.lookChars]) DO
looks[Rope.Fetch[l.lookChars, j]] _ TRUE;
ENDLOOP;
IO.PutF[dump,"(looks: %g)", IO.rope[l.lookChars]];
};
n: NestTiogaControl => {
tiogaChar.endOfNode _ TRUE;
tiogaChar.deltaLevel _ n.deltaLevel;
IO.PutF[dump,"(deltaLevel: %g)", IO.int[tiogaChar.deltaLevel]];
};
s: StyleTiogaControl => {
tiogaChar.format _ s.format;
IO.PutF[dump,"(format: %g)", IO.atom[s.format]];
};
p: PropertyTiogaControl => {
tiogaChar.propList _ Atom.PutPropOnList[tiogaChar.propList, p.prop, TiogaAccess.GetInternalProp[p.prop, p.value]];
IO.PutF[dump,"(property %g=%g)", IO.atom[p.prop], IO.rope[p.value]];
};
ENDCASE => ERROR;
IF NOT PriorityQueue.Empty[tiogaControlInfo] THEN 
i _ NARROW[PriorityQueue.Remove[tiogaControlInfo]]
ELSE {
i _ NIL;
EXIT;
};
IF NARROW[i.key, REF INT]^#controlIndex THEN EXIT;
};
ENDLOOP;
};
ENDLOOP;
DO 
WriteTiogaChar[
! IO.EndOfStream => EXIT];
ENDLOOP;
TiogaAccess.WriteFile[out, "ISTest.tioga"];
};

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.


fISImplProcs.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
MKaplan, August 29, 1985 2:50:24 am PDT


Interface USING [
Item],
EXPORTS 
ExportsList
[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.
[x: PriorityQueue.Item, y: PriorityQueue.Item, data: REF ANY _ NIL] RETURNS [BOOL]
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
ΚŸ˜™Icodešœ
Οm
œ1™<K™'K™—š
Οk	˜	Kšœžœ
™KšœžœK˜UKšžœ
žœ˜Kšžœ
žœ žœ-˜]Kšœžœžœ;˜KKšœžœ0˜CKšœžœL˜]Kšœ
žœB˜QKšœ
žœ.˜=Kšœžœ₯
Οcœ%˜ζ
KšœžœŸœ)˜i—K˜K˜KšΠlnœž
˜Kšžœžœ=ž˜TKšžœ™Kšœž˜˜Kšœžœ˜+K˜š
Οn
œžœ4žœ#žœžœ˜Kšœ
žœ˜*š
žœžœ5žœžœ
žœ˜eKšœžœ˜%Kšžœžœ
žœ
˜!šžœžœ˜ Kš	œžœžœžœžœ4˜fKšœžœ
˜
Kš
œ ˜ šžœžœ
ž˜š
œ ˜ Kš
œ˜—Kšžœžœ
˜—š
ž˜Kšœžœ#žœžœ˜XKšœžœžœ
žœ˜]Kš
œ-˜-Kšžœ
˜—K˜—K˜Kšžœ
˜—K˜K˜—K˜•StartOfExpansionH -- [node: ISNode.Handle, interscriptContext: ISNode.InterscriptContext]šœžœ˜9Kš
ΠckE™EK™xšžœžœ
ž˜#š
œ*˜*Kš
œ$˜$K˜š
ž˜Kšœžœ?˜UKšœžœžœ
žœ$˜cKš
œ-˜-Kšžœ
˜—Kšœžœžœ
žœ
žœžœ˜WK˜(Kš
œ˜—š
œ)˜)Kšœ1žœ˜7—šœ%ž˜*KšœžœT˜jKšœžœžœ
žœ˜]Kš
œ-˜-K˜Kšžœ
˜—KšžœžœŸ5˜F—Kš
œ˜—K˜–V -- [x: PriorityQueue.Item, y: PriorityQueue.Item, data: REF ANY _ NIL] RETURNS [BOOL]š
œ(˜(Kš
’R™RKšžœ
žœ
žœžœ
žœžœ
žœžœ˜mK˜—Kš
œI˜IKšœžœ"˜8šœžœžœ
˜šœžœž˜(Kšœžœ˜ Kšœžœ˜Kšœžœ˜Kšœžœžœ˜+Kšžœžœ˜——Kšœžœžœ˜)Kšœžœžœ˜4Kšœžœžœ˜2Kšœžœžœ˜4Kšœžœžœ˜:K˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜6Kš
’E™Ešžœžœ
ž˜#šœ$ž˜)K˜Kš
œ˜Kšžœ
˜—Kšžœžœ
˜—K˜—K˜Kšœ	žœ˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜2Kš
’E™Ešžœžœ
ž˜#š
œ)˜)Kš
œ$˜$Kš
œ˜K˜—š
œ+˜+Kšœžœ˜-Kšžœžœ˜>Kš
œ˜—š
œ%˜%K˜Kš
œ˜—Kšžœžœ
˜—K˜—K˜Jšœžœ
˜Kšœžœ˜Kšœžœ
˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜3Kš
’E™Ešžœžœ
ž˜#š
œ)˜)Kš
œ˜K˜K˜Kš
œ*˜*Kšœžœ˜K˜—š
œ)˜)šžœžœ
ž˜š
œ#˜#Kš
œ>˜>K˜—Kšžœžœ
˜—Kš
œ˜—š
œ%˜%Kš
žœ
žœžœžœ
žœ˜bšžœ
žœ'žœ˜3Kšœžœ7˜MKšœžœžœ
žœ$˜cKš
œ-˜-K˜—Kšœžœ˜-Kš
œ(˜(Kšžœžœ
˜*K˜—Kšžœžœ
˜—K˜—K˜šΠbnœžœžœ˜1Kš
œ4˜4K˜—K˜š£œžœ	žœžœ˜7Kš
œ˜Kšœžœ3˜IKšœžœžœ
žœ˜BKš
œ,˜,K˜K˜—š‘
œžœ!žœ
žœ˜NKšœžœžœ˜Kš	œžœ
žœžœ
žœ˜"Kšžœ"˜$Kšžœ
žœ-žœ
žœ
˜=Kš
œ˜Kšžœ˜Kšžœ
˜K˜—K˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜3Kš
’E™Ešžœžœ
ž˜#˜+š
žœžœ5žœžœ
žœ˜eKšœžœ˜%Kšžœžœ
žœ
˜!šžœžœ˜ Kšœžœ)˜5Kšœžœ
˜Kš
œ ˜ šžœžœ
ž˜š
œ˜Kš
œ˜—Kšžœžœ
˜—Kšžœžœ1˜BKš
œ˜—K˜Kšžœ
˜—K˜—Kšžœžœ
˜—K˜—K˜–I -- [node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]šœžœ˜3Kš
’E™Ešžœžœ
ž˜#˜*šžœ8žœžœ
ž˜[š
œ˜Kšœžœ-˜CKšœžœžœ
žœ˜^Kš
œ.˜.K˜—Kšžœžœ
˜—K˜—Kšžœžœ
˜—K˜—K˜šœžœ˜8Kš
’E™Ešžœžœ
ž˜#K˜PKšžœžœ
˜—K˜—K˜š‘œžœ˜Kšœžœ˜K˜/š
œ(˜(Kš
œ˜Kš
œ	˜	Kšœžœ
žœ˜Kšœžœ
˜Kšœ	žœ
˜Kšœžœ
˜K˜Kšœ
ž˜
Kš
œ˜—Kš
œ1˜1Kšœžœ)˜DKšœžœ
˜Kšœžœ
žœžœ$˜8Kš
œ˜K˜š‘œžœ˜Kš
œ˜Kš
œ-˜-šžœžœ
˜šžœžœ ˜FKšžœ
žœŸG˜S——Kšžœ˜!Kš
œ ˜ K˜K˜ K˜K˜—K˜K˜K˜šžœžœ
žœ˜Kšœžœžœ
žœ˜'Kšžœžœ˜7šžœžœ
˜&˜Kšœžœžœ
Ÿ/œ˜K—Kšžœ
˜—šžœ˜šžœ
žœžœ
ž˜,š
œ˜Kšœžœ
žœ˜šžœžœ
žœž˜.Kšœ$žœ
˜)Kšžœ
˜—Kšžœ0˜2K˜—š
œ˜Kšœžœ
˜K˜$Kšžœžœ˜?K˜—š
œ˜K˜Kšžœžœ˜0Kš
œ˜—š
œ˜Kš
œr˜rKšžœžœžœ˜DKš
œ˜—Kšžœžœ
˜—šžœ
žœ'žœ
˜2Kšœžœ(˜2—šžœ˜Kšœž˜Kšžœ
˜K˜—Kšžœ
žœžœ
žœžœ
žœ
˜2K˜Kšžœ
˜—K˜Kšžœ
˜šžœ
˜˜Kšœžœžœ˜—Kšžœ
˜—K˜+—K˜—K˜Kšœ%ž˜)š‘œžœ˜(šžœ3žœžœ
ž˜DKšžœžœžœB˜rKšžœ
˜—K˜—K˜š‘œžœ
žœ*˜Cšžœžœ
ž˜Kšœ
žœ
žœ˜Kš
œ˜Kš
œ!˜!K˜—Kš
ž˜K˜——šžœ
˜K˜—K˜—…—(R:W