
    <<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.