<<>> <> <> <> 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]; ts 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) + ts afterForms ¬ formsStart-1; DO IF from.GetIndex[]-ts {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[]-ts 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.