ISTiogaImplsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
MKaplan, August 29, 1985 7:09:59 pm PDT
DIRECTORY
Interface USING [Item],
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],
ISTiogaImpls,
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];
ISTiogaImplsImpl: CEDAR PROGRAM
IMPORTS ISBinding, IO, ISMessage, Atom, Rope, PriorityQueue, ISNode, TiogaAccess, FS
EXPORTS ExportsList
~ 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 = {
[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
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 = {
[x: PriorityQueue.Item, y: PriorityQueue.Item, data: REF ANY ← NIL] RETURNS [BOOL]
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 = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext SELECT FROM
e: ISToken.EndInterscriptContext => BEGIN
TerminatePreviousNode[-1];
PrintTiogaFile[];
END;
ENDCASE => NULL;
};
unNests: INT ← 1;
InternalizePara: PUBLIC ISNode.InternalizeProc = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
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 = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
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 = {
[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, "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 = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
WITH interscriptContext SELECT FROM
b: ISToken.BindingsInterscriptContext => {
WITH ISBinding.ObtainBinding[Atom.MakeAtom["STYLE.FORMAT"], NARROW[b.bindings]] SELECT FROM
c: ISToken.CharactersTVHandle => {
tc: TiogaControl ← NEW[TiogaControlRec ← [style[format: Atom.MakeAtom[RopeFromChars[c]]]]];
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 = {
[node: ISNode.Handle, interscriptContext: ISToken.InterscriptContext]
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.