<<>>
    <<SchemeViewing.mesa>>
        <<Copyright Ó 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Last tweaked by Mike Spreitzer on May 12, 1992 12:56 pm PDT>>

    DIRECTORY EditSpan, EditToolOps, IO, NodeProps, NodeStyle, NodeStyleOps, Real, Rope, RuntimeError, Scheme, SchemePrettyRead, 
    SchemePrinting, SimpleFeedback, StructuredStreams, TEditDocument, TEditInput, TEditInputOps, TEditSelection, TextEditBogus, 
    TextNode, TiogaFileOps, TiogaOps, TiogaStreams, UnparserBuffer, UserProfile;

    SchemeViewing: CEDAR PROGRAM
        IMPORTS EditSpan, EditToolOps, IO, NodeProps, NodeStyle, NodeStyleOps, Real, Rope, RuntimeError, Scheme, SchemePrettyRead, 
        SchemePrinting, SimpleFeedback, StructuredStreams, TEditInput, TEditInputOps, TEditSelection, TextEditBogus, TextNode, 
        TiogaFileOps, TiogaStreams, UnparserBuffer, UserProfile
        =

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

    ROPE: TYPE ~ Rope.ROPE;

    InputList: TYPE ~ LIST OF Input;
    Input: TYPE ~ RECORD [form: Scheme.Any, posns: SPR.FormToSource];

    margin: INT Ź 60;
    how: SP.How Ź [3];

    ts

    debugStart: BOOL Ź FALSE;

    DoDebugStart: PROC [viewer: TiogaOps.Viewer Ź NIL] RETURNS [recordAtom: BOOL Ź TRUE, quit: BOOL Ź FALSE] --TiogaOps.CommandProc-- ~ 
    {
        debugStart Ź TRUE;
        SimpleFeedback.Append[$SchemePretty, oneLiner, $FYI, "Debugging starts."];
        RETURN [TRUE, TRUE]};

    DontDebugStart: PROC [viewer: TiogaOps.Viewer Ź NIL] RETURNS [recordAtom: BOOL Ź TRUE, quit: BOOL Ź FALSE] --TiogaOps.CommandProc-- 
    ~ {
        debugStart Ź FALSE;
        SimpleFeedback.Append[$SchemePretty, oneLiner, $FYI, "Not debugging starts."];
        RETURN [TRUE, TRUE]};

    SchemePPExpr: PROC [viewer: TiogaOps.Viewer Ź NIL] RETURNS [recordAtom: BOOL Ź TRUE, quit: BOOL Ź FALSE] --TiogaOps.CommandProc--
        ~ {RETURN SchemePP[viewer, FALSE]};

    SchemePPData: PROC [viewer: TiogaOps.Viewer Ź NIL] RETURNS [recordAtom: BOOL Ź TRUE, quit: BOOL Ź TRUE] --TiogaOps.CommandProc--
        ~ {RETURN SchemePP[viewer, TRUE]};

    SchemePP: PROC [viewer: TiogaOps.Viewer Ź NIL, data: BOOL] RETURNS [recordAtom: BOOL Ź TRUE, quit: BOOL Ź FALSE] 
    --TiogaOps.CommandProc-- ~ {
        head: Scheme.Pair Ź Scheme.Cons[NIL, NIL];
        tail: Scheme.Pair Ź head;
        posns: SPR.FormToSource Ź NIL;
        indentSp, extra: INT Ź 0;
        newline: ROPE Ź NIL;
        readSpan: TextNode.Span Ź TextNode.nullSpan;
        dbgStack: BOOL ~ UserProfile.Boolean["SchemePretty.ViewStackDepth", FALSE];
        dbgIdxs: BOOL ~ UserProfile.Boolean["SchemePretty.ViewIndices", FALSE];
        ReadForms: PROC [sel: TextNode.Span, selStartIdx, selEndIdx: INT, root, startNode: TextNode.Ref] RETURNS [whyNot: ROPE] ~ {
            nodeStart: INT ~ selStartIdx - sel.start.where;
            nodeRope: ROPE ~ TextEditBogus.GetRope[sel.start.node];
            initial: INT ~ selStartIdx-nodeStart;
            min: INT ~ initial - (margin-5);
            lineStart: INT Ź initial;
            formsEnd: INT Ź selStartIdx-1;
            extStack: INT Ź 0;
            afterForms: INT Ź selStartIdx;
            nextLoc: TextNode.Location Ź sel.start;
            indentSp Ź GetIndentSpaces[startNode];
            newline Ź WITH NodeProps.GetProp[root, $NewlineDelimiter] SELECT FROM
                x: ROPE => x,
                x: REF CHAR => Rope.FromChar[x­],
                ENDCASE => "\n";
            WHILE lineStart>0 AND lineStart>min DO
                c: CHAR ~ nodeRope.Fetch[lineStart Ź lineStart.PRED];
                IF c='\r OR c='\l THEN {lineStart Ź lineStart.SUCC; EXIT};
                ENDLOOP;
            extra Ź initial - lineStart;
            newline Ź newline.Concat[allSpaces.Substr[len: extra]];
            IF debugStart THEN SimpleFeedback.PutFL[$SchemePretty, oneLiner, $FYI, "ReadForms: %g+%g", LIST[ [integer[indentSp]], 
            [integer[extra]]]];
            IF extra > margin-indentSp-5 THEN RETURN [IO.PutFR["form starts more than %g characters into %g-indented node", 
            [integer[margin-indentSp-5]], [integer[indentSp]] ]];
            {DO
                IF afterForms > selEndIdx THEN EXIT;
                {form, nc: Scheme.Any; lextStack: INT;
                IF dbgIdxs THEN SimpleFeedback.PutFL[$SchemePretty, begin, $FYI, "TiogaRead[[%g\"%q\", %g], %g] ", LIST[ 
                [cardinal[LOOPHOLE[nextLoc.node]]], [rope[nextLoc.node.rope]], [integer[nextLoc.where]], [integer[afterForms]] ]];
                [form, nc, posns, lextStack, nextLoc, afterForms] Ź SPR.TiogaRead[nextLoc, GetStackAddr[], SPR.allButOther, TEditInput.interrupt, 
                posns, afterForms !
                    Scheme.Complain => {
                        SimpleFeedback.Append[$SchemePretty, oneLiner, $Error, Rope.Concat["Scheme read err: ", msg]];
                        GOTO Bail};
                    SPR.Warning => {
                        SimpleFeedback.Append[$SchemePretty, oneLiner, $Warning, Rope.Concat["Scheme read warning: ", message]];
                        RESUME}];
                IF dbgIdxs THEN SimpleFeedback.PutFL[$SchemePretty, end, $FYI, "=> [[%g\"%q\", %g], %g]", LIST[ [cardinal[LOOPHOLE[nextLoc.node]]], 
                [rope[nextLoc.node.rope]], [integer[nextLoc.where]], [integer[afterForms]] ]];
                extStack Ź MAX[extStack, lextStack];
                {this: Scheme.Pair ~ Scheme.Cons[form, NIL];
                IF afterForms > selEndIdx+1 THEN SimpleFeedback.PutF[$SchemePretty, oneLiner, $Warning, " last form extended %g chars beyond end of 
                selection", [integer[afterForms-selEndIdx-1]] ];
                IF dbgStack THEN SimpleFeedback.PutF[$SchemePretty, oneLiner, $Warning, " max read stack = %xH", [integer[extStack]] ];
                tail.cdr Ź this;
                tail Ź this;
                IF nc=Scheme.endOfFile THEN EXIT;
                }}ENDLOOP;
            EXITS Bail => root Ź root};
            IF dbgIdxs THEN SimpleFeedback.PutFL[$SchemePretty, oneLiner, $FYI, "selStartIdx=%g, afterForms=%g, selEndIdx=%g", LIST[ 
            [integer[selStartIdx]], [integer[afterForms]], [integer[selEndIdx]] ]];
            IF head.cdr=NIL THEN RETURN ["no forms successfully read"];
            SELECT TRUE FROM
                afterForms > selEndIdx => readSpan Ź [sel.start, TextNode.LocRelative[sel.end, afterForms-selEndIdx-1]];
                afterForms > selStartIdx => readSpan Ź [sel.start, TextNode.LocRelative[sel.start, afterForms-selStartIdx-1]];
                ENDCASE => RETURN ["Can't happen: afterForms <= selStartIdx"];
            RETURN [NIL]};
        FormatForms: PROC RETURNS [old, new: TextNode.Span, newRoot: TextNode.Ref, newIns: TEditDocument.BeforeAfter, whyNot: ROPE] ~ {
            tfoRoot: TiogaFileOps.Ref ~ TiogaFileOps.CreateRoot[];
            raRoot: REF ANY ~ tfoRoot;
            buff: IO.STREAM ~ TS.CreateOutput[to: tfoRoot, breakAtNewline: TRUE, defaultFormat: "scheme", flexilevel: TRUE, normalNestIndent: 
            3, minFmtIndent: 1, maxFmtIndent: 20, commentHandling: [FALSE[]] ];
            ubh: UB.Handle ~ UB.Create[publics: [margin: margin-indentSp, output: [stream[buff]]], newline: newline];
            out: IO.STREAM ~ SS.Create[ubh];
            newRoot Ź NARROW[raRoot];
            SS.Begin[out];
            {ENABLE UNWIND => {IO.Close[out]};
            SP.PrettyPrint[out, head.cdr, how, (IF data THEN $datas ELSE $exprs), posns, NIL, TEditInput.interrupt !
                UB.BogusInput => {whyNot Ź Rope.Concat["UB err: ", msg]; GOTO Bail};
                Scheme.Complain => {whyNot Ź msg; GOTO Bail};
                SPR.Warning => {SimpleFeedback.Append[$SchemePretty, oneLiner, $Warning, message]; RESUME}
                ];
            SS.End[out];
            EXITS Bail => whyNot Ź whyNot};
            IO.Close[out];
            IO.Close[buff];
            IF whyNot#NIL THEN RETURN [TextNode.nullSpan, TextNode.nullSpan, NIL, after, whyNot];
            new Ź [[TextNode.FirstChild[newRoot], 0], TextNode.LastLocWithin[newRoot]];
            new.end.where Ź MAX[new.end.where-1, 0]; --LastLocWithin returns end pointing after last char, which we don't want the final 
            selection to do
            IF new.start.node=NIL THEN RETURN [TextNode.nullSpan, TextNode.nullSpan, NIL, after, "no output!"];
            RETURN [readSpan, new, newRoot, before, NIL]};
        TEditInput.interrupt­ Ź FALSE;
        SimpleFeedback.ClearHerald[$SchemePretty, $Warning];
        SpanReplace[ReadForms, FormatForms];
        RETURN [quit: TRUE]};

    GetIndentSpaces: PROC [node: TextNode.Ref] RETURNS [indentSP: INT] ~ {
        style: NodeStyle.Ref ~ NodeStyleOps.Alloc[];
        indentPts, spacePts: REAL;
        NodeStyleOps.ApplyAll[style, node, screen];
        indentPts Ź NodeStyle.GetReal[style, leftIndent];
        spacePts Ź NodeStyle.GetSpaceWidth[style];
        IF spacePts=0.0 THEN spacePts Ź 1.0;
        indentSP Ź Real.Round[indentPts/spacePts];
        NodeStyleOps.Free[style];
        RETURN};

    Reader: TYPE ~ PROC [sel: TextNode.Span, selStartIdx, selEndIdx: INT, root, startNode: TextNode.Ref] RETURNS [whyNot: ROPE];

    Formatter: TYPE ~ PROC RETURNS [old, new: TextNode.Span, newRoot: TextNode.Ref, newIns: TEditDocument.BeforeAfter, whyNot: ROPE];

    SpanReplace: PROC [Read: Reader, Format: Formatter] ~ {
        opdRoot, newRoot: TextNode.Ref Ź NIL;
        old, new: TextNode.Span;
        newIns: TEditDocument.BeforeAfter;
        whyNot: ROPE Ź NIL;
        dbgIdxs: BOOL ~ UserProfile.Boolean["SchemePretty.ViewIndices", FALSE];
        StartStringReplace: PROC [root: TextNode.Ref, tSel: TEditDocument.Selection] = {
            IF tSel.viewer=NIL OR tSel.data#tSel.viewer.data THEN {whyNot Ź "deleted or inconsistent viewer"; RETURN};
            IF tSel.start.pos.node=NIL OR tSel.end.pos.node=NIL THEN {whyNot Ź "NIL node"; RETURN};
            {selStart: TextNode.Location ~ RationalizeLoc[tSel.start.pos, tSel.granularity, before];
            selEnd: TextNode.Location ~ RationalizeLoc[tSel.end.pos, tSel.granularity, after];
            selStartIdx: INT ~ TextNode.LocOffset[[root, 0], selStart];
            selEndIdx: INT ~ selStartIdx + TextNode.LocOffset[selStart, selEnd];
            opdRoot Ź root;
            whyNot Ź Read[[selStart, selEnd], selStartIdx, selEndIdx, root, selStart.node];
            RETURN}};
        FinishStringReplace: PROC [root: TextNode.Ref, tSel: TEditDocument.Selection] = {
            result: TextNode.Span;
            resultLen: INT;

            TEditSelection.Deselect[];
            result Ź EditSpan.Replace[opdRoot, newRoot, old, new, FALSE, TEditInput.currentEvent];
            resultLen Ź TextNode.LocOffset[result.start, result.end];
            tSel.start.pos Ź result.start;
            tSel.end.pos Ź result.end;
            tSel.pendingDelete Ź FALSE;
            IF resultLen = 0 THEN { -- make a caret
                tSel.insertion Ź before;
                tSel.granularity Ź point
                }
            ELSE {
                tSel.insertion Ź newIns;
                tSel.granularity Ź char
                };
            TEditSelection.MakeSelection[tSel, primary];
            RETURN};

        TEditInputOps.CallWithLocks[StartStringReplace];
        IF whyNot#NIL THEN {
            SimpleFeedback.Append[$SchemePretty, oneLiner, $Error, whyNot];
            RETURN};
        [old, new, newRoot, newIns, whyNot] Ź Format[];
        IF whyNot#NIL THEN {
            SimpleFeedback.Append[$SchemePretty, oneLiner, $Error, whyNot];
            RETURN};
        IF dbgIdxs THEN {
            SimpleFeedback.PutFL[$SchemePretty, begin, $FYI, "old=[start: [%g\"%q\", %g]", LIST[ [cardinal[LOOPHOLE[old.start.node]]], 
            [rope[old.start.node.rope]], [integer[old.start.where]] ]];
            SimpleFeedback.PutFL[$SchemePretty, end, $FYI, ", end: [%g\"%q\", %g]]", LIST[ [cardinal[LOOPHOLE[old.end.node]]], 
            [rope[old.end.node.rope]], [integer[old.end.where]] ]];
            };
        TEditInputOps.CallWithLocks[FinishStringReplace];
        RETURN};

    RationalizeLoc: PROC [loc: TextNode.Location, granularity: TEditDocument.SelectionGrain, side: TEditDocument.BeforeAfter] RETURNS 
    [TextNode.Location] ~ {
        rope: ROPE ~ TextEditBogus.GetRope[loc.node];
        len: INT ~ rope.Length[];
        nodeSel: BOOL ~ granularity=node OR granularity=branch;
        IF nodeSel
            THEN loc.where Ź IF side=before THEN 0 ELSE MAX[0, len-1]
            ELSE loc.where Ź MAX[0, MIN[len, loc.where]];
        RETURN [loc]};

    allSpaces: ROPE ~ Rope.MakeRope[base: NEW [CHAR Ź ' ], size: INT.LAST, fetch: AllFetch];

    AllFetch: PROC [data: REF ANY, index: INT] RETURNS [CHAR] ~ {
        IF index=INT.LAST THEN ERROR RuntimeError.BoundsFault[];
        RETURN [NARROW[data, REF CHAR]­]};

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

    GetStackAddr: PROC RETURNS [INT] ~ TRUSTED INLINE {
        local: INT Ź 3;
        lp: LONG POINTER Ź @local;
        RETURN [LOOPHOLE[lp]]};

    Start: PROC ~ {
        UserProfile.CallWhenProfileChanges[NoteProfile];
        EditToolOps.RegisterCommandButton[buttonName: "SchemePrettyPrintExpr", proc: SchemePPExpr, startNextLine: TRUE];
        EditToolOps.RegisterCommandButton[buttonName: "SchemePrettyPrintData", proc: SchemePPData, startNextLine: FALSE];
        EditToolOps.RegisterCommandButton[buttonName: "SchemePrettyDoDebugStart", proc: DoDebugStart, startNextLine: FALSE];
        EditToolOps.RegisterCommandButton[buttonName: "SchemePrettyDontDebugStart", proc: DontDebugStart, startNextLine: FALSE];
        };

    Start[];

    END.