[_CDCSL_93-16_]<1>Cedar>release>SchemePretty>SchemeViewing.mesa

SchemeViewing.mesa

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];

tsd: INT ¬ -1; --(Tioga stream index) - (TextNode.LocNumber) for corresponding locations

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.