GetDoc:
PUBLIC
PROC [s1, s2, s3:
STREAM]
RETURNS [root: Node] ~ {
tableF: ARRAY [0..numFormats) OF ATOM;
tableP: ARRAY [0..numProps) OF ATOM;
tableL: ARRAY [0..numLooks) OF Looks;
countF, countP, countL: NAT ¬ 0;
StoreFormat:
PROC [format:
ATOM]
RETURNS [index:
BYTE ¬
BYTE.
LAST] ~ {
IF countF<numFormats THEN { tableF[index ¬ countF] ¬ format; countF ¬ countF+1 };
};
StoreProp:
PROC [prop:
ATOM]
RETURNS [index:
BYTE ¬
BYTE.
LAST] ~ {
IF countP<numProps THEN { tableP[index ¬ countP] ¬ prop; countP ¬ countP+1 };
};
StoreLooks:
PROC [looks: Looks]
RETURNS [index:
BYTE ¬
BYTE.
LAST] ~ {
IF countL<numLooks THEN { tableL[index ¬ countL] ¬ looks; countL ¬ countL+1 };
};
FetchFormat:
PROC [index:
BYTE]
RETURNS [
ATOM] ~ {
IF NOT index<countF THEN ERROR Error; RETURN [tableF[index]];
};
FetchProp:
PROC [index:
BYTE]
RETURNS [
ATOM] ~ {
IF NOT index<countP THEN ERROR Error; RETURN [tableP[index]];
};
FetchLooks:
PROC [index:
BYTE]
RETURNS [Looks] ~ {
IF NOT index<countL THEN ERROR Error; RETURN [tableL[index]];
};
ReserveFormat:
PROC [format:
ATOM, index:
BYTE] ~ {
IF StoreFormat[format]#index THEN ERROR;
};
ReserveProp:
PROC [prop:
ATOM, index:
BYTE] ~ {
IF StoreProp[prop]#index THEN ERROR;
};
ReserveLooks:
PROC [looks: Looks, index:
BYTE] ~ {
IF StoreLooks[looks]#index THEN ERROR;
};
node, parent, prev: Node ¬ NIL;
StartNode:
PROC [leaf:
BOOL, format:
ATOM] ~ {
node ¬ NEW[Tioga.NodeRep ¬ [parent: parent, format: format]];
IF prev#NIL THEN prev.next ¬ node ELSE IF parent#NIL THEN parent.child ¬ node;
IF leaf THEN prev ¬ node ELSE { parent ¬ node; prev ¬ NIL };
};
ReadProp:
PROC [name:
ATOM] = {
specs: ROPE ~ GetLenRope[s3];
value: REF ~ NodeProps.DoSpecs[name, specs];
SELECT name
FROM
$CharSets => node.charSets ¬ NARROW[value];
$CharProps => node.charProps ¬ NARROW[value];
ENDCASE => NodeProps.PutProp[node, name, value];
};
ReadLooks:
PROC
RETURNS [Looks] ~ {
looksOp: Op ~ GetOp[s3];
IF looksOp
IN [looksFirst..looksLast]
THEN {
index: BYTE ~ IndexFromOp[looksFirst, looksOp];
RETURN[FetchLooks[index]];
}
ELSE {
looks: Looks ~
SELECT looksOp
FROM
look1 => GetLookChars[s3, 1],
look2 => GetLookChars[s3, 2],
look3 => GetLookChars[s3, 3],
looks => GetLooks[s3],
ENDCASE => ERROR Error;
index: BYTE ~ StoreLooks[looks];
RETURN[looks];
};
};
ReadRuns:
PROC ~ {
p:
PROC [q:
PROC [item:
REF, repeat:
INT]] ~ {
numRuns: INT ~ GetLen[s3];
THROUGH [0..numRuns)
DO
looks: Looks ~ ReadLooks[];
repeat: INT ~ GetLen[s3];
q[TextEdit.ItemFromLooks[looks], repeat];
ENDLOOP;
};
node.runs ¬ Rosary.FromRuns[p];
};
CheckRosary:
PROC [rosary:
ROSARY, size:
INT] ~ {
IF NOT (rosary=NIL OR Rosary.Size[rosary]=size) THEN ERROR Error;
};
newlineChars: NAT ¬ 1;
ReadRope:
PROC [comment:
BOOL] ~ {
size: INT ~ GetLen[s3];
s: STREAM ~ IF comment THEN s2 ELSE s1;
node.comment ¬ comment;
node.rope ¬ IF size>0 THEN IO.GetRope[s, size, TRUE] ELSE NIL;
THROUGH [0..newlineChars) DO [] ¬ GetChar[s] ENDLOOP; -- discard newline sequence
CheckRosary[node.runs, size]; -- can check these now because the rope comes last
CheckRosary[node.charSets, size];
CheckRosary[node.charProps, size];
};
buffer: REF TEXT ~ RefText.ObtainScratch[100];
PreloadTables[ReserveFormat, ReserveProp, ReserveLooks];
DO op: Op ~ GetOp[s3];
SELECT op
FROM
startNode, startLeaf => {
format: ATOM ~ GetLenAtom[s3, buffer];
index: BYTE ~ StoreFormat[format];
StartNode[leaf: (op=startLeaf), format: format];
};
IN [startNodeFirst..startNodeLast] => {
index: BYTE ~ IndexFromOp[startNodeFirst, op];
format: ATOM ~ FetchFormat[index];
StartNode[leaf: FALSE, format: format];
};
IN [startLeafFirst..startLeafLast] => {
index: BYTE ~ IndexFromOp[startLeafFirst, op];
format: ATOM ~ FetchFormat[index];
StartNode[leaf: TRUE, format: format];
};
prop => {
name: ATOM ~ GetLenAtom[s3, buffer];
index: BYTE ~ StoreProp[name];
ReadProp[name];
};
propShort => {
index: BYTE ~ GetByte[s3];
name: ATOM ~ FetchProp[index];
ReadProp[name];
};
runs => ReadRuns[];
dataRope => ReadRope[comment: FALSE];
commentRope => ReadRope[comment: TRUE];
endNode => { prev ¬ parent; parent ¬ prev.parent };
endOfFile => EXIT;
ENDCASE => ERROR Error;
ENDLOOP;
RefText.ReleaseScratch[buffer];
IF NOT parent=NIL AND prev#NIL THEN ERROR Error;
RETURN[IF prev#NIL THEN prev ELSE node];
};
PutDoc:
PUBLIC
PROC [s1, s2, s3:
STREAM, root: Node] ~ {
tableF: ARRAY [0..numFormats) OF ATOM;
tableP: ARRAY [0..numProps) OF ATOM;
tableL: ARRAY [0..numLooks) OF Looks;
countF, countP, countL: NAT ¬ 0;
The following Find* operations just do a dumb linear search; this is much simpler than the old PGSupport, it uses only local storage, and the tables are never very large. -- DKW
FindFormat:
PROC [format:
ATOM]
RETURNS [found:
BOOL ¬
FALSE, index:
BYTE ¬ 0] ~ {
IF format=emptyAtom THEN format ¬ NIL; -- important for compatibility!
FOR i: BYTE IN [0..countF) DO IF tableF[i]=format THEN RETURN[TRUE, i] ENDLOOP;
IF countF<numFormats THEN { tableF[index ¬ countF] ¬ format; countF ¬ countF+1 };
};
FindProp:
PROC [prop:
ATOM]
RETURNS [found:
BOOL ¬
FALSE, index:
BYTE ¬ 0] ~ {
FOR i: BYTE IN [0..countP) DO IF tableP[i]=prop THEN RETURN[TRUE, i] ENDLOOP;
IF countP<numProps THEN { tableP[index ¬ countP] ¬ prop; countP ¬ countP+1 };
};
FindLooks:
PROC [looks: Looks]
RETURNS [found:
BOOL ¬
FALSE, index:
BYTE ¬ 0] ~ {
FOR i: BYTE IN [0..countL) DO IF tableL[i]=looks THEN RETURN[TRUE, i] ENDLOOP;
IF countL<numLooks THEN { tableL[index ¬ countL] ¬ looks; countL ¬ countL+1 };
};
ReserveFormat:
PROC [format:
ATOM, index:
BYTE] ~ {
IF FindFormat[format].index#index THEN ERROR;
};
ReserveProp:
PROC [prop:
ATOM, index:
BYTE] ~ {
IF FindProp[prop].index#index THEN ERROR;
};
ReserveLooks:
PROC [looks: Looks, index:
BYTE] ~ {
IF FindLooks[looks].index#index THEN ERROR;
};
newline: ROPE ~ TextEdit.GetNewlineDelimiter[root];
node: Node ¬ root;
PreloadTables[ReserveFormat, ReserveProp, ReserveLooks];
DO
leaf: BOOL ~ (node.child=NIL);
ropeSize: INT ~ Rope.Size[node.rope];
{
-- write start op and format
found: BOOL; index: BYTE;
[found, index] ¬ FindFormat[node.format];
IF found
THEN {
-- old format
PutOp[s3, OpFromIndex[(IF leaf THEN startLeafFirst ELSE startNodeFirst), index]];
}
ELSE {
-- new format
PutOp[s3, (IF leaf THEN startLeaf ELSE startNode)];
PutLenAtom[s3, node.format];
};
};
{
-- write properties
WriteProp:
PROC [name:
ATOM, value:
REF]
RETURNS [
BOOL ¬
FALSE] = {
specs: ROPE ~ NodeProps.GetSpecs[name, value];
IF specs#
NIL
THEN {
found: BOOL; index: BYTE;
[found, index] ¬ FindProp[name];
IF found THEN { PutOp[s3, propShort]; PutByte[s3, index] } -- old prop
ELSE { PutOp[s3, prop]; PutLenAtom[s3, name] }; -- new prop
PutLenRope[s3, specs];
};
};
WritePropRosary:
PROC [name:
ATOM, rosary:
ROSARY] ~ {
IF rosary=NIL THEN RETURN;
IF Rosary.Size[rosary]#ropeSize THEN ERROR;
[] ¬ WriteProp[name, rosary];
};
WritePropRosary[$CharSets, node.charSets];
WritePropRosary[$CharProps, node.charProps];
[] ¬ NodeProps.MapProps[node, WriteProp, FALSE, FALSE];
};
IF node.runs#
NIL
THEN {
-- write looks
numRuns, runsSize: INT ¬ 0;
countRuns: Rosary.RunActionType ~ { numRuns ¬ numRuns+1 };
writeRuns: Rosary.RunActionType ~ {
looks: Looks ~ TextEdit.LooksFromItem[item];
found: BOOL; index: BYTE;
[found, index] ¬ FindLooks[looks];
IF found THEN PutOp[s3, OpFromIndex[looksFirst, index]]
ELSE
SELECT CountLooks[looks]
FROM
-- must write out the looks
1 => { PutOp[s3, look1]; PutLookChars[s3, looks] };
2 => { PutOp[s3, look2]; PutLookChars[s3, looks] };
3 => { PutOp[s3, look3]; PutLookChars[s3, looks] };
ENDCASE => { PutOp[s3, looks]; PutLooks[s3, looks] };
PutLen[s3, repeat];
runsSize ¬ runsSize+repeat;
};
[] ¬ Rosary.MapRuns[[node.runs], countRuns];
PutOp[s3, runs];
PutLen[s3, numRuns];
[] ¬ Rosary.MapRuns[[node.runs], writeRuns];
IF runsSize#ropeSize THEN ERROR;
};
{
-- write the rope
s: STREAM ~ IF node.comment THEN s2 ELSE s1;
PutOp[s3, IF node.comment THEN commentRope ELSE dataRope];
PutLen[s3, ropeSize];
IO.PutRope[s, node.rope];
IO.PutRope[s, newline];
};
{
-- move to the next node
IF NOT leaf THEN node ¬ node.child -- descend in the tree
ELSE
DO
-- move to sibling or up* then sibling
IF node=root THEN GOTO Finis;
IF node.next#NIL THEN { node ¬ node.next; EXIT }; -- sibling
node ¬ node.parent; -- parent
PutOp[s3, endNode];
ENDLOOP;
};
REPEAT Finis => PutOp[s3, endOfFile];
ENDLOOP;
};