<> <> <> <> DIRECTORY Commander, Convert, EditNotify, InputFocus, IO, List, Menus, Process, PositionedList, Real, RefTab, RefText, Rope, ScreenCoordsTypes, TextNode, Tioga, TiogaButtons, TiogaOps, TypeScript, Vector2, ViewerClasses, ViewerOps, ViewerSpecs, ViewerTools; ViewerCommandsImpl: CEDAR MONITOR LOCKS c USING c: Connection IMPORTS Commander, Convert, EditNotify, InputFocus, IO, List, Menus, PositionedList, Process, Real, RefTab, RefText, Rope, TextNode, TiogaButtons, TiogaOps, TypeScript, ViewerOps, ViewerSpecs, ViewerTools SHARES ViewerClasses--because the damn .link and .name fields of a MenuEntry are inaccessible through PUBLIC things-- = BEGIN <> LORA: TYPE ~ LIST OF REF ANY; LOLORA: TYPE ~ LIST OF LORA; ROPE: TYPE ~ Rope.ROPE; LOR: TYPE ~ LIST OF ROPE; LOLOR: TYPE ~ LIST OF LOR; Viewer: TYPE ~ ViewerClasses.Viewer; MenuEntry: TYPE ~ ViewerClasses.MenuEntry; TiogaButton: TYPE ~ TiogaButtons.TiogaButton; Error: ERROR [msg: ROPE] ~ CODE; Argument: TYPE ~ RECORD [start, length: INT, arg: REF ANY]; LOA: TYPE ~ LIST OF Argument; Butt: TYPE ~ RECORD [button: ViewerClasses.MouseButton ¬ red, shift, control: BOOL ¬ FALSE]; Connection: TYPE ~ REF ConnectionPrivate; ConnectionPrivate: TYPE ~ MONITORED RECORD [ cmd: Commander.Handle, v: Viewer, docRoot: TiogaOps.Ref, going: BOOL ¬ TRUE, head, tail: LOR ¬ NIL, change: CONDITION]; PositionedArgumentList: TYPE ~ PositionedList.PositionedArgumentList; <> cvProp: ATOM ~ $CurrentViewer; matchSubtree: ROPE ~ "**"; up: ROPE ~ ".."; restart: ROPE ~ "/"; inputFocus: ROPE ~ "/InputFocus"; rootClass: ViewerClasses.ViewerClass ~ NEW [ViewerClasses.ViewerClassRec ¬ [flavor: $Root]]; rootViewer: Viewer ~ NEW [ViewerClasses.ViewerRec ¬ [name: "root", class: rootClass]]; outs: RefTab.Ref --viewer <> PWV: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { cv: Viewer ~ GetCV[cmd]; PrintPath[cmd.out, FullName[cv], TRUE]; cmd.out.PutRope["\n"]; RETURN}; CV: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; path: LOR ~ IF args#NIL THEN ConvertToLOR[args.first.arg] ELSE NIL; found: BOOL ¬ TRUE; newCV: Viewer; IF args=NIL THEN newCV ¬ NIL ELSE IF args.rest#NIL THEN Error["CV takes only 1 argument"] ELSE [found, newCV] ¬ Find[cv, path]; IF found THEN cmd.propertyList ¬ List.PutAssoc[key: cvProp, val: newCV, aList: cmd.propertyList] ELSE Error[Rope.Cat[FmtFullName[cv], " ", FmtPath[path], " not found"]]; PrintPath[cmd.out, FullName[newCV], TRUE]; cmd.out.PutRope["\n"]; RETURN}; VLs: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; menu, pos: BOOL ¬ FALSE; labels, icons: BOOL ¬ TRUE; curPath: LOR ¬ LIST[NIL]; Per: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN v ¬ rootViewer; {path: LOR ~ FullName[v.parent]; IF NOT labels THEN SELECT v.class.flavor FROM $Label, $NumberLabel, $Rule => RETURN; ENDCASE => NULL; depth ¬ MAX[depth, 1] - 1; IF NOT LOREqual[curPath, path] THEN { PrintTimes[cmd.out, "\t", depth]; PrintPath[cmd.out, path, TRUE]; cmd.out.PutRope["\n"]; curPath ¬ path}; PrintTimes[cmd.out, "\t", depth]; cmd.out.PutF1["%g", [atom[v.class.flavor]]]; IF pos THEN { cmd.out.PutF["[%g, %g, %g, ", [integer[v.wx]], [integer[v.wy]], [integer[v.ww]] ]; cmd.out.PutF1["%g]", [integer[v.wh]] ]; }; cmd.out.PutF1[": %g", [rope[QuoteName[ShortName[v]]]]]; cmd.out.PutRope["\n"]; IF menu THEN { IF v.menu#NIL THEN FOR i: INT IN [0 .. Menus.GetNumberOfLines[v.menu]) DO PrintTimes[cmd.out, "\t", depth+1]; cmd.out.PutF1["Menu line %g:", [integer[i]]]; FOR me: MenuEntry ¬ Menus.GetLine[v.menu, i], me.link WHILE me#NIL DO cmd.out.PutRope[" "]; cmd.out.PutRope[QuoteName[me.name]]; ENDLOOP; cmd.out.PutRope["\n"]; ENDLOOP; IF TiogaButtons.IsTiogaButtons[v] THEN { Print: PROC [x: TiogaButton] RETURNS [BOOL] ~ { this: ROPE ~ TiogaOps.GetRope[x.startLoc.node].Substr[start: x.startLoc.where, len: 1 + x.endLoc.where - x.startLoc.where]; cmd.out.PutRope[" "]; cmd.out.PutRope[this]; RETURN [FALSE]}; PrintTimes[cmd.out, "\t", depth+1]; cmd.out.PutRope["TiogaButtons:"]; [] ¬ TiogaButtons.EnumerateTiogaButtons[v, Print]; cmd.out.PutRope["\n"]; }; }; RETURN}}; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO IF al.first.arg # NIL THEN WITH al.first.arg SELECT FROM x: ROPE => IF x.Fetch[0]='- THEN { nextSense: BOOL ¬ TRUE; FOR i: INT IN (0 .. x.Length) DO sense: BOOL ~ nextSense; SELECT x.Fetch[i] FROM '-, '~ => nextSense ¬ FALSE; 'i => icons ¬ sense; 'l => labels ¬ sense; 'm => menu ¬ sense; 'p => pos ¬ sense; ENDCASE => Error[Rope.Concat["Unknown switch: ", Convert.RopeFromChar[x.Fetch[i]]]]; ENDLOOP; LOOP}; x: LOA => NULL; ENDCASE => Error[IO.PutFR1["Argument (%g) not a ROPE or LIST", [refAny[al.first.arg]] ]]; EnumViewers[0, cv, ConvertToLOR[al.first.arg], icons, Per]; ENDLOOP; RETURN}; VType: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Type: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; {contents: ROPE ~ ViewerTools.GetContents[v]; PrintPath[cmd.out, FullName[v], FALSE]; IF contents.Length[]=0 THEN cmd.out.PutRope[" has no contents"] ELSE { cmd.out.PutRope[":\n"]; cmd.out.PutRope[contents]; cmd.out.PutRope["\n\n"]}; RETURN}}; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumViewers[0, cv, ConvertToLOR[al.first.arg], TRUE, Type]; ENDLOOP; RETURN}; VSet: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; IF args=NIL OR args.rest=NIL OR args.rest.rest#NIL THEN Error["Exactly two args, please"]; {path: LOR ~ ConvertToLOR[args.first.arg]; new: ROPE ~ WITH args.rest.first.arg SELECT FROM x: ROPE => x, ENDCASE => Error[IO.PutFR1["New contents must be a ROPE, not %g", [refAny[args.rest.first.arg]] ]]; v: Viewer ~ Find[cv, path].ans; IF v=NIL THEN Error[Rope.Cat[FmtFullName[cv], " ", FmtPath[path], " not found"]]; ViewerTools.SetContents[v, new]; RETURN}}; VConnect: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; found: BOOL; v: Viewer; docRoot: TiogaOps.Ref; IF args=NIL OR args.rest#NIL THEN Error["Exactly one argument, please"]; {path: LOR ~ ConvertToLOR[args.first.arg]; [found, v] ¬ Find[cv, path]; IF NOT found THEN Error[Rope.Cat[FmtFullName[cv], " ", FmtPath[path], " not found"]]; IF v=NIL OR v.class.flavor#$Typescript THEN Error[Rope.Concat[FmtFullName[v], " not a TypeScript"]]; docRoot ¬ TiogaOps.ViewerDoc[v]; {c: Connection ~ NEW [ConnectionPrivate ¬ [cmd: cmd, v: v, docRoot: docRoot]]; TRUSTED { Process.EnableAborts[@c.change]; Process.SetTimeout[@c.change, Process.SecondsToTicks[10]]; Process.Detach[FORK CopyOutput[c]]}; [] ¬ outs.Store[docRoot, c]; CopyInput[c !UNWIND => {c.going ¬ FALSE; [] ¬ outs.Delete[docRoot]}]; c.going ¬ FALSE; [] ¬ outs.Delete[docRoot]; RETURN}}}; <> VNotify: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; IF args=NIL THEN Error["Just what am I supposed to notify, anyway?"]; {path: LOR ~ ConvertToLOR[args.first.arg]; v: Viewer ~ Find[cv, path].ans; IF v=NIL THEN Error[Rope.Cat[FmtFullName[cv], " ", FmtPath[path], " not found"]]; {rest: ROPE ~ cmd.commandLine.Substr[start: args.first.start+args.first.length]; restin: IO.STREAM ~ IO.RIS[Rope.Cat["( ", rest, " )"]]; input: REF ANY ~ IO.GetRefAny[restin !IO.Error => Error["IO Syntax error"]]; il: LORA ~ IF input#NIL THEN WITH input SELECT FROM x: LORA => x, ENDCASE => Error["Not a LIST!"] ELSE NIL; FOR li: LORA ¬ il, li.rest WHILE li#NIL DO IF li.first = $Coords THEN li.first ¬ NEW [ScreenCoordsTypes.TIPScreenCoordsRec ¬ [1, 1, FALSE]] ELSE IF li.first = $RealCoords THEN li.first ¬ NEW [Vector2.VEC ¬ [0, 0]]; ENDLOOP; v.class.notify[v, il]; RETURN}}}; BPush: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; IF args=NIL THEN Error["Just what am I supposed to push, anyway?"]; {path: LOR ~ ConvertToLOR[args.first.arg]; v: Viewer ~ Find[cv, path].ans; butt: Butt ~ ParseButt[args.rest]; input: LORA ¬ LIST[mbAtoms[butt.button], $Hit]; IF v=NIL THEN Error[Rope.Cat[FmtFullName[cv], " ", FmtPath[path], " not found"]]; IF v.class.flavor # $Button THEN Error[Rope.Concat[FmtFullName[v], " not a button"]]; IF butt.shift THEN input ¬ CONS[$Shift, input]; IF butt.control THEN input ¬ CONS[$Control, input]; input ¬ CONS[$Mark, input]; input ¬ CONS[NEW [ScreenCoordsTypes.TIPScreenCoordsRec ¬ [1, 1, FALSE]], input]; v.class.notify[v, input]; RETURN}}; mbAtoms: ARRAY ViewerClasses.MouseButton OF ATOM ~ [red: $Red, yellow: $Yellow, blue: $Blue]; MPush: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; name: ROPE; IF args=NIL OR args.rest=NIL THEN Error["Just what am I supposed to push, anyway?"]; WITH args.rest.first.arg SELECT FROM x: ROPE => name ¬ x; ENDCASE => Error[IO.PutFR1["Menu entry name must be a ROPE, not (%g)", [refAny[args.rest.first.arg]] ]]; {path: LOR ~ ConvertToLOR[args.first.arg]; v: Viewer ~ Find[cv, path].ans; IF v=NIL THEN Error[Rope.Cat[FmtFullName[cv], " ", FmtPath[path], " not found"]]; IF v.menu=NIL THEN Error["Viewer not found"]; {me: MenuEntry ~ Menus.FindEntry[v.menu, name]; butt: Butt ~ ParseButt[args.rest.rest]; IF me=NIL THEN Error["Menu entry not found"]; me.proc[v, me.clientData, butt.button, butt.shift, butt.control]; RETURN}}}; TPush: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE}; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; name: ROPE; IF args=NIL OR args.rest=NIL THEN Error["Just what am I supposed to push, anyway?"]; WITH args.rest.first.arg SELECT FROM x: ROPE => name ¬ x; ENDCASE => Error[IO.PutFR1["Tioga button name must be a ROPE, not (%g)", [refAny[args.rest.first.arg]] ]]; {path: LOR ~ ConvertToLOR[args.first.arg]; v: Viewer ~ Find[cv, path].ans; IF v=NIL THEN Error[Rope.Cat[FmtFullName[cv], " ", FmtPath[path], " not found"]]; IF NOT TiogaButtons.IsTiogaButtons[v] THEN Error[Rope.Concat[FmtFullName[v], " not a TiogaButtons viewer"]]; {tb: TiogaButton ~ FindTiogaButton[v, name]; butt: Butt ~ ParseButt[args.rest.rest]; IF tb=NIL THEN Error["Tioga button not found"]; tb.proc[tb, tb.clientData, butt.button, butt.shift, butt.control]; RETURN}}}; <> MoveBoundary: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { in: IO.STREAM ~ IO.RIS[cmd.commandLine]; IF cmd.commandLine.Find["."] >= 0 THEN { x: REAL ~ in.GetReal[]; IF x<0 OR x>1 THEN RETURN [$Failure, "Get real"]; ViewerOps.MoveBoundary[Real.Round[x*ViewerSpecs.bwScreenWidth], ViewerSpecs.openBottomY]; } ELSE { div: INT ~ in.GetInt[]; ViewerOps.MoveBoundary[div, ViewerSpecs.openBottomY]; }; RETURN}; Paint: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ViewerOps.PaintEverything[]; RETURN}; VOpen: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Open: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.OpenIcon[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Open]; ENDLOOP; RETURN }; VClose: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Close: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.CloseViewer[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Close]; ENDLOOP; RETURN }; VDestroy: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Destroy: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.DestroyViewer[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Destroy]; ENDLOOP; RETURN }; <> VTop: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Top: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.TopViewer[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Top]; ENDLOOP; RETURN }; VBottom: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Bottom: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.BottomViewer[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Bottom]; ENDLOOP; RETURN }; VLeft: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Left: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.ChangeColumn[v, left]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Left]; ENDLOOP; RETURN }; VRight: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Right: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.ChangeColumn[v, right]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Right]; ENDLOOP; RETURN }; VColor: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Color: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.ChangeColumn[v, color]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Color]; ENDLOOP; RETURN }; VGrow: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Grow: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; ViewerOps.GrowViewer[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Grow]; ENDLOOP; RETURN }; <> <<>> VFull: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Full: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; IF v.iconic THEN ViewerOps.OpenIcon[v]; IF ViewersInColumn[v] > 1 THEN -- more than 1 viewer, so grow ViewerOps.GrowViewer[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Full]; ENDLOOP; RETURN }; VShrink: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- = { ENABLE Error => { cmd.err.PutRope[msg]; cmd.err.PutRope["\n"]; result ¬ $Failure; CONTINUE }; args: LOA ~ Parse[cmd]; cv: Viewer ~ GetCV[cmd]; Shrink: PROC [depth: INTEGER, v: Viewer] ~ { IF v=NIL THEN RETURN; IF ViewersInColumn[v] = 1 THEN -- only 1 viewer, so grow ViewerOps.GrowViewer[v]; }; FOR al: LOA ¬ args, al.rest WHILE al#NIL DO EnumTopViewersOnce[0, cv, ConvertToLOR[al.first.arg], TRUE, Shrink]; ENDLOOP; RETURN }; <> GetCV: PROC [cmd: Commander.Handle] RETURNS [Viewer] ~ { RETURN [NARROW[List.Assoc[key: cvProp, aList: cmd.propertyList]]]}; FindTiogaButton: PROC [v: Viewer, name: ROPE] RETURNS [tb: TiogaButton ¬ NIL] ~ { Try: PROC [x: TiogaButton] RETURNS [BOOL] ~ { this: ROPE; IF x.startLoc.node # x.endLoc.node THEN ERROR; this ¬ TiogaOps.GetRope[x.startLoc.node]; IF NOT TiogaButtons.IsEntireNode[x] THEN this ¬ this.Substr[start: x.startLoc.where, len: 1 + x.endLoc.where - x.startLoc.where]; IF Rope.Match[pattern: name, object: this, case: FALSE] THEN {tb ¬ x; RETURN [TRUE]} ELSE RETURN [FALSE] }; [] ¬ TiogaButtons.EnumerateTiogaButtons[v, Try]; RETURN}; CopyInput: PROC [c: Connection] ~ { buff: REF TEXT ~ RefText.New[buffSize]; DO nAvail: INT ~ c.cmd.in.CharsAvail[TRUE]; nDo: INT ~ MIN[nAvail, buff.maxLength]; IF nAvail=0 THEN {Process.PauseMsec[500]; LOOP}; [] ¬ c.cmd.in.GetBlock[block: buff, count: nDo]; TypeScript.TypeIn[c.v, buff]; ENDLOOP; }; buffSize: NATURAL ¬ 256; CopyOutput: PROC [c: Connection] ~ { change: ROPE ¬ NIL; going: BOOL ¬ TRUE; Get: ENTRY PROC [c: Connection] ~ { WHILE c.head=NIL DO WAIT c.change ENDLOOP; change ¬ c.head.first; c.head ¬ c.head.rest; IF c.head=NIL THEN c.tail ¬ NIL; going ¬ c.going; RETURN}; DO Get[c]; IF NOT going THEN RETURN; c.cmd.out.PutRope[change]; ENDLOOP; }; AddOutput: ENTRY PROC [c: Connection, output: ROPE] ~ { this: LOR ~ LIST[output]; IF c.tail=NIL THEN c.head ¬ this ELSE c.tail.rest ¬ this; c.tail ¬ this; BROADCAST c.change; RETURN}; DispatchNotes: PROC [change: REF READONLY EditNotify.Change] ~ { WITH change^ SELECT FROM x: EditNotify.Change[ChangingText] => { c: Connection ~ NARROW[outs.Fetch[TextNode.Root[x.text]].val]; IF c#NIL THEN AddOutput[c, x.text.rope.Substr[x.start, x.newlen]]; }; ENDCASE => NULL; RETURN}; <<>> <> EnumTopViewersOnce: PROC [depth: INTEGER, from: Viewer, path: LOR, icons: BOOL, To: PROC [INTEGER, Viewer]] ~ { <> topViewers: LIST OF Viewer ¬ NIL; found: BOOL ¬ FALSE; CheckTo: PROC [depth: INTEGER, v: Viewer] ~ { IF depth <= 1 THEN {found ¬ TRUE; To[depth, v]}; }; EnumTop: ViewerOps.EnumProc ~ { topViewers ¬ CONS[v, topViewers]; RETURN [TRUE] }; depth ¬ 1; -- ignore input value, only there for compatibility with EnumViewers procedure IF path=NIL THEN {IF icons OR NOT Iconic[from] THEN CheckTo[Depth[from], from]} ELSE ViewerOps.EnumerateViewers[EnumTop]; FOR vlist: LIST OF Viewer ¬ topViewers, vlist.rest WHILE vlist#NIL DO FOR p: LOR ¬ path, p.rest WHILE p#NIL DO -- likely to be the shorter list IF p.first.Equal[matchSubtree] THEN depth ¬ depth+1 ELSE IF p.first.Equal[restart] THEN depth ¬ 1 ELSE IF p.first.Equal[inputFocus] THEN { f: InputFocus.Focus ~ InputFocus.GetInputFocus[]; IF f=NIL OR f.owner=NIL THEN Error["No current input focus"]; CheckTo[1, TopParent[f.owner]]; -- take the top-level viewer here } ELSE IF p.first.Equal[up] THEN { IF from=NIL THEN Error["Can't go up from root"]; depth ¬ depth-1; } ELSE IF MatchViewerName[p.first, vlist.first] THEN CheckTo[depth, vlist.first] ENDLOOP; ENDLOOP; IF NOT found THEN Error["Function requires a top-level viewer; no valid matches found"]; }; EnumViewers: PROC [depth: INTEGER, from: Viewer, path: LOR, icons: BOOL, To: PROC [INTEGER, Viewer]] ~ { EnumPass: ViewerOps.EnumProc ~ { IF Rope.Match[path.first, ShortName[v: v, useVersion: Rope.Find[path.first, "!"]#-1], FALSE] THEN EnumViewers[depth+1, v, path.rest, icons, To]; RETURN [TRUE]}; IF path=NIL THEN {IF icons OR NOT Iconic[from] THEN To[depth, from]} ELSE IF path.first.Equal[matchSubtree] THEN EnumSubtree[depth, from, path.rest, icons, To] ELSE IF path.first.Equal[restart] THEN EnumViewers[depth-Depth[from], NIL, path.rest, icons, To] ELSE IF path.first.Equal[inputFocus] THEN { f: InputFocus.Focus ~ InputFocus.GetInputFocus[]; IF f=NIL OR f.owner=NIL THEN Error["No current input focus"]; EnumViewers[depth + Depth[f.owner] - Depth[from], f.owner, path.rest, icons, To] } ELSE IF path.first.Equal[up] THEN { IF from=NIL THEN Error["Can't go up from root"]; EnumViewers[depth-1, from.parent, path.rest, icons, To]} ELSE IF from=NIL THEN ViewerOps.EnumerateViewers[EnumPass] ELSE EnumChildren[from, EnumPass]; RETURN}; EnumChildren: PROC [viewer: Viewer, enum: ViewerOps.EnumProc] = { v: Viewer ¬ viewer.child; WHILE v#NIL DO next: Viewer ¬ v.sibling; IF ~enum[v] THEN RETURN; v ¬ next; ENDLOOP; }; EnumSubtree: PROC [depth: INTEGER, from: Viewer, then: LOR, icons: BOOL, To: PROC [INTEGER, Viewer]] ~ { Work: PROC [depth: INTEGER, from: Viewer, partials: LOLOR, iconic: BOOL] ~ { accept: BOOL ¬ FALSE; SubtreePass: ViewerOps.EnumProc ~ { name: ROPE ~ ShortName[v]; newParts: LOLOR ¬ LIST[then]; FOR pl: LOLOR ¬ partials, pl.rest WHILE pl#NIL DO IF pl.first#NIL AND Rope.Match[pl.first.first, name, FALSE] THEN newParts ¬ CONS[pl.first.rest, newParts]; ENDLOOP; Work[depth+1, v, newParts, iconic OR v.iconic]; RETURN}; FOR pl: LOLOR ¬ partials, pl.rest WHILE pl#NIL DO IF pl.first=NIL THEN accept ¬ TRUE; ENDLOOP; IF accept AND from#NIL THEN {IF icons OR NOT iconic THEN To[depth, from]}; IF from=NIL THEN ViewerOps.EnumerateViewers[SubtreePass] ELSE ViewerOps.EnumerateChildren[from, SubtreePass]; RETURN}; Work[depth, from, LIST[then], Iconic[from]]; RETURN}; Find: PROC [from: Viewer, path: LOR] RETURNS [found: BOOL ¬ FALSE, ans: Viewer ¬ NIL] ~ { Note: PROC [depth: INTEGER, v: Viewer] ~ {found ¬ TRUE; ans ¬ v}; EnumViewers[0, from, path, TRUE, Note]; RETURN}; <> <<>> ViewersInColumn: PROC [viewer: Viewer] RETURNS [count: INTEGER¬0] ~ { ListColumn: ViewerOps.EnumProc = { IF ~v.iconic AND v.column=viewer.column THEN count ¬ count + 1; }; IF viewer=NIL THEN RETURN; ViewerOps.EnumerateViewers[ListColumn]; }; TopParent: PROC [v: Viewer] RETURNS [top: Viewer] ~ { FOR v ¬ v, v.parent WHILE v # NIL DO top ¬ v; ENDLOOP; }; Depth: PROC [v: Viewer] RETURNS [INTEGER] ~ { depth: INTEGER ¬ 0; FOR v ¬ v, v.parent WHILE v # NIL DO depth ¬ depth+1; ENDLOOP; RETURN [depth]}; Iconic: PROC [v: Viewer] RETURNS [BOOL] ~ { FOR v ¬ v, v.parent WHILE v # NIL DO IF v.iconic THEN RETURN [TRUE]; ENDLOOP; RETURN [FALSE]}; <> Parse: PROC [cmd: Commander.Handle] RETURNS [args: LOA] ~ { parsed: PositionedArgumentList ¬ PositionedList.ParseToPositionedList[cmd].list; Work: PROC RETURNS [args: LOA] ~ { tail: LOA ¬ args ¬ LIST[[0, 0, NIL]]; WHILE parsed#NIL DO IF parsed.first.rope.Equal[")"] THEN { parsed ¬ parsed.rest; EXIT} ELSE IF parsed.first.rope.Equal["("] THEN { start: INT ~ parsed.first.start; parsed ¬ parsed.rest; {sub: LOA ~ Work[]; next: INT ~ IF parsed#NIL THEN parsed.first.start ELSE cmd.commandLine.Length[]; tail ¬ tail.rest ¬ LIST[[start, next-start, sub]]; }} ELSE { tail ¬ tail.rest ¬ LIST[[parsed.first.start, parsed.first.length, parsed.first.rope]]; parsed ¬ parsed.rest}; ENDLOOP; RETURN [args.rest]}; parsed ¬ parsed.rest --skip token for command name--; args ¬ Work[]; IF parsed#NIL THEN Error["Mismatched parentheses"]; RETURN}; ParseButt: PROC [args: LOA] RETURNS [butt: Butt ¬ []] ~ { FOR al: LOA ¬ args, al.rest WHILE al#NIL DO WITH al.first.arg SELECT FROM x: ROPE => SELECT TRUE FROM x.Equal["Shift", FALSE] => butt.shift ¬ TRUE; x.Equal["Control", FALSE] => butt.control ¬ TRUE; x.Equal["Red", FALSE] => butt.button ¬ red; x.Equal["Yellow", FALSE] => butt.button ¬ yellow; x.Equal["Blue", FALSE] => butt.button ¬ blue; ENDCASE => Error[IO.PutFR1["Invalid button click token (%g)", [rope[x]] ]]; ENDCASE => Error[IO.PutFR1["Invalid button click arg (%g)", [refAny[al.first.arg]] ]]; ENDLOOP; }; ConvertToLOR: PROC [ra: REF ANY] RETURNS [lor: LOR] ~ { IF ra=NIL THEN RETURN [NIL]; WITH ra SELECT FROM x: ROPE => RETURN [LIST[x]]; x: LOR => RETURN [x]; x: LOA => { tail: LOR ¬ lor ¬ LIST[NIL]; FOR xl: LOA ¬ x, xl.rest WHILE xl#NIL DO WITH xl.first.arg SELECT FROM y: ROPE => tail ¬ tail.rest ¬ LIST[y]; ENDCASE => Error[IO.PutFR1["Step must be a ROPE, not %g", [refAny[xl.first.arg]] ]]; ENDLOOP; lor ¬ lor.rest}; x: LORA => { tail: LOR ¬ lor ¬ LIST[NIL]; FOR xl: LORA ¬ x, xl.rest WHILE xl#NIL DO WITH xl.first SELECT FROM y: ROPE => tail ¬ tail.rest ¬ LIST[y]; ENDCASE => Error[IO.PutFR1["Step must be a ROPE, not %g", [refAny[xl.first]] ]]; ENDLOOP; lor ¬ lor.rest}; ENDCASE => Error[IO.PutFR1["Path must be a ROPE or LIST, not %g", [refAny[ra]] ]]; RETURN}; PrintTimes: PROC [to: IO.STREAM, one: ROPE, n: NATURAL] ~ { FOR i: NATURAL IN [0 .. n) DO to.PutRope[one]; ENDLOOP; RETURN}; PrintPath: PROC [to: IO.STREAM, path: LOR, parens: BOOL] ~ { first: BOOL ¬ NOT parens; IF parens THEN to.PutRope["("]; FOR pl: LOR ¬ path, pl.rest WHILE pl#NIL DO IF first THEN first ¬ FALSE ELSE to.PutRope[" "]; to.PutRope[QuoteName[pl.first]]; ENDLOOP; IF parens THEN to.PutRope[" )"]; RETURN}; LOREqual: PROC [a, b: LOR] RETURNS [BOOL] ~ { WHILE a#b AND a#NIL AND b#NIL DO IF NOT a.first.Equal[b.first] THEN RETURN [FALSE]; a ¬ a.rest; b ¬ b.rest; ENDLOOP; RETURN [a=b]}; FmtFullName: PROC [v: Viewer, parens: BOOL ¬ TRUE] RETURNS [ROPE] ~ { RETURN FmtPath[FullName[v], parens]}; FmtPath: PROC [path: LOR, parens: BOOL ¬ TRUE] RETURNS [ROPE] ~ { out: IO.STREAM ~ IO.ROS[]; PrintPath[out, path, parens]; RETURN [out.RopeFromROS]}; FullName: PROC [v: Viewer] RETURNS [LOR] ~ { full: LOR ¬ NIL; FOR v ¬ v, v.parent WHILE v # NIL DO full ¬ CONS[ShortName[v], full]; ENDLOOP; RETURN [full]}; MatchViewerName: PROC [pattern: ROPE, v: Viewer] RETURNS [match: BOOL] ~ { match ¬ Rope.Match[pattern, ShortName[v: v, useVersion: Rope.Find[pattern, "!"]#-1], FALSE]; <> }; ShortName: PROC [v: Viewer, useVersion: BOOL¬FALSE] RETURNS [ROPE] ~ { IF useVersion AND v.file#NIL THEN RETURN [v.file]; IF v.name#NIL THEN RETURN [v.name]; RETURN [Convert.RopeFromInt[LOOPHOLE[v], 8]]}; QuoteName: PROC [name: ROPE] RETURNS [ROPE] ~ { IF name.SkipOver[0, okChars] < name.Length THEN RETURN [Convert.RopeFromRope[name]]; RETURN [name]}; okChars: ROPE ¬ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789{}[];:<>,./?!@#$%&*-+=^"; <> EditNotify.AddNotifyProc[proc: DispatchNotes, changeSet: [ChangingText: TRUE]]; Commander.Register[key: "PWV", proc: PWV, doc: "PWV prints current working viewer"]; Commander.Register[key: "CV", proc: CV, doc: "CV ( name* ) change current working viewer"]; Commander.Register[key: "VLs", proc: VLs, doc: "VLs [-[~]lmp] ( name* )* list viewers whose path names match given path; ** matches any number of steps; ~l excludes labels; m includes menu; p includes position"]; Commander.Register[key: "VType", proc: VType, doc: "VType ( name* )* types contents of viewers"]; Commander.Register[key: "VSet", proc: VSet, doc: "VSet ( name* ) newContents sets contents of a viewer"]; Commander.Register[key: "VNotify", proc: VNotify, doc: "VNotify ( name* ) input* sends input to a viewer"]; Commander.Register[key: "BPush", proc: BPush, doc: "BPush ( name* ) (Red|Yellow|Blue|Shift|Control)* pushes a button"]; Commander.Register[key: "MPush", proc: MPush, doc: "VNotify ( name* ) menuEntryName (Red|Yellow|Blue|Shift|Control)* pushes a menu button on a viewer"]; Commander.Register[key: "TPush", proc: TPush, doc: "TPush ( name* ) tiogaButtonName (Red|Yellow|Blue|Shift|Control)* pushes a tioga button in a viewer"]; Commander.Register[key: "VConnect", proc: VConnect, doc: "VConnect ( name* ) connects to typescript"]; Commander.Register[key: "MoveBoundary", proc: MoveBoundary, doc: "MoveBoundary [fraction|position] sets the column boundary"]; Commander.Register[key: "Paint", proc: Paint, doc: "Paint repaints the screen"]; Commander.Register[key: "VOpen", proc: VOpen, doc: "VOpen ( name* ) opens an iconic viewer"]; Commander.Register[key: "VClose", proc: VClose, doc: "VClose ( name* ) closes a viewer"]; Commander.Register[key: "VDestroy", proc: VDestroy, doc: "VDestroy ( name* ) destroys a viewer"]; Commander.Register[key: "VLeft", proc: VLeft, doc: "VLeft ( name* ) moves a viewer to the left column"]; Commander.Register[key: "VRight", proc: VRight, doc: "VRight ( name* ) moves a viewer to the right column"]; Commander.Register[key: "VColor", proc: VColor, doc: "VColor ( name* ) moves a viewer to the color display"]; Commander.Register[key: "VTop", proc: VTop, doc: "VTop ( name* ) moves a viewer to the top of its column"]; Commander.Register[key: "VBottom", proc: VBottom, doc: "VBottom ( name* ) moves a viewer to the bottom of its column"]; Commander.Register[key: "VGrow", proc: VGrow, doc: "VGrow ( name* ) toggles between full and partial column"]; Commander.Register[key: "VFull", proc: VFull, doc: "VFull ( name* ) makes a viewer full column"]; Commander.Register[key: "VShrink", proc: VShrink, doc: "VShrink ( name* ) makes a viewer partial column"]; END. <> <> <> <> <> <> <> <> <> <> <> <> <<>>