PutFileImpl.mesa
Copyright Ó 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
Michael Plass, October 15, 1987 3:57:27 pm PDT
Rick Beach, March 27, 1985 1:04:56 pm PST
Russ Atkinson (RRA) August 7, 1985 12:49:05 pm PDT
Doug Wyatt, February 17, 1988 5:34:29 pm PST
DIRECTORY
Atom USING [GetPName],
CedarProcess USING [Priority, DoWithPriority],
FileOps USING [comment, endNode, endOfFile, IntBytes, LengthByte, look1, look2, look3, looks, looksFirst, LooksIndex, prop, PropIndex, propShort, rope, runs, startNode, startNodeFirst, terminalTextNode, terminalTextNodeFirst, ThirdByte, FormatIndex],
FileWriter USING [Close, OpenC, Ref, ToRope, ToStream, WriteChar, WriteRope],
FS USING [Create, Error, FileInfo, OpenFile, PagesForBytes, StreamBufferParms, StreamFromOpenFile, StreamOpen],
IO USING [Close, PutChar, PutRope, RopeFromROS, ROS, SetIndex, SetLength, STREAM],
NodeProps USING [GetSpecs, MapProps],
PGSupport USING [CreatePGF, EnterLooks, EnterProp, EnterFormatName, FreePGF, PGF],
PrincOpsUtils USING [],
PutGet USING [],
Rope,
RopeEdit USING [BlankChar],
TextLooks,
TextNode USING [FirstChild, Forward, IsLastSibling, Next, Node, NodeProps, Parent],
UserProfile USING [Number];
PutFileImpl: CEDAR PROGRAM
IMPORTS Atom, CedarProcess, FileWriter, FS, IO, npI: NodeProps, PGSupport, Rope, RopeEdit, TextLooks, TextNode, UserProfile
EXPORTS PutGet
= BEGIN OPEN PutGet;
Node: TYPE = TextNode.Node;
ROPE: TYPE = Rope.ROPE;
defaultStreamBufferParams: FS.StreamBufferParms ← [vmPagesPerBuffer: 8, nBuffers: 2];
These parameters are here to encorage experimentation. However, don't set them to unreasonable values or you will be sorry!
ToRope: PUBLIC PROC [node: Node, flatten, textOnly: BOOL ← FALSE] RETURNS [dataLen, count: INT, output: ROPE] = {
control, comment, data: FileWriter.Ref;
simple: BOOL;
[output, simple] ← SimpleFile[node];
IF simple THEN { dataLen ← count ← Rope.Size[output]; RETURN };
[control, comment, data] ← FileWriter.ToRope[];
Finish[control, comment, data, node, flatten];
[dataLen, count, output] ← FileWriter.Close[control, comment, data, textOnly];
};
ToStream: PUBLIC PROC [stream: IO.STREAM, node: Node, flatten, textOnly: BOOL ← FALSE] RETURNS [dataLen, count: INT] = {
control, comment, data: FileWriter.Ref;
rope: ROPE;
simple: BOOL;
[rope, simple] ← SimpleFile[node];
IF simple THEN {
IO.PutRope[stream, rope];
dataLen ← count ← Rope.Size[rope];
RETURN
};
[control, comment, data] ← FileWriter.ToStream[stream];
Finish[control, comment, data, node, flatten];
[dataLen, count, ] ← FileWriter.Close[control, comment, data, textOnly];
};
ToFile: PUBLIC PROC [fileName: ROPE, node: Node, start: INT ← 0, flatten, textOnly: BOOL ← FALSE] RETURNS [dataLen, count: INT] = {
file: FS.OpenFile;
estimatedBytes, estimatedPages: INT ← 0;
fileName ← fileName.Flatten[0, fileName.SkipTo[0, "!"]];
estimatedBytes ← FS.FileInfo[fileName ! FS.Error => CONTINUE].bytes;
estimatedPages ← FS.PagesForBytes[estimatedBytes];
file ← FS.Create[name: fileName, pages: estimatedPages,
keep: UserProfile.Number["Tioga.defaultKeep", 2]];
[dataLen, count] ← ToFileC[file, node, start, flatten, textOnly];
};
ToFile: PUBLIC PROC [fileName: ROPE, node: Node, start: INT ← 0, flatten, textOnly: BOOL ← FALSE] RETURNS [dataLen, count: INT] = {
file: FS.OpenFile;
fileName ← fileName.Flatten[0, fileName.SkipTo[0, "!"]];
file ← FS.Create[name: fileName, keep: UserProfile.Number["Tioga.defaultKeep", 2]];
[dataLen, count] ← ToFileC[file, node, start, flatten, textOnly];
};
ToFileC: PUBLIC PROC [file: FS.OpenFile, node: Node, start: INT ← 0, flatten, textOnly: BOOL ← FALSE] RETURNS [dataLen, count: INT] = {
ropeToFile: PROC [rope: ROPE] = {
stream: IO.STREAM ~ FS.StreamFromOpenFile[openFile: file, accessRights: $write, streamBufferParms: defaultStreamBufferParams];
IO.SetLength[stream, 0];
IO.SetIndex[stream, 0];
IO.PutRope[stream, rope];
IO.Close[stream];
};
opener: PROC RETURNS [control, comment, data: FileWriter.Ref] = {
[control, comment, data] ← FileWriter.OpenC[file, start];
};
[dataLen, count] ← FileIt[ropeToFile, opener, node, flatten, textOnly];
};
savePriority: CedarProcess.Priority ← normal;
FileIt: PROC [ropeToFile: PROC [ROPE],
opener: PROC RETURNS [control, comment, data: FileWriter.Ref],
node: Node, flatten, textOnly: BOOL
] RETURNS [dataLen, count: INT] = {
innerFileIt: PROC ~ {
rope: ROPE;
simple: BOOL;
[rope, simple] ← SimpleFile[node];
IF simple
THEN {
ropeToFile[rope];
dataLen ← count ← Rope.Size[rope];
}
ELSE {
control, comment, data: FileWriter.Ref;
[control, comment, data] ← opener[];
Finish[control, comment, data, node, flatten];
[dataLen, count, ] ← FileWriter.Close[control, comment, data, textOnly];
};
};
CedarProcess.DoWithPriority[savePriority, innerFileIt];
};
SimpleFile: PROC [root: Node] RETURNS [rope: ROPE, simple: BOOL] = {
SimpleNode: PROC [node: Node] RETURNS [ROPE, BOOL] = {
HasInterestingProp: PROC RETURNS [BOOL] = INLINE --gfi saver-- {
Check: PROC [name: ATOM, value: REF] RETURNS [BOOL] = {
RETURN [SELECT name FROM
$Viewer, $LockedViewer, $FromTiogaFile, $DocumentLock, $FileCreateDate, $FileExtension => FALSE,
When add a new "system" property that should not go on files, add registration at end of TEditDocuments2Impl so will not copy/write the property.
ENDCASE => TRUE]
};
RETURN [npI.MapProps[node, Check, FALSE, FALSE]]
};
text: Node = node;
IF node.formatName=NIL AND NOT text.comment AND NOT HasInterestingProp[] THEN {
IF node.charSets=NIL AND node.charLooks=NIL AND node.charProps=NIL THEN
RETURN [node.rope, TRUE];
};
RETURN [NIL, FALSE]
};
IF root=NIL THEN RETURN [NIL, TRUE];
[rope, simple] ← SimpleNode[root];
IF ~simple THEN RETURN; -- not a simple root node
IF root.child=NIL THEN RETURN; -- simple root and no child
IF rope # NIL OR -- root has child and text, so not simple
~root.child.last OR root.child.child # NIL THEN RETURN [NIL, FALSE]; -- more than one child, so not simple
[rope, simple] ← SimpleNode[root.child];
};
Finish: PROC [control, comment, data: FileWriter.Ref, root: Node, flatten: BOOL] = {
WriteChar: PROC [c: CHAR, writer: FileWriter.Ref] = INLINE --gfi saver-- {
FileWriter.WriteChar[c, writer]
};
WriteAtom: PROC [atom: ATOM] = INLINE --gfi saver-- {
WriteControlRope[Atom.GetPName[atom]]
};
WriteRope: PROC [r: ROPE, writer: FileWriter.Ref] = INLINE --gfi saver-- {
WriteLen[Rope.Size[r]];
FileWriter.WriteRope[r, Rope.Size[r], writer];
WriteChar[15C, writer]
};
WriteControlRope: PROC [r: ROPE] = INLINE --gfi saver-- {
size: INT ← Rope.Size[r];
WriteLen[size];
FileWriter.WriteRope[r, size, control]
};
WriteLen: PROC [len: INT] = {
first, second, fourth: FileOps.LengthByte;
third: FileOps.ThirdByte;
lenBytes: FileOps.IntBytes ← LOOPHOLE[len];
IF lenBytes.fourth # 0 THEN {
fourth.data ← lenBytes.fourth;
first.others ← second.others ← third.others ← TRUE;
};
IF lenBytes.thirdTop # 0 OR lenBytes.thirdBottom # 0 THEN {
third.dataTop ← lenBytes.thirdTop;
third.dataBottom ← lenBytes.thirdBottom;
first.others ← second.others ← TRUE
};
IF lenBytes.second # 0 THEN {
second.data ← lenBytes.second; first.others ← TRUE;
};
first.data ← lenBytes.first;
WriteChar[LOOPHOLE[first], control];
IF first.others THEN {
WriteChar[LOOPHOLE[second], control];
IF second.others THEN {
WriteChar[LOOPHOLE[third], control];
IF third.others THEN {
WriteChar[LOOPHOLE[fourth], control]
}
}
}
};
WriteLooks: PROC [lks: TextLooks.LooksBytes] = INLINE --gfi saver-- {
WriteChar[LOOPHOLE[lks.byte0], control];
WriteChar[LOOPHOLE[lks.byte1], control];
WriteChar[LOOPHOLE[lks.byte2], control];
WriteChar[LOOPHOLE[lks.byte3], control]
};
CountLookBits: PROC [lks: TextLooks.Looks] RETURNS [cnt: NAT] = INLINE --gfi saver-- {
cnt ← 0;
FOR c: CHAR IN TextLooks.Look DO IF lks[c] THEN cnt ← cnt+1; ENDLOOP
};
WriteLookChars: PROC [lks: TextLooks.Looks] = INLINE --gfi saver-- {
FOR c: CHAR IN TextLooks.Look DO IF lks[c] THEN WriteChar[c, control]; ENDLOOP
};
WriteProp: PROC [name: ATOM, value: REF] RETURNS [BOOL] = { -- write specs as a rope
specs: ROPE ← npI.GetSpecs[name, value];
IF specs=NIL THEN RETURN [FALSE];
[ok, propindex] ← PGSupport.EnterProp[name, pgf];
IF ok
THEN { -- can use short form
WriteChar[FileOps.propShort, control];
WriteChar[LOOPHOLE[propindex], control]
}
ELSE { -- must write full prop name
WriteChar[FileOps.prop, control];
WriteAtom[name]
};
WriteControlRope[specs];
RETURN [FALSE]
};
formatName: ATOM;
ok, terminal: BOOL;
formatindex: FileOps.FormatIndex;
looksindex: FileOps.LooksIndex;
propindex: FileOps.PropIndex;
node, nodeChild: Node;
pgf: PGSupport.PGF ← PGSupport.CreatePGF[];
nameText: REF TEXT ← NEW[TEXT[32]];
node ← root;
DO -- first write format
rope: ROPE;
size: INT;
runs: TextLooks.Runs;
terminal ← (nodeChild←TextNode.FirstChild[node])=NIL;
[ok, formatindex] ← PGSupport.EnterFormatName[formatName ← node.formatName, pgf];
IF ok THEN {
WriteChar[formatindex+(IF ~terminal THEN FileOps.startNodeFirst ELSE FileOps.terminalTextNodeFirst), control]
}
ELSE {
WriteChar[IF ~terminal THEN FileOps.startNode ELSE FileOps.terminalTextNode, control];
WriteControlRope[IF formatName#NIL THEN Atom.GetPName[formatName] ELSE NIL]
};
write charSets and charProps, if any, as node props
IF node.charSets#NIL THEN [] ← WriteProp[$CharSets, node.charSets];
IF node.charProps#NIL THEN [] ← WriteProp[$CharProps, node.charProps];
write other node props
IF node.props # NIL THEN [] ← npI.MapProps[node, WriteProp, FALSE, FALSE];
now write contents
IF flatten THEN { -- flatten rope and runs
node.rope ← Rope.Balance[node.rope];
node.runs ← TextLooks.Flatten[node.runs];
};
rope ← node.rope; size ← Rope.Size[rope];
IF (runs ← node.charLooks) # NIL THEN {
loc, cnt, numRuns: INT ← 0;
WriteRun: TextLooks.RunAction ~ {
[ok, looksindex] ← PGSupport.EnterLooks[looks, pgf];
IF ok THEN WriteChar[FileOps.looksFirst+looksindex, control]
ELSE { -- must write out the looks
SELECT CountLookBits[looks] FROM
1 => { WriteChar[FileOps.look1, control];
WriteLookChars[looks]
};
2 => { WriteChar[FileOps.look2, control];
WriteLookChars[looks]
};
3 => { WriteChar[FileOps.look3, control];
WriteLookChars[looks]
};
ENDCASE => {
WriteChar[FileOps.looks, control];
WriteLooks[LOOPHOLE[looks]]
};
};
WriteLen[len];
loc ← loc+len;
cnt ← cnt+1;
};
numRuns ← TextLooks.CountRuns[runs];
WriteChar[FileOps.runs, control];
WriteLen[numRuns];
[] ← TextLooks.MapRuns[runs, WriteRun];
IF cnt#numRuns OR loc#size THEN ERROR;
};
IF node.comment THEN { -- put text in comment area of file
WriteChar[FileOps.comment, control];
WriteRope[rope, comment]
}
ELSE { -- put text in data area of file
WriteChar[FileOps.rope, control];
WriteRope[rope, data]
};
move to the next node
IF ~terminal THEN node ← nodeChild
ELSE { -- node has no children
DO IF node=root THEN GOTO Finis;
IF ~TextNode.IsLastSibling[node] THEN { node ← TextNode.Next[node]; EXIT };
node ← TextNode.Parent[node];
WriteChar[FileOps.endNode, control];
ENDLOOP
};
REPEAT Finis => {
WriteChar[FileOps.endOfFile, control];
PGSupport.FreePGF[pgf]
};
ENDLOOP
};
WriteMesaFilePlain: PUBLIC PROC [fileName: ROPE, root: Node] = {
h: IO.STREAM ← FS.StreamOpen[fileName: fileName, accessOptions: $create, keep: UserProfile.Number["Tioga.defaultKeep", 2]];
WritePlain[h, root, TRUE];
IO.Close[h];
};
WriteFilePlain: PUBLIC PROC [fileName: ROPE, root: Node] = {
h: IO.STREAM ← FS.StreamOpen[fileName: fileName, accessOptions: $create, keep: UserProfile.Number["Tioga.defaultKeep", 2]];
WritePlain[h, root];
IO.Close[h];
};
WriteFileCPlain: PUBLIC PROC [file: FS.OpenFile, root: Node] = {
h: IO.STREAM = FS.StreamFromOpenFile[file, $write];
WritePlain[h, root];
IO.Close[h];
};
WriteRopePlain: PUBLIC PROC [root: Node, restoreDashes: BOOL ← FALSE]
RETURNS [output: ROPE] = {
h: IO.STREAM = IO.ROS[];
WritePlain[h, root, restoreDashes];
RETURN [IO.RopeFromROS[h]]
};
IsAlreadyACommentLine: PROC [r: ROPE] RETURNS [BOOL] = {
loc: INT ← 0;
size: INT = Rope.Size[r];
c: CHAR;
WHILE loc < size AND RopeEdit.BlankChar[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.Find[s1: r, s2: "\n"] > 0 THEN {
comment has a CR in it, so be careful
RETURN [FALSE];
};
IF Rope.Match[pattern: "--*--*", object: r] THEN {
comment has some other double dashes in it, so be careful
RETURN [FALSE];
};
RETURN [TRUE]
};
WritePlain: PUBLIC PROC [h: IO.STREAM, root: Node, restoreDashes: BOOL ← FALSE] = {
node: Node ← root;
level: INTEGER ← 0;
levelDelta: INTEGER;
first: BOOL ← TRUE;
NewLine: PROC = {
IF first THEN first ← FALSE ELSE IO.PutChar[h, '\n];
THROUGH [1..level) DO IO.PutChar[h, '\t] ENDLOOP; -- output level-1 tabs
};
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[h, " - - "];
IO.PutRope[self: h, r: rope, start: start, len: len];
first ← FALSE;
};
NewLine[]; IO.PutRope[h, "-- "]; -- restore the leading dashes for Mesa comments
MapDelimitedPieces[EachPart, "--", rope, start, len];
};
MapDelimitedPieces[EachLine, "\n", node.rope, 0, Rope.Size[node.rope]];
}
ELSE {NewLine[]; IO.PutRope[h, node.rope] };
ENDLOOP;
};
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;
};
END.