

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.
    آ  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
‌تo  •NewlineDelimiter
–(cedarcode) styleک code™Kڑœ
دeœ7™BK™#K™:—Kک Kڑدk	œ)‍œ‍œ‍œگکطKک ڑدnœ‍œ‍ک#Kڑ‍œ)‍œ‍œ‍œڈکصKک—Kک Kڑ
‍œ‍œ+‍œ‍œ‍œکnKک KکKڑœ‍œکKک ڑ
œ‍œ‍œ‍œ‍œ‍ک&Kڑœ‍œ‍œ‍œ‍œ‍œ‍œک&—Kڑœ
‍œک)Kڑ	œ‍œ‍œ‍œ‍œ
ک+Kک ڑںœ‍œ‍œ
‍œ‍œ‍œ‍œ‍œدcœکKڑںœ‍œکKک<KکKڑœ‍œکKڑœ‍œ‍œکKڑœ	‍œ
کKڑœ‍œ‍œک+Kڑœ
‍œ‍œ‍œکKڑœ‍œکKڑœ	‍œ‍œکKڑœ
‍œکKڑœ‍œک
ڑ‍œ‍کڑ‍œکKڑœ‍œک'Kڑœ?‍œکKKک—Kڑœ‍œکKڑ‍œ‍œ‍œکڑ‍œ‍œ‍کڑœ‍œ‍œ
ک&Kڑ‍œ‍œ!ک,ڑ‍œ‍œ‍œ‍کKڑœ‍œ*‍œکUKڑœ‍œ+‍œکSKڑœ‍œ1‍œک_Kڑœ‍œ4‍œکdKڑœ‍œ‍œ‍œ‍œ	‍œ‍œکpKڑœ‍œ-‍œکZKڑœ‍œ,‍œکXKڑœ‍œ.‍œک\Kڑœ‍œ%‍œکQKڑ‍œ‍œ7کH——Kڑœ‍œ‍œ	‍œ‍œ‍œ*کfڑ‍œکڑ‍œکڑ‍œکKڑœ	‍œmکxKڑ‍œک—کKڑœ	‍œ8کCKڑ‍œک—Kڑœ‍œک'Kڑœ3‍œک<—KڑœکKڑœ‍œ‍کKڑœکKڑœ‍œ‍کKڑœ‍œکKڑœ‍œ‍کKڑœ‍œ‍œکKکKڑœ‍œ‍œ‍œک-Kک9Kک<Kڑœ‍œ*ک4Kڑœ‍œکKڑœ‍œکKڑ‍œ	‍œ‍œک"ڑ‍œ
‍œکKڑœ‍œک&ڑœ‍œکک.Kڑœ/ک/—Kڑœک—Kک—ڑ‍œکKک$KکKڑœ	‍œ	کKڑ	œ‍œ+‍œ'‍œL‍œک؛Kڑœ)ک)Kڑœ<‍œکCڑœ‍œ:کBKڑœک—Kڑœک—Kڑœ‍œکڑ‍کKکKکKکKڑ‍œ‍œ2کCKڑœP‍œ,ک„ڑ‍œ‍œکKکKک-—Kڑœ‍œک$Kڑ‍œ‍œ‍œکڑ‍œ‍œ‍œک%Kڑœ‍œکKک.Kڑ‍œک—Kڑœ‍œکKکKکKڑ‍œ‍œ‍œکKڑ‍œک—Kڑœ:ک:Kڑ‍œکKڑ‍œ
‍œ‍œکڑ‍œکKڑ‍œ #ک3Kڑ
‍œ‍œ‍œ‍œ‍œک,Kڑœ%ک%Kڑœک—Kک
Kڑœ
‍œک——ڑ‍کKڑœ	‍œک#—Kڑ‍œک—Kڑ‍œ4‍œ‍œ‍œ;ک…Kڑ‍œک—Kک Kڑں	œ.ک7Kک ڑںœ‍œ
‍œ‍œک%Kڑ	œ‍œ‍œ‍œ‍œکKکKڑ‍œک—Kک ڑں	œ‍œ
‍œ‍œک+Kڑ	œ‍œ‍œ‍œ‍œکKڑœ‍œک&Kڑ‍œکKڑ‍œ
‍œک)—Kک ڑںœ‍œ
‍œ‍œک)Kڑ	œ‍œ‍œ‍œ‍œکKڑœ‍œک*Kڑ‍œکKڑ‍œ
‍œک)—Kک ڑںœ‍œ+ "œکaKک>کKڑœ/ک/Kڑœ;ک;Kڑœ=‍œکBKک—Kک—Kک Kڑœ0ک0Kک Kڑœ©ک©Kک Kڑ‍œک— …—      !A  