
    <<SchemePrettyFileImpl.mesa>>
        <<Copyright Ó 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Spreitze, April 9, 1990 3:12 pm PDT>>
        <<Last tweaked by Mike Spreitzer on May 12, 1992 1:18 pm PDT>>

    DIRECTORY Atom, Commander, CommanderOps, Convert, FS, IO, NodeProps, PFS, Rope, Scheme, SchemePrettyRead, SchemePrinting, 
    StructuredStreams, TextNode, TiogaFileOps, TiogaIO, TiogaStreams, UnparserBuffer, UserProfile;

    SchemePrettyFileImpl: CEDAR PROGRAM
        IMPORTS Atom, Commander, CommanderOps, Convert, FS, IO, NodeProps, PFS, Rope, Scheme, SchemePrettyRead, SchemePrinting, 
        StructuredStreams, TextNode, TiogaFileOps, TiogaIO, TiogaStreams, UnparserBuffer, UserProfile
        =

    BEGIN OPEN Scheme, SchemePrettyRead, SchemePrinting, SS:StructuredStreams, TS:TiogaStreams, UB:UnparserBuffer;

    defaultHow: How Ź [];
    defaultMargin: INT Ź 80;

    plainWidths: REF ARRAY CHAR OF INTEGER
        Ź NEW[ARRAY CHAR OF INTEGER Ź ALL[1]];
    tabWidth: INTEGER Ź plainWidths['\t] Ź 8;
    plainSpacers: LIST OF CHAR Ź LIST['\t, ' ];

    PrettyPrintFileCmd: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY Ź NIL, msg: ROPE Ź NIL] --Commander.CommandProc-- ~ {
        PPLocal: PROC ~ {};
        argv: CommanderOps.ArgumentVector ~ CommanderOps.Parse[cmd];
        how: How Ź defaultHow;
        margin: INT Ź defaultMargin;
        barfum: ROPE Ź NIL;
        context: ATOM Ź $exprs;
        debugSS, debugRead, plainOut: BOOL Ź FALSE;
        debugLog: IO.STREAM Ź NIL;
        i: NAT Ź 1;
        outName: ROPE Ź NIL;
        extStack: INT Ź 0;
        msg Ź NIL;
        WHILE i < argv.argc DO
            ENABLE {
                Complain => {barfum Ź msg; GOTO Abort};
                Convert.Error => {barfum Ź "Conversion error on command line"; GOTO Abort};
                };
            arg: ROPE ~ argv[i];
            IF arg.Length[]<1 THEN LOOP;
            SELECT TRUE FROM
                arg.Fetch[0]='- => IF i.SUCC=argv.argc
                    THEN RETURN [$Failure, "switch arg missing"]
                    ELSE SELECT TRUE FROM
                        arg.Equal["-margin", FALSE] => {margin Ź Convert.IntFromRope[argv[i.SUCC]]; i Ź i+2};
                        arg.Equal["-sia", FALSE] => {how.sia Ź Convert.IntFromRope[argv[i.SUCC]]; i Ź i+2};
                        arg.Equal["-simplelen", FALSE] => {how.simpleLen Ź Convert.IntFromRope[argv[i.SUCC]]; i Ź i+2};
                        arg.Equal["-simplequote", FALSE] => {how.simpleQuote Ź Convert.BoolFromRope[argv[i.SUCC]]; i Ź i+2};
                        arg.Equal["-debug", FALSE] => {debugLog Ź IF Convert.BoolFromRope[argv[i.SUCC]] THEN cmd.err ELSE NIL; i Ź i+2};
                        arg.Equal["-plainOut", FALSE] => {plainOut Ź Convert.BoolFromRope[argv[i.SUCC]]; i Ź i+2};
                        arg.Equal["-debugss", FALSE] => {debugSS Ź Convert.BoolFromRope[argv[i.SUCC]]; i Ź i+2};
                        arg.Equal["-debugRead", FALSE] => {debugRead Ź Convert.BoolFromRope[argv[i.SUCC]]; i Ź i+2};
                        arg.Equal["-context", FALSE] => {context Ź Atom.MakeAtom[argv[i.SUCC]]; i Ź i+2};
                        ENDCASE => RETURN [$Failure, Rope.Concat["unrecognized switch: ", arg]];
                i.SUCC<argv.argc AND (argv[i.SUCC].Equal["_"] OR argv[i.SUCC].Equal["Ź"]) => {outName Ź arg; i Ź i+2};
                ENDCASE => {
                    ENABLE {
                        PFS.Error => {
                            barfum Ź IO.PutFR["PFS.Error[%g, %g] while processing %g", [atom[error.code]], [rope[error.explanation]], [rope[arg]] ];
                            GOTO Abort};
                        TiogaIO.Error => {
                            barfum Ź IO.PutFR1["TiogaIO.Error while reading %g", [rope[arg]] ];
                            GOTO Abort};
                        Complain => {barfum Ź msg; GOTO Abort};
                        Warning => {cmd.err.PutRope[message.Concat["\n"]]; RESUME}};
                    tfoRoot: TiogaFileOps.Ref;
                    raRoot: REF ANY;
                    tnRoot: TextNode.Ref;
                    buff: IO.STREAM;
                    ubh: UB.Handle;
                    out: IO.STREAM;
                    head: Pair ~ Cons[NIL, NIL];
                    tail: Pair Ź head;
                    inFilePath: PFS.PATH Ź PFS.PathFromRope[arg];
                    inRoot: TextNode.Ref Ź TiogaIO.FromFile[inFilePath].root;
                    inLoc: TextNode.Location Ź [TextNode.FirstChild[inRoot], 0];
                    inDex: INT Ź TextNode.LocOffset[[inRoot, 0], inLoc];
                    posns: FormToSource Ź NIL;
                    lextStack: INT;
                    IF outName=NIL THEN outName Ź arg;
                    IF plainOut THEN {
                        buff Ź FS.StreamOpen[outName, create];
                        ubh Ź UB.Create[
                            publics: [margin: margin, width: plainWidths­,
                                spacers: plainSpacers, output: [stream[buff]]],
                            newline: "\n"];
                        }
                    ELSE {
                        tfoRoot Ź TiogaFileOps.CreateRoot[];
                        raRoot Ź tfoRoot;
                        tnRoot Ź NARROW[raRoot];
                        buff Ź TS.CreateOutput[to: tfoRoot, breakAtNewline: TRUE, defaultFormat: "scheme", flexilevel: TRUE, normalNestIndent: 3, 
                        minFmtIndent: 1, maxFmtIndent: 20, commentHandling: [FALSE[]] ];
                        TiogaFileOps.SetStyle[tfoRoot, "scheme"];
                        NodeProps.PutProp[tnRoot, $Comment, NodeProps.ValueFromBool[TRUE]];
                        ubh Ź UB.Create[publics: [margin: margin, output: [stream[buff]]],
                            newline: "\n"];
                        };
                    out Ź SS.Create[ubh];
                    DO
                        arg, anc: Any;
                        posns: FormToSource;
                        this: Pair;
                        IF debugRead THEN cmd.err.PutF1["Read[%g] => ", [integer[inDex]] ];
                        [arg, anc, posns, lextStack, inLoc, inDex] Ź TiogaRead[start: inLoc, stackBase: LOOPHOLE[PPLocal], addTo: posns, deltaIndex: inDex];
                        IF debugRead THEN {
                            InfoPrint[cmd.err, arg];
                            cmd.err.PutF1[" [%g]\n", [integer[inDex]] ]};
                        extStack Ź MAX[extStack, lextStack];
                        IF arg=endOfFile THEN EXIT;
                        IF anc=endOfFile AND head#tail THEN {
                            cmtd: Commented ~ NARROW[arg];
                            tail.car Ź AffixVector[tail.car, cmtd.prefix];
                            EXIT};
                        this Ź Cons[arg, NIL];
                        tail.cdr Ź this;
                        tail Ź this;
                        IF anc=endOfFile THEN EXIT;
                        ENDLOOP;
                    PrettyPrint[out, head.cdr, how, context, posns, debugLog];
                    IO.Close[out];
                    IF plainOut THEN IO.Close[buff]
                    ELSE {
                        IO.Close[buff]; --adds a nodebreak non-idempotently
                        IF FALSE THEN TS.EndNode[buff, reset, TRUE];
                        TiogaFileOps.Store[tfoRoot, outName];
                        };
                    i Ź i + 1;
                    outName Ź NIL};
            REPEAT
                Abort => RETURN [$Failure, barfum];
            ENDLOOP;
        IF UserProfile.Boolean["SchemePretty.ViewStackDepth", FALSE] THEN msg Ź IO.PutFR1["max read stack depth = %xH", 
        [integer[extStack]]];
        RETURN};

    DoProfile: Commander.CommandProc ~ {NoteProfile[edit]};

    Fmt: PROC [a: Any] RETURNS [ROPE] ~ {
        buf: IO.STREAM ~ IO.ROS[];
        Print[a, buf];
        RETURN buf.RopeFromROS[]};

    FmtScheme: PROC [a: Any] RETURNS [ROPE] ~ {
        buf: IO.STREAM ~ IO.ROS[];
        Print[a, buf !Complain => GOTO Abort];
        RETURN buf.RopeFromROS[];
        EXITS Abort => RETURN ["(can't print)"]};

    FmtInfo: PROC [a: Any] RETURNS [ROPE] ~ {
        buf: IO.STREAM ~ IO.ROS[];
        InfoPrint[buf, a !Complain => GOTO Abort];
        RETURN buf.RopeFromROS[];
        EXITS Abort => RETURN ["(can't print)"]};

    NoteProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc--~ {
        defaultMargin Ź UserProfile.Number["SchemePretty.margin", 80];
        defaultHow Ź [
            sia: UserProfile.Number["SchemePretty.sia", 2],
            simpleLen: UserProfile.Number["SchemePretty.simpleLen", 2],
            simpleQuote: UserProfile.Boolean["SchemePretty.simpleQuote", TRUE]
            ];
        };

    UserProfile.CallWhenProfileChanges[NoteProfile];

    Commander.Register[key: "SchemePrettyPrintFile", proc: PrettyPrintFileCmd, doc: "( [<outFileName> _] <inFileName> | <spec> ) 
    *\n<spec> = -margin <int>\n| -sia <int>\n| -simplelen <int>\n| -simplequote <boolean>\n| -debug <boolean>\n| -debugss 
    <boolean>\n| -context <name>\n| -plainOut <boolean>"];

    END.