<<>> <> <> <> <> <> <> <> <> <> <> <> DIRECTORY Atom, CharOps, IO, NodeProps, PFS, PFSNames, RefText, Rope, Rosary, TextEdit, TextNode, Tioga, TiogaFileFormat, TiogaFileIO, TiogaIO, TiogaIOExtras; TiogaIOImpl: CEDAR PROGRAM IMPORTS Atom, CharOps, IO, NodeProps, PFS, PFSNames, RefText, Rope, Rosary, TextEdit, TextNode, TiogaFileIO EXPORTS TiogaIO, TiogaIOExtras ~ BEGIN STREAM: TYPE ~ IO.STREAM; ROPE: TYPE ~ Rope.ROPE; ROSARY: TYPE ~ Rosary.ROSARY; Node: TYPE ~ Tioga.Node; Looks: TYPE ~ Tioga.Looks; noLooks: Looks ~ Tioga.noLooks; Look: TYPE ~ Tioga.Look; <> GetByte: PROC [s: STREAM] RETURNS [BYTE] ~ INLINE { RETURN[IO.GetByte[s]] }; PutByte: PROC [s: STREAM, byte: BYTE] ~ INLINE { IO.PutByte[s, byte] }; GetChar: PROC [s: STREAM] RETURNS [CHAR] ~ INLINE { RETURN[IO.GetChar[s]] }; PutChar: PROC [s: STREAM, char: CHAR] ~ INLINE { IO.PutChar[s, char] }; Op: TYPE ~ TiogaFileFormat.Op; GetOp: PROC [s: STREAM] RETURNS [Op] ~ INLINE { RETURN[VAL[GetByte[s]]] }; PutOp: PROC [s: STREAM, op: Op] ~ INLINE { PutByte[s, ORD[op]] }; IndexFromOp: PROC [first: Op, op: Op] RETURNS [BYTE] ~ INLINE { RETURN[ORD[op]-ORD[first]] }; OpFromIndex: PROC [first: Op, index: BYTE] RETURNS [Op] ~ INLINE { RETURN[VAL[ORD[first]+index]] }; GetLen: PROC [s: STREAM] RETURNS [CARD] ~ { b: BYTE ~ GetByte[s]; RETURN[IF b<(2**7) THEN b ELSE GetLen[s]*(2**7)+(b MOD (2**7))]; }; PutLen: PROC [s: STREAM, len: CARD] ~ { IF len<(2**7) THEN PutByte[s, len] ELSE { PutByte[s, (2**7)+(len MOD (2**7))]; PutLen[s, len/(2**7)] }; }; GetLenRope: PROC [s: STREAM] RETURNS [ROPE] ~ { len: CARD ~ GetLen[s]; RETURN[IO.GetRope[s, len, TRUE]]; }; SkipLenRope: PROC [s: STREAM] ~ { len: CARD ~ GetLen[s]; IO.SetIndex[s, IO.GetIndex[s]+len]; }; PutLenRope: PROC [s: STREAM, rope: ROPE] ~ { PutLen[s, Rope.Size[rope]]; IO.PutRope[s, rope]; }; GetLenText: PROC [s: STREAM, buffer: REF TEXT ¬ NIL] RETURNS [REF TEXT] ~ { len: CARD ~ GetLen[s]; RETURN[IO.GetText[s, len]]; }; GetLenAtom: PROC [s: STREAM, buffer: REF TEXT ¬ NIL] RETURNS [ATOM] ~ { RETURN[Atom.MakeAtomFromRefText[GetLenText[s, buffer]]]; }; PutLenAtom: PROC [s: STREAM, atom: ATOM] ~ { PutLenRope[s, Atom.GetPName[atom]]; }; Get16: PROC [s: STREAM] RETURNS [CARD16] ~ { b0: BYTE ~ GetByte[s]; b1: BYTE ~ GetByte[s]; RETURN[b0*(2**8)+b1]; }; Put16: PROC [s: STREAM, val: CARD16] ~ { b0: BYTE ~ val / (2**8); b1: BYTE ~ val MOD (2**8); PutByte[s, b0]; PutByte[s, b1]; }; Get32: PROC [s: STREAM] RETURNS [CARD32] ~ { h0: CARD16 ~ Get16[s]; h1: CARD16 ~ Get16[s]; RETURN[h0*(2**16)+h1]; }; Put32: PROC [s: STREAM, val: CARD32] ~ { h0: CARD16 ~ val / (2**16); h1: CARD16 ~ val MOD (2**16); Put16[s, h0]; Put16[s, h1]; }; GetLooks: PROC [s: STREAM] RETURNS [Looks] ~ INLINE { RETURN[LOOPHOLE[Get32[s]]] }; PutLooks: PROC [s: STREAM, looks: Looks] ~ INLINE { Put32[s, LOOPHOLE[looks]] }; GetLookChars: PROC [s: STREAM, n: NAT] RETURNS [looks: Looks ¬ noLooks] ~ { THROUGH [0..n) DO c: Look ~ GetChar[s]; looks[c] ¬ TRUE ENDLOOP; }; PutLookChars: PROC [s: STREAM, looks: Looks] ~ { FOR c: Look IN Look DO IF looks[c] THEN PutChar[s, c] ENDLOOP; }; CountLooks: PROC [looks: Looks] RETURNS [n: NAT ¬ 0] ~ { FOR c: Look IN Look DO IF looks[c] THEN n ¬ n+1 ENDLOOP; }; <> Error: PUBLIC ERROR ~ CODE; numFormats: NAT ~ TiogaFileFormat.numFormats; numProps: NAT ~ TiogaFileFormat.numProps; numLooks: NAT ~ TiogaFileFormat.numLooks; PreloadTables: PROC [ reserveFormat: PROC [ATOM, BYTE], reserveProp: PROC [ATOM, BYTE], reserveLooks: PROC [Looks, BYTE] ] ~ { reserveFormat[NIL, 0]; reserveProp[NIL, 0]; reserveProp[$Prefix, 1]; reserveProp[$Postfix, 2]; reserveLooks[noLooks, 0]; }; GetDocRope: PUBLIC PROC [s1, s2, s3: STREAM] RETURNS [rope: ROPE ¬ NIL] ~ { SkipRuns: PROC ~ { numRuns: INT ~ GetLen[s3]; THROUGH [0..numRuns) DO looksOp: Op ~ GetOp[s3]; SELECT looksOp FROM IN [looksFirst..looksLast] => NULL; look1 => [] ¬ GetLookChars[s3, 1]; look2 => [] ¬ GetLookChars[s3, 2]; look3 => [] ¬ GetLookChars[s3, 3]; looks => [] ¬ GetLooks[s3]; ENDCASE => ERROR Error; [] ¬ GetLen[s3]; ENDLOOP; }; newlineChars: NAT ¬ 1; ReadRope: PROC [comment: BOOL] ~ { size: INT ~ GetLen[s3]; s: STREAM ~ IF comment THEN s2 ELSE s1; rope ¬ Rope.Concat[rope, IO.GetRope[s, size+newlineChars, TRUE]]; }; DO op: Op ~ GetOp[s3]; SELECT op FROM startNode, startLeaf => SkipLenRope[s3]; IN [startNodeFirst..startNodeLast] => NULL; IN [startLeafFirst..startLeafLast] => NULL; prop => { SkipLenRope[s3]; SkipLenRope[s3] }; propShort => { [] ¬ GetByte[s3]; SkipLenRope[s3] }; runs => SkipRuns[]; dataRope => ReadRope[comment: FALSE]; commentRope => ReadRope[comment: TRUE]; endNode => NULL; endOfFile => EXIT; ENDCASE => ERROR Error; ENDLOOP; }; 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 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]; }; emptyAtom: ATOM ~ Atom.MakeAtom[NIL]; 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; <> 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 { 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; }; <> InterestingProp: PROC [name: ATOM, value: REF] RETURNS [BOOL] ~ { RETURN [SELECT name FROM $Viewer, $LockedViewer, $FromTiogaFile, $DocumentLock, $FileCreateDate, $FileExtension, $NewlineDelimiter => FALSE, <> ENDCASE => TRUE]; }; SimpleNode: PROC [node: Node, comment: BOOL] RETURNS [BOOL] ~ { RETURN[node.runs=NIL AND node.charSets=NIL AND node.charProps=NIL AND (node.format=NIL OR node.format=emptyAtom) AND node.comment=comment AND NOT NodeProps.MapProps[node, InterestingProp, FALSE, FALSE]]; }; RopeFromSimpleDoc: PUBLIC PROC [root: Node] RETURNS [ROPE] ~ { IF root#NIL AND root.rope=NIL AND SimpleNode[root, TRUE] THEN { child: Node ~ root.child; IF child#NIL AND child.child=NIL AND child.next=NIL AND SimpleNode[child, FALSE] THEN RETURN[IF child.rope=NIL THEN "" ELSE child.rope]; }; RETURN [NIL]; }; <<>> SimpleDocFromRope: PUBLIC PROC [rope: ROPE] RETURNS [Node] ~ { RETURN [TextEdit.DocFromNode[TextEdit.FromRope[rope]]]; }; <<>> <> LowerCase: PROC [r: ROPE] RETURNS [ROPE] ~ { RETURN [Rope.Translate[base: r, translator: Rope.Lower]]; }; <<>> FileExtensionFromPath: PROC [path: PFS.PATH] RETURNS [ATOM] ~ { name: ROPE ~ PFSNames.ShortNameRope[path]; pos: INT ~ Rope.FindBackward[name, "."]; ext: ROPE ~ IF pos<0 THEN NIL ELSE Rope.Substr[name, pos+1]; RETURN[IF Rope.IsEmpty[ext] THEN $null ELSE Atom.MakeAtom[LowerCase[ext]]]; }; FileCreateDateFromUniqueID: PROC [uniqueID: PFS.UniqueID] RETURNS [REF] ~ { RETURN[NEW[PFS.UniqueID ¬ uniqueID]]; }; PutFileProps: PROC [root: Node, fullFName: PFS.PATH, uniqueID: PFS.UniqueID] ~ { NodeProps.PutProp[root, $FileExtension, FileExtensionFromPath[fullFName]]; NodeProps.PutProp[root, $FileCreateDate, FileCreateDateFromUniqueID[uniqueID]]; }; FromRope: PUBLIC PROC [rope: ROPE] RETURNS [Node] ~ { parts: TiogaFileIO.Parts ~ TiogaFileIO.GetParts[IO.RIS[rope]]; IF parts.isTioga THEN RETURN[GetDoc[ s1: IO.RIS[Rope.Substr[rope, parts.start1, parts.len1]], s2: IO.RIS[Rope.Substr[rope, parts.start2, parts.len2]], s3: IO.RIS[Rope.Substr[rope, parts.start3, parts.len3]] ]] ELSE RETURN[SimpleDocFromRope[rope]]; }; ToStream: PUBLIC PROC [s: STREAM, root: Node] RETURNS [dataLen: INT] ~ { rope: ROPE ~ RopeFromSimpleDoc[root]; IF rope=NIL THEN { put: PROC [s1, s2, s3: STREAM] ~ { PutDoc[s1, s2, s3, root] }; dataLen ¬ TiogaFileIO.PutParts[s, put]; } ELSE { IO.PutRope[s, rope]; dataLen ¬ Rope.Size[rope]; }; }; ToRope: PUBLIC PROC [root: Node] RETURNS [ROPE] ~ { rope: ROPE ~ RopeFromSimpleDoc[root]; IF rope=NIL THEN { s: STREAM ~ IO.ROS[]; dataLen: INT ~ ToStream[s, root]; RETURN[IO.RopeFromROS[s]]; } ELSE RETURN[rope]; }; FromPair: PUBLIC PROC [pair: TiogaIO.Pair] RETURNS [Node] ~ { IF Rope.Size[pair.formatting]>0 THEN RETURN[FromRope[Rope.Concat[pair.contents, pair.formatting]]] ELSE RETURN[SimpleDocFromRope[pair.contents]]; }; ToPair: PUBLIC PROC [root: Node] RETURNS [TiogaIO.Pair] ~ { rope: ROPE ~ RopeFromSimpleDoc[root]; IF rope=NIL THEN { s: STREAM ~ IO.ROS[]; dataLen: INT ~ ToStream[s, root]; rope: ROPE ~ IO.RopeFromROS[s]; RETURN[[ contents: Rope.Substr[base: rope, len: dataLen], formatting: Rope.Substr[base: rope, start: dataLen] ]]; } ELSE RETURN[[contents: rope, formatting: NIL]]; }; <<>> checkMutabilityInFromFile: BOOL ¬ TRUE; <<>> FromFile: PUBLIC PROC [fileName: PFS.PATH, wantedUniqueID: PFS.UniqueID] RETURNS [fullFName: PFS.PATH, uniqueID: PFS.UniqueID, root: Node] ~ { rope: ROPE ¬ NIL; [rope: rope, fullFName: fullFName, uniqueID: uniqueID] ¬ PFS.RopeOpen[ fileName: fileName, wantedUniqueID: wantedUniqueID, includeFormatting: TRUE, checkMutability: checkMutabilityInFromFile]; root ¬ FromRope[rope]; PutFileProps[root, fullFName, uniqueID]; }; ToFile: PUBLIC PROC [fileName: PFS.PATH, root: Node] RETURNS [fullFName: PFS.PATH, uniqueID: PFS.UniqueID, dataLen: INT] ~ { file: PFS.OpenFile ~ PFS.Open[name: fileName, access: create]; RETURN ToOpenFile[file, root]; }; FromOpenFile: PUBLIC PROC [file: PFS.OpenFile] RETURNS [fullFName: PFS.PATH, uniqueID: PFS.UniqueID, root: Node] ~ { [fullFName: fullFName, uniqueID: uniqueID] ¬ PFS.GetInfo[file]; PFS.Close[file]; RETURN FromFile[fullFName, uniqueID]; }; ToOpenFile: PUBLIC PROC [file: PFS.OpenFile, root: Node] RETURNS [fullFName: PFS.PATH, uniqueID: PFS.UniqueID, dataLen: INT] ~ { s: STREAM ~ PFS.StreamFromOpenFile[openFile: file, accessOptions: write]; [fullFName: fullFName, uniqueID: uniqueID] ¬ PFS.GetInfo[file]; dataLen ¬ ToStream[s, root]; IO.Close[s]; PutFileProps[root, fullFName, uniqueID]; }; <> IsAlreadyACommentLine: PROC [r: ROPE] RETURNS [BOOL] = { loc: INT ¬ 0; size: INT = Rope.Size[r]; c: CHAR; WHILE loc < size AND CharOps.Blank[c ¬ Rope.Fetch[r, loc]] DO loc ¬ loc+1; ENDLOOP; IF loc > size-2 OR c # '- OR Rope.Fetch[r, loc+1] # '- THEN RETURN [FALSE]; IF Rope.SkipTo[s: r, skip: "\r\l"] < size THEN { <> RETURN [FALSE]; }; IF Rope.Match[pattern: "--*--*", object: r] THEN { <> RETURN [FALSE]; }; RETURN [TRUE] }; MapDelimitedPieces: PROC [action: PROC [rope: ROPE, start, len: INT], delimiter: ROPE, base: ROPE, start: INT ¬ 0, len: INT ¬ INT.LAST] = { t: INT ¬ start; dSize: INT = Rope.Size[delimiter]; end: INT = MIN[start+len, Rope.Size[base]]; DO i: INT ¬ Rope.Index[s1: base, pos1: t, s2: delimiter]; IF i > end-dSize THEN {i ¬ end}; IF i >= t THEN action[base, t, i-t]; IF i = end THEN EXIT; t ¬ i+dSize; ENDLOOP; }; <<>> WritePlain: PUBLIC PROC [s: IO.STREAM, root: Node, restoreDashes: BOOL ¬ FALSE, indent: ROPE ¬ NIL] ~ { node: Node ¬ root; level: INTEGER ¬ 0; levelDelta: INTEGER; BeginLine: PROC = { THROUGH [1..level) DO IO.PutRope[s, indent] ENDLOOP; -- output level-1 tabs }; EndLine: PROC = { IO.PutChar[s, '\n]; }; IF indent=NIL THEN indent ¬ "\t"; DO [node, levelDelta] ¬ TextNode.Forward[node]; IF node=NIL THEN EXIT; level ¬ level+levelDelta; IF restoreDashes AND node.comment AND NOT IsAlreadyACommentLine[node.rope] THEN { EachLine: PROC [rope: ROPE, start, len: INT] = { first: BOOL ¬ TRUE; EachPart: PROC [rope: ROPE, start, len: INT] = { IF NOT first THEN IO.PutRope[s, " - - "]; IO.PutRope[self: s, r: rope, start: start, len: len]; first ¬ FALSE; }; BeginLine[]; IO.PutRope[s, "-- "]; -- restore the leading dashes for Mesa comments MapDelimitedPieces[EachPart, "--", rope, start, len]; EndLine[]; }; MapDelimitedPieces[EachLine, "\n", node.rope, 0, Rope.Size[node.rope]]; } ELSE { BeginLine[]; IO.PutRope[s, node.rope]; EndLine[] }; ENDLOOP; }; <<>> WritePlainToStream: PUBLIC PROC [s: IO.STREAM, root: Node, restoreDashes: BOOL] = { WritePlain[s, root, restoreDashes]; }; <<>> WritePlainToRope: PUBLIC PROC [root: Node, restoreDashes: BOOL] RETURNS [ROPE] ~ { rope: ROPE ~ RopeFromSimpleDoc[root]; IF rope=NIL THEN { s: STREAM ~ IO.ROS[]; WritePlain[s, root, restoreDashes]; RETURN[IO.RopeFromROS[s]]; } ELSE RETURN[rope]; }; <<>> <> <> <> < IF Rope.Size[rope] = 1 THEN RETURN [Rope.Fetch[rope, 0]];>> < NULL;>> <> <<};>> <<>> <> <> < RETURN [rope];>> < NULL;>> <> <<};>> <<>> <> <> <<};>> <<>> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<}>> <> <> <> <<};>> <<};>> <<[node, levelDelta] ¬ TextNode.Forward[node];>> <> <= length THEN EXIT;>> <> <> <<};>> <<};>> <<>> END.