<> <> <> <> <> DIRECTORY IO, IOUtils, NodeProps, Rope, TextNode, TiogaFileOps, TiogaStreams; TiogaStreamsImpl: CEDAR PROGRAM IMPORTS IO, IOUtils, NodeProps, Rope, TextNode, TiogaFileOps EXPORTS TiogaStreams = BEGIN OPEN TN: TextNode, TFO: TiogaFileOps; ROPE: TYPE = Rope.ROPE; CommentHandling: TYPE = TiogaStreams.CommentHandling; DepthOp: TYPE = TiogaStreams.DepthOp; NotNow: PUBLIC ERROR [s: IO.STREAM] = CODE; BadDepth: PUBLIC ERROR [s: IO.STREAM, depth: INT] = CODE; CallerBug: PUBLIC ERROR [s: IO.STREAM, message: ROPE] = CODE; IsATS: PUBLIC PROC [s: IO.STREAM] RETURNS [is: BOOLEAN] = {is ¬ s # NIL AND s.streamData # NIL AND ( ISTYPE[s.streamData, TiogaInStreamData] OR ISTYPE[s.streamData, TiogaOutStreamData]); }; TiogaInStreamData: TYPE = REF TiogaInStreamDataRep; TiogaInStreamDataRep: TYPE = RECORD [ ch: CommentHandling, end: BOOLEAN ¬ FALSE, next, nodeLen, nodeRLen, nodeUrLen, nodePrefixLength: INT ¬ 0, depth, indexAtNodeStart, index: INT ¬ 0, nodeRope: ROPE ¬ NIL, levelPrefix: ROPE, node, root: TN.Ref]; CreateInput: PUBLIC PROC [from: TN.Ref, commentHandling: CommentHandling ¬ [FALSE[]], levelPrefix: ROPE ¬ NIL] RETURNS [in: IO.STREAM] = BEGIN sd: TiogaInStreamData ¬ NEW [TiogaInStreamDataRep ¬ [ ch: commentHandling, levelPrefix: levelPrefix, node: NIL, root: from ]]; GoToBeginning[sd]; in ¬ IO.CreateStream[streamProcs: tiogaInStreamProcs, streamData: sd]; END; GoToBeginning: PROC [sd: TiogaInStreamData] = { dd: INT; IF sd.root = NIL THEN {sd.end ¬ TRUE; RETURN}; [sd.node, dd] ¬ TN.Forward[sd.root]; IF sd.node = NIL THEN {sd.end ¬ TRUE; RETURN}; SELECT dd FROM <1 => {sd.end ¬ TRUE; RETURN}; =1 => { sd.end ¬ FALSE; sd.depth ¬ 1; sd.indexAtNodeStart ¬ 0; NodeHello[sd]; }; ENDCASE => ERROR; }; TryForNextChar: PROC [sd: TiogaInStreamData] = BEGIN IF sd.end THEN RETURN; WHILE sd.next >= sd.nodeLen DO dd: INT; next: TN.Ref; [next, dd] ¬ TN.Forward[sd.node]; IF sd.depth+dd <= 0 OR next = NIL THEN {sd.end ¬ TRUE; RETURN}; sd.next ¬ sd.next - sd.nodeLen; sd.depth ¬ sd.depth + dd; sd.indexAtNodeStart ¬ sd.indexAtNodeStart + sd.nodeLen; sd.node ¬ next; NodeHello[sd]; ENDLOOP; END; NodeHello: PROC [sd: TiogaInStreamData] = BEGIN tn: TN.RefTextNode ¬ sd.node; Use: PROC [prefix, suffix: ROPE] = { IF sd.levelPrefix.Length[] # 0 THEN THROUGH [1 .. sd.depth) DO prefix ¬ sd.levelPrefix.Concat[prefix]; ENDLOOP; sd.nodePrefixLength ¬ prefix.Length[]; sd.nodeRope ¬ prefix.Concat[NodeRope[tn]].Concat[suffix]; sd.nodeRLen ¬ sd.nodeRope.Length[]; sd.nodeUrLen ¬ NodeRope[tn].Length[]; sd.nodeLen ¬ sd.nodeRLen + 1}; IF tn.comment THEN TRUSTED {WITH x: sd.ch SELECT FROM FALSE => { sd.nodeRope ¬ NIL; sd.nodeRLen ¬ sd.nodeUrLen ¬ sd.nodeLen ¬ sd.nodePrefixLength ¬ 0}; TRUE => Use[x.prefix, x.suffix]; ENDCASE => ERROR} ELSE Use[NIL, NIL]; END; tiogaInStreamProcs: REF IO.StreamProcs ¬ IO.CreateStreamProcs[variety: input, class: $TiogaInStream, getChar: GetChar, endOf: EndOf, backup: BackupIn, getIndex: GetInIndex, setIndex: SetInIndex]; GetChar: PROC [self: IO.STREAM] RETURNS [char: CHAR] = { sd: TiogaInStreamData ¬ NARROW[self.streamData]; TryForNextChar[sd]; IF sd.end THEN ERROR IO.EndOfStream[self]; char ¬ IF sd.next 0, TRUE => rawSize + 1 + prefix.Length[] + suffix.Length[], ENDCASE => ERROR}; [next, dd] ¬ TN.Forward[of]; IF dd > 1 THEN ERROR; IF dd < 1 THEN RETURN; dd ¬ dd - 1; WHILE dd = 0 DO ddi: INT; [next, dd, ddi] ¬ Work[next]; di ¬ di + ddi; ENDLOOP; dd ¬ dd + 1; }; new: TN.Ref; dd, di, newStart: INT; TryForNextChar[sd]; [new, dd, di] ¬ Work[sd.node]; newStart ¬ sd.indexAtNodeStart + di; IF newStart < sd.index THEN ERROR; sd.index ¬ newStart; IF sd.depth+dd <= 0 OR new = NIL THEN {sd.end ¬ TRUE; RETURN}; sd.node ¬ new; sd.indexAtNodeStart ¬ newStart; sd.depth ¬ sd.depth + dd; sd.next ¬ 0; NodeHello[sd]; }; TiogaOutStreamData: TYPE = REF TiogaOutStreamDataRep; TiogaOutStreamDataRep: TYPE = RECORD [ breakAtNewline, parsePrefix, flexilevel, tabsWhite, adjApp, adjFmt: BOOL, levelPrefix: ROPE, spacesPerTab, nni, mini, maxi: INT, root: TFO.Ref ¬ NIL, nodes: LIST OF TFO.Ref ¬ NIL, indents: LIST OF INT ¬ NIL, --indents.first goes with nodes.first ready: BOOLEAN ¬ FALSE, lpCharsSeen, lpLength: INT ¬ 0, nodeDepth: INT ¬ 0, --actual Tioga depth of nodes.first userDepth: INT ¬ 0, --where user thinks she is cpl, csl, cbl: INT ¬ 0, --len of comment prefix, suffix, both nextDepth, deltaDepth, indent: INT ¬ 0, ch: CommentHandling, fmts: RopeSeq ¬ NIL, contents: ROPE ¬ NIL, defaultFormat: ROPE ¬ NIL, comment: BOOL ¬ FALSE, looks: ARRAY Look OF LooksRuns ¬ ALL[NIL]]; RopeSeq: TYPE ~ REF RopeSequence; RopeSequence: TYPE ~ RECORD [elts: SEQUENCE length: NAT OF ROPE]; LooksRuns: TYPE = LIST OF LooksRun; LooksRun: TYPE = RECORD [first, afterLast: INT]; Look: TYPE = CHAR['a .. 'z]; notClosed: INT = -1; CreateOutput: PUBLIC PROC [to: TFO.Ref, breakAtNewline: BOOL ¬ FALSE, levelPrefix, defaultFormat: ROPE ¬ NIL, flexilevel: BOOL ¬ FALSE, spacesPerTab, normalNestIndent, minFmtIndent: INT ¬ 0, maxFmtIndent: INT ¬ -1, commentHandling: CommentHandling ¬ [FALSE[]] ] RETURNS [out: IO.STREAM] = BEGIN adjFmt: BOOL ~ maxFmtIndent>=minFmtIndent; sd: TiogaOutStreamData ¬ NEW [TiogaOutStreamDataRep ¬ [ breakAtNewline: breakAtNewline, parsePrefix: levelPrefix#NIL OR flexilevel, flexilevel: flexilevel, tabsWhite: spacesPerTab>0, adjApp: normalNestIndent>0 AND NOT adjFmt, adjFmt: adjFmt, levelPrefix: levelPrefix, spacesPerTab: spacesPerTab, nni: normalNestIndent, mini: minFmtIndent, maxi: maxFmtIndent, root: to, nodes: LIST[to], indents: LIST[-(IF normalNestIndent>0 THEN normalNestIndent ELSE 1)], lpLength: levelPrefix.Length[], nextDepth: 1, userDepth: 1, ch: commentHandling, defaultFormat: defaultFormat ]]; pfp: IOUtils.PFProcs; IF adjFmt THEN { sd.fmts ¬ NEW [RopeSequence[1+maxFmtIndent-minFmtIndent]]; FOR i: NAT IN [0..sd.fmts.length) DO sd.fmts[i] ¬ NIL ENDLOOP}; TRUSTED {WITH x: sd.ch SELECT FROM FALSE => NULL; TRUE => sd.cbl ¬ (sd.cpl ¬ x.prefix.Length) + (sd.csl ¬ x.suffix.Length); ENDCASE => ERROR}; out ¬ IO.CreateStream[streamProcs: tiogaOutStreamProcs, streamData: sd]; pfp ¬ IOUtils.CopyPFProcs[out]; [] ¬ IOUtils.SetPFCodeProc[pfProcs: pfp, char: 'l, codeProc: FormatL]; [] ¬ IOUtils.SetPFCodeProc[pfProcs: pfp, char: 'n, codeProc: FormatN]; [] ¬ IOUtils.SetPFProcs[stream: out, pfProcs: pfp]; PrepareForChar[out, sd]; END; tiogaOutStreamProcs: REF IO.StreamProcs ¬ IO.CreateStreamProcs[variety: output, class: $TiogaOutStream, putChar: PutChar, putBlock: PutBlock, close: CloseOut]; PutChar: PROC [self: IO.STREAM, char: CHAR] = BEGIN sd: TiogaOutStreamData ¬ NARROW[self.streamData]; SELECT TRUE FROM sd.breakAtNewline AND IsLB[char] => {EndNode[self, reset, FALSE]; RETURN}; sd.ready OR NOT sd.parsePrefix => NULL; sd.flexilevel => IF char=' OR sd.tabsWhite AND char='\t THEN { sd.indent ¬ sd.indent + (IF char#' THEN sd.spacesPerTab ELSE 1); RETURN}; char = sd.levelPrefix.Fetch[sd.lpCharsSeen] => { sd.lpCharsSeen ¬ sd.lpCharsSeen + 1; IF sd.lpCharsSeen = sd.lpLength THEN {sd.lpCharsSeen ¬ 0; sd.nextDepth ¬ sd.nextDepth + 1}; RETURN}; ENDCASE => NULL; PrepareForChar[self, sd]; sd.contents ¬ sd.contents.Concat[Rope.FromChar[char]]; END; PutBlock: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex, count: NAT] = BEGIN sd: TiogaOutStreamData ¬ NARROW[self.streamData]; next: NAT ¬ startIndex; afterLast: NAT ¬ startIndex + count; WHILE next < afterLast DO nextCR, subsize: NAT; WHILE (NOT sd.ready) OR IsLB[block[next]] DO PutChar[self, block[next]]; next ¬ next + 1; IF next >= afterLast THEN RETURN; ENDLOOP; FOR nextCR ¬ next, nextCR + 1 WHILE nextCR < afterLast AND ~IsLB[block[nextCR]] DO NULL ENDLOOP; IF (subsize ¬ nextCR - next) # 0 THEN { sd.contents ¬ sd.contents.Concat[RopeFromSubText[block, next, subsize]]; next ¬ nextCR; }; ENDLOOP; END; CloseOut: PROC [self: IO.STREAM, abort: BOOL ¬ FALSE] = BEGIN EndNode[self]; IOUtils.AmbushStream[self: self, streamProcs: IOUtils.closedStreamProcs, streamData: NIL]; END; CurOutNode: PUBLIC PROC [s: IO.STREAM] RETURNS [n: TFO.Ref] = BEGIN sd: TiogaOutStreamData ¬ NARROW[s.streamData]; n ¬ sd.nodes.first; END; SetFormat: PUBLIC PROC [of: IO.STREAM, format: ROPE] = BEGIN n: TFO.Ref ¬ CurOutNode[of]; TFO.SetFormat[n, format]; END; FormatL: PROC [stream: IO.STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR] = { sd: TiogaOutStreamData ¬ NARROW[stream.streamData]; PrepareForChar[stream, sd]; WITH val SELECT FROM rv: IO.Value[rope] => LooksWork[stream, sd, rv.value]; ENDCASE => ERROR IO.Error[PFUnprintableValue, stream]; }; FormatN: PROC [stream: IO.STREAM, val: IO.Value, format: IOUtils.Format, char: CHAR] = { sd: TiogaOutStreamData ¬ NARROW[stream.streamData]; PrepareForChar[stream, sd]; WITH val SELECT FROM x: IO.Value[boolean] => sd.comment ¬ x.value; ENDCASE => ERROR IO.Error[PFUnprintableValue, stream]; }; LooksWork: PROC [stream: IO.STREAM, sd: TiogaOutStreamData, chars: ROPE] = { index: INT ¬ sd.contents.Length[]; FOR i: INT IN [0 .. chars.Length[]) DO c: CHAR ¬ chars.Fetch[i]; SELECT c FROM ' => LooksWork[stream, sd, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"]; IN ['a .. 'z] => { IF sd.looks[c] = NIL OR sd.looks[c].first.afterLast # notClosed THEN sd.looks[c] ¬ CONS[[first: index, afterLast: notClosed], sd.looks[c]] }; IN ['A .. 'Z] => {l: Look ¬ c + ('a - 'A); IF sd.looks[l] # NIL AND sd.looks[l].first.afterLast = notClosed THEN sd.looks[l].first.afterLast ¬ index; }; ENDCASE => ERROR IO.Error[PFUnprintableValue, stream]; ENDLOOP; }; EndNode: PUBLIC PROC [s: IO.STREAM, depthOp: DepthOp ¬ reset, idempotently: BOOLEAN ¬ FALSE] = BEGIN sd: TiogaOutStreamData ~ NARROW[s.streamData]; cl: INT ~ sd.contents.Length[]; pref, suf: INT ¬ 0; cmt: BOOL ¬ sd.comment; IF NOT sd.ready THEN BEGIN IF idempotently THEN RETURN; PrepareForChar[s, sd]; END; TRUSTED {WITH x: sd.ch SELECT FROM FALSE => NULL; TRUE => IF cl>=sd.cbl AND x.prefix.EqualSubstrs[s2: sd.contents, len2: sd.cpl] AND x.suffix.EqualSubstrs[s2: sd.contents, start2: cl-sd.csl] THEN {cmt ¬ TRUE; pref ¬ sd.cpl; suf ¬ sd.csl}; ENDCASE => ERROR}; TFO.SetContents[sd.nodes.first, sd.contents.Substr[start: pref, len: cl-pref-suf]]; IF cmt THEN SetTFOComment[sd.nodes.first]; SetLooks[sd, pref, suf]; sd.ready ¬ FALSE; sd.lpCharsSeen ¬ sd.deltaDepth ¬ sd.indent ¬ 0; sd.contents ¬ NIL; sd.nextDepth ¬ SELECT depthOp FROM same => sd.userDepth, reset => 1, ENDCASE => ERROR; END; SetLooks: PROC [sd: TiogaOutStreamData, pre, suf: INT] = { len: INT ¬ sd.contents.Length[]; FOR l: Look IN Look DO FOR lr: LooksRuns ¬ sd.looks[l], lr.rest WHILE lr # NIL DO start: INT ~ MAX[lr.first.first, pre]; afterLast: INT ¬ IF lr.first.afterLast = notClosed THEN len ELSE lr.first.afterLast; afterLast ¬ MIN[len-suf, afterLast]; IF afterLast>start THEN TFO.AddLooks[x: sd.nodes.first, start: start-pre, len: afterLast - start, look: l, root: sd.root]; ENDLOOP; ENDLOOP; sd.looks ¬ ALL[NIL]; }; ChangeDepth: PUBLIC PROC [s: IO.STREAM, deltaDepth: INTEGER ¬ 0, autoEndNode: BOOLEAN ¬ TRUE, idempotently: BOOLEAN ¬ FALSE] = BEGIN sd: TiogaOutStreamData ¬ NARROW[s.streamData]; IF autoEndNode THEN EndNode[s, same, idempotently]; IF sd.ready THEN ERROR NotNow[s]; IF sd.flexilevel THEN ERROR CallerBug[s, "can't ChangeDepth[a flexilevel stream]"]; sd.deltaDepth ¬ sd.deltaDepth + deltaDepth; END; AdjCacheIndex: TYPE ~ INTEGER [-5 .. 100]; AdjCache: TYPE ~ ARRAY AdjCacheIndex OF REF ANY; adjCache: REF AdjCache ¬ NEW [AdjCache ¬ ALL[NIL]]; PrepareForChar: PROC [s: IO.STREAM, sd: TiogaOutStreamData] = { adjProp: REF ANY ¬ NIL; fmt: ROPE ¬ sd.defaultFormat; GetFmt: PROC [n: INT] RETURNS [ROPE] ~ { i: NAT ~ n - sd.mini; IF sd.fmts[i] = NIL THEN sd.fmts[i] ¬ IO.PutFR["%g%g", [rope[sd.defaultFormat]], [integer[n]] ]; RETURN [sd.fmts[i]]}; GetAdj: PROC [delta: INT] RETURNS [REF ANY] ~ { IF delta IN AdjCacheIndex THEN { IF adjCache[delta]=NIL THEN adjCache[delta] ¬ NodeProps.DoSpecs[NodeProps.namePostfix, IO.PutFR1["%g sp bigger leftIndent", [integer[delta]]]]; RETURN [adjCache[delta]]} ELSE RETURN [NodeProps.DoSpecs[NodeProps.namePostfix, IO.PutFR1["%g sp bigger leftIndent", [integer[delta]]]]]}; IF sd.ready THEN RETURN; IF sd.flexilevel THEN { delta: INT; sd.nextDepth ¬ sd.nodeDepth; WHILE sd.indents.first > sd.indent DO sd.indents ¬ sd.indents.rest; sd.nextDepth ¬ sd.nextDepth - 1; ENDLOOP; IF sd.indents.first < sd.indent THEN { sd.indents ¬ CONS[sd.indent, sd.indents]; sd.nextDepth ¬ sd.nextDepth + 1}; IF sd.adjFmt THEN {delta ¬ sd.indent - sd.indents.rest.first; IF deltasd.maxi THEN {fmt ¬ GetFmt[sd.maxi]; adjProp ¬ GetAdj[delta-sd.maxi]} ELSE fmt ¬ GetFmt[delta]} ELSE IF sd.adjApp AND (delta ¬ sd.indent - (sd.indents.rest.first+sd.nni)) # 0 THEN adjProp ¬ GetAdj[delta]; } ELSE { sd.nextDepth ¬ sd.nextDepth + sd.deltaDepth; }; IF sd.nextDepth < 0 THEN ERROR BadDepth[s, sd.nextDepth]; WHILE sd.nextDepth < sd.nodeDepth DO sd.nodes ¬ sd.nodes.rest; sd.nodeDepth ¬ sd.nodeDepth - 1; ENDLOOP; IF sd.nextDepth > sd.nodeDepth THEN { sd.nodes ¬ CONS[TFO.InsertAsLastChild[x: sd.nodes.first], sd.nodes]; sd.nodeDepth ¬ sd.nodeDepth + 1} ELSE { sd.nodes.first ¬ TFO.InsertNode[x: sd.nodes.first, child: FALSE]; }; IF adjProp#NIL THEN NodeProps.PutProp[NARROW[AsRef[sd.nodes.first]], NodeProps.namePostfix, adjProp]; IF fmt#NIL THEN TFO.SetFormat[sd.nodes.first, fmt]; sd.contents ¬ NIL; sd.ready ¬ TRUE; sd.userDepth ¬ sd.nodeDepth; WHILE sd.userDepth < sd.nextDepth DO sd.contents ¬ sd.contents.Concat[sd.levelPrefix]; sd.userDepth ¬ sd.userDepth + 1; ENDLOOP; IF sd.lpCharsSeen > 0 THEN { sd.contents ¬ sd.contents.Concat[sd.levelPrefix.Substr[len: sd.lpCharsSeen]]; }; }; AsRef: PROC [r: REF ANY] RETURNS [REF ANY] ~ INLINE {RETURN [r]}; SetTFOComment: PROC [tfo: TFO.Ref] ~ { tn: TN.RefTextNode ~ NARROW[AsRef[tfo]]; NodeProps.PutProp[n: tn, name: NodeProps.nameComment, value: NodeProps.ValueFromBool[TRUE]]}; CopyChildren: PUBLIC PROC [from: TN.Ref, to: TFO.Ref] = BEGIN Work: PROC [from: TN.Ref, to: TFO.Ref] RETURNS [next: TN.Ref, dd: INT] = TRUSTED { last: TFO.Ref ¬ to; lastIsParent: BOOLEAN ¬ TRUE; [next, dd] ¬ TN.Forward[from]; IF dd > 1 THEN ERROR; IF dd < 1 THEN RETURN; dd ¬ dd - 1; WHILE dd = 0 DO toKid: TFO.Ref; tn: TN.RefTextNode ¬ next; r: ROPE ¬ NodeRope[tn]; toKid ¬ last.InsertNode[child: lastIsParent]; toKid.SetContents[r]; IF tn.comment THEN SetTFOComment[toKid]; last ¬ toKid; lastIsParent ¬ FALSE; [next, dd] ¬ Work[next, toKid]; ENDLOOP; dd ¬ dd + 1; }; [] ¬ Work[from, to]; END; RopeFromSubText: PROC [text: REF READONLY TEXT, startIndex, count: NAT] RETURNS [rope: ROPE] = { rope ¬ Rope.FromRefText[text, startIndex, count]; }; IsLB: PROC [c: CHAR] RETURNS [BOOL] ~ INLINE {RETURN [c='\r OR c='\l]}; NodeRope: PROC [n: TN.Ref] RETURNS [ROPE] ~ {RETURN [n.rope]}; END.