ViewerCommandsImpl.Mesa
Last tweaked by Mike Spreitzer on June 8, 1988 3:24:59 pm PDT
Polle Zellweger (PTZ) June 26, 1989 5:16:27 pm PDT
Swinehar, September 17, 1993 2:28 pm PDT
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
Types
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;
Globals
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 ý connection-- ~ RefTab.Create[];
Commands: working viewer, list viewers, set & type viewer contents, connect to 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}}};
Buttons, menus & notification commands
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}}};
Commands based on ViewerOps operations: open, close, top, bottom, paint, etc.
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
};
Not implemented
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
};
The following two commands, VFull & VShrink, have no direct ViewerOps counterpart
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
};
ViewerCommands support routines
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};
Enumeration routines
EnumTopViewersOnce:
PROC [depth:
INTEGER, from: Viewer, path:
LOR, icons:
BOOL,
To:
PROC [
INTEGER, Viewer]] ~ {
This procedure makes a list of top-level viewers and then calls the To procedure once for each element of the path that matches an element of the list. This method, rather than enumerating directly, is necessary for functions like Top and Bottom, which alter the Viewers data structure and can thereby create infinite loops. It goes to some effort to use the same path semantics as other commands, even though only top-level viewers will be considered.
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};
Viewers utilities
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]};
Other utilities: I/O, lists, etc.
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];
if no version specified in pattern, go ahead and match w/o version
};
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{}[];:<>,./?!@#$%&*-+=^";
Initialization
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.
Polle Zellweger (PTZ) June 16, 1988 6:07:17 pm PDT
added: VOpen, VClose, VDestroy, VLeft, VRight, VColor, VTop, VBottom, VGrow, VFull, VShrink, ViewersInColumn, EnumTopViewersOnce, TopParent
changes to: Try (local of FindTiogaButton) -- add knowledge of full-node Tioga buttons, add * matching in Tioga button names
Polle Zellweger (PTZ) June 17, 1988 11:57:29 am PDT (for Mike Spreitzer)
Fix bug in EnumViewers - wanted to enumerate only first-level children.
added: EnumChildren, changes to: EnumViewers
Polle Zellweger (PTZ) April 30, 1989 2:47:35 pm PDT
Change to match from viewer.file if user specifies a version number in the filename pattern.
added: MatchViewerName, changes to: EnumTopViewersOnce, ShortName
Polle Zellweger (PTZ) June 26, 1989 5:15:41 pm PDT
Remove infinite loop.
changes to: EnumTopViewersOnce