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

SchemeViewing.mesa

Last tweaked by Mike Spreitzer on April 11, 1990 11:28 am PDT

DIRECTORY EditSpan, EditToolOps, IO, MessageWindow, NodeProps, NodeStyle, NodeStyleOps, Real, Rope, Scheme, SchemePrettyRead, SchemePrinting, StructuredStreamsExtras, TEditDocument, TEditInput, TEditInputOps, TEditSelection, TextEdit, TextNode, TiogaOps, TiogaStreams, UnparserBufferExtras, UserProfile;

SchemeViewing: CEDAR PROGRAM

IMPORTS EditSpan, EditToolOps, IO, MessageWindow, NodeProps, NodeStyle, NodeStyleOps, Real, Rope, Scheme, SchemePrettyRead, SchemePrinting, StructuredStreamsExtras, TEditInput, TEditInputOps, TEditSelection, TextEdit, TextNode, TiogaStreams, UnparserBufferExtras, UserProfile

BEGIN OPEN SPR:SchemePrettyRead, SP:SchemePrinting, SS:StructuredStreamsExtras, UB:UnparserBufferExtras;

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;

MessageWindow.Append["Debugging starts.", TRUE];

RETURN [TRUE, TRUE]};

DontDebugStart: PROC [viewer: TiogaOps.Viewer ¬ NIL] RETURNS [recordAtom: BOOL ¬ TRUE, quit: BOOL ¬ FALSE] --TiogaOps.CommandProc-- ~ {

debugStart ¬ FALSE;

MessageWindow.Append["Not debugging starts.", TRUE];

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-- ~ {

inputs: InputList ¬ LIST[[NIL, NIL]];

tail: InputList ¬ inputs;

indentSp, extra, formsStart, afterForms: INT ¬ 0;

newline: ROPE ¬ NIL;

ReadForms: PROC [from: IO.STREAM, nodeRope: ROPE, nodeStart, selStart, afterSel: INT, root, startNode: TextNode.Ref] RETURNS [whyNot: ROPE] ~ {

initial: INT ~ selStart-nodeStart;

min: INT ~ initial - (margin-5);

lineStart: INT ¬ initial;

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.InlineFetch[lineStart ¬ lineStart.PRED];

IF c='\r OR c='\l THEN {lineStart ¬ lineStart.SUCC; EXIT};

ENDLOOP;

extra ¬ initial - lineStart;

IF debugStart THEN MessageWindow.Append[IO.PutFR["%g+%g: ", [integer[indentSp]], [integer[extra]]], FALSE];

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

IO.SetIndex[from, (formsStart ¬ selStart) + tsd];

afterForms ¬ formsStart-1;

IF from.GetIndex[]-tsd >= afterSel THEN EXIT;

{form, nc: Scheme.Any;

posns: SPR.FormToSource;

[form, nc, posns] ¬ SPR.Read[from, SPR.noSource, TEditInput.interrupt !

Scheme.Complain => {

MessageWindow.Append[Rope.Cat["Scheme read err: ", msg], FALSE];

GOTO Bail};

SPR.Warning => {

MessageWindow.Append[Rope.Cat["Scheme read warning: ", message], FALSE];

RESUME}];

{this: InputList ~ LIST[[form, posns]];

afterForms ¬ from.GetIndex[]-tsd;

IF afterForms > afterSel THEN MessageWindow.Append[IO.PutFR[" last form extended %g chars beyond end of selection", [integer[afterForms-afterSel]]], FALSE];

tail.rest ¬ this;

tail ¬ this;

IF nc=Scheme.endOfFile THEN EXIT;

}}ENDLOOP;

RETURN [NIL];

EXITS Bail => RETURN [NIL]};

FormatForms: PROC RETURNS [start, end: INT, newIns: TEditDocument.BeforeAfter, with, whyNot: ROPE] ~ {

buff: IO.STREAM ~ IO.ROS[];

ubh: UB.Handle ~ UB.Create[publics: [margin: margin-indentSp, output: [stream[buff]]], newline: newline];

out: IO.STREAM ~ SS.Create[ubh];

FOR i: INT IN [0 .. extra) DO out.PutChar[' ] ENDLOOP;

SS.Begin[out];

{ENABLE UNWIND => {IO.Close[out]};

FOR fl: InputList ¬ inputs.rest, fl.rest WHILE fl#NIL DO

SP.PrettyPrint[out, fl.first.form, how, (IF data THEN $data ELSE $expr), fl.first.posns, NIL, TEditInput.interrupt !

UB.BogusInput => {whyNot ¬ Rope.Cat["UB err: ", msg]; GOTO Bail};

Scheme.Complain => {whyNot ¬ msg; GOTO Bail};

SPR.Warning => {MessageWindow.Append[message, TRUE]; RESUME}

];

IF fl.rest#NIL THEN SS.Bp[out, always, 0, " "];

ENDLOOP;

newIns ¬ after;

SS.End[out];

EXITS Bail => with ¬ NIL};

IO.Close[out];

IF whyNot#NIL THEN RETURN [0, -1, after, NIL, whyNot];

with ¬ IO.RopeFromROS[buff];

with ¬ with.Substr[start: extra];

RETURN [formsStart, afterForms, newIns, with, NIL]};

TEditInput.interrupt ¬ FALSE;

MessageWindow.Clear[];

StringReplace[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.GetScreenSpaceWidth[style];

IF spacePts=0.0 THEN spacePts ¬ 1.0;

indentSP ¬ Real.Round[indentPts/spacePts];

NodeStyleOps.Free[style];

RETURN};

Reader: TYPE ~ PROC [from: IO.STREAM, nodeRope: ROPE, nodeStart, selStart, afterSel: INT, root, startNode: TextNode.Ref] RETURNS [whyNot: ROPE];

Formatter: TYPE ~ PROC RETURNS [start, end: INT, newIns: TEditDocument.BeforeAfter, with, whyNot: ROPE];

StringReplace: PROC [Read: Reader, Format: Formatter] ~ {

opdRoot: TextNode.Ref ¬ NIL;

start, end: INT;

newIns: TEditDocument.BeforeAfter;

with, whyNot: ROPE ¬ NIL;

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

afterSel: TextNode.Location ~ RationalizeLoc[tSel.end.pos, tSel.granularity, after];

nodeStartIdx: INT ~ TextNode.LocOffset[[root, 0], [selStart.node, 0]];

selStartIdx: INT ~ nodeStartIdx + selStart.where;

afterSelIdx: INT ~ selStartIdx + TextNode.LocOffset[selStart, afterSel];

in: IO.STREAM ~ TiogaStreams.CreateInput[from: root, commentHandling: useDirectly];

super: ROPE ~ TextNode.NodeRope[selStart.node];

opdRoot ¬ root;

whyNot ¬ Read[in, super, nodeStartIdx, selStartIdx, afterSelIdx, root, selStart.node];

in.Close[];

RETURN}};

FinishStringReplace: PROC [root: TextNode.Ref, tSel: TEditDocument.Selection] = {

replStart: TextNode.Location ~ TextNode.LocRelative[[opdRoot, 0], start];

replEnd: TextNode.Location ~ TextNode.LocRelative[[opdRoot, 0], end-1];

resultLen: TextEdit.Offset;

TEditSelection.Deselect[];

IF end>start THEN EditSpan.Delete[opdRoot, [replStart, replEnd], TEditInput.currentEvent];

[resultLen: resultLen] ¬ TextEdit.InsertRope[root: opdRoot, dest: replStart.node, rope: with, destLoc: replStart.where, inherit: FALSE, event: TEditInput.currentEvent];

IF resultLen # with.Length[] THEN ERROR;

tSel.start.pos ¬ tSel.end.pos ¬ replStart;

tSel.pendingDelete ¬ FALSE;

IF resultLen = 0 THEN { -- make a caret

tSel.end.pos.where ¬ tSel.start.pos.where;

tSel.insertion ¬ before;

tSel.granularity ¬ point

}

ELSE {

tSel.end.pos.where ¬ tSel.start.pos.where+resultLen-1;

tSel.insertion ¬ newIns;

tSel.granularity ¬ char

};

TEditSelection.MakeSelection[tSel, primary];

RETURN};

TEditInputOps.CallWithLocks[StartStringReplace];

IF whyNot#NIL THEN {

MessageWindow.Append[whyNot, FALSE];

RETURN};

[start, end, newIns, with, whyNot] ¬ Format[];

IF whyNot#NIL THEN {

MessageWindow.Append[whyNot, FALSE];

RETURN};

IF end < start THEN RETURN;

TEditInputOps.CallWithLocks[FinishStringReplace];

RETURN};

RationalizeLoc: PROC [loc: TextNode.Location, granularity: TEditDocument.SelectionGrain, side: TEditDocument.BeforeAfter] RETURNS [TextNode.Location] ~ {

rope: ROPE ~ TextNode.NodeRope[loc.node];

len: INT ~ rope.Length[];

nodeSel: BOOL ~ granularity=node OR granularity=branch;

IF nodeSel

THEN loc.where ¬ IF side=before THEN 0 ELSE len

ELSE loc.where ¬ MAX[0, MIN[len, loc.where + (IF side=after THEN 1 ELSE 0)]];

RETURN [loc]};

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

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.