G2dToolImpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, October 29, 1992 6:03 pm PST
DIRECTORY ColumnLs, Commander, CommanderOps, G2dTool, IO, PreDebug, Real, Rope;
G2dToolImpl: CEDAR PROGRAM
IMPORTS ColumnLs, Commander, CommanderOps, IO, PreDebug, Real, Rope
EXPORTS G2dTool
~ BEGIN
Types
ROPE:   TYPE ~ Rope.ROPE;
Op:   TYPE ~ RECORD [proc: Commander.CommandProc, name, usage: ROPE];
OpSequence:  TYPE ~ RECORD [length: NAT ¬ 0, s: SEQUENCE maxLength: NAT OF Op];
2d Registration and Dispatch
ops: REF OpSequence ¬ NIL;
delimiter: ROPE ¬ ",";
Register: PUBLIC PROC [name: ROPE, proc: Commander.CommandProc, usage: ROPE] ~ {
op: Op ¬ [proc, name, usage];
IF proc # NIL THEN op.usage ¬ Rope.Concat[" ", usage];
IF ops # NIL THEN
FOR n: NAT IN [0..ops.length) DO
IF NOT Eq[name, ops[n].name] THEN LOOP;
ops[n] ¬ op;
RETURN;
ENDLOOP;
IF ops = NIL THEN ops ¬ NEW[OpSequence[10]];
IF ops.length = ops.maxLength THEN {
old: REF OpSequence ~ ops;
ops ¬ NEW[OpSequence[Real.Round[1.3*old.length]]];
FOR i: NAT IN [0..old.length) DO ops[i] ¬ old[i]; ENDLOOP;
ops.length ¬ old.length;
};
ops[ops.length] ¬ op;
ops.length ¬ ops.length+1;
};
PrintOps: PROC [cmd: Commander.Handle] ~ {
ColumnWidth: PROC RETURNS [NAT] ~ {
names: LIST OF ROPE ¬ NIL;
FOR n: NAT IN [0..ops.length) DO
IF ops[n].proc # NIL THEN names ¬ CONS[ops[n].name, names];
ENDLOOP;
RETURN[ColumnLs.ColumnWidth[cmd, names]];
};
names: LIST OF ROPE ¬ NIL;
colWidth: NAT ¬ ColumnWidth[];
IF ops = NIL THEN {IO.PutRope[cmd.out, "no registered commands\n"]; RETURN};
IO.PutF[cmd.out, "\t\t\t\t\t\t%lCommands%l\n", IO.rope["bz"], IO.rope["BZ"]];
FOR n: NAT IN [0..ops.length) DO
IF ops[n].proc = NIL
THEN {
ColumnLs.ColumnateGivenColumnWidth[cmd, names, colWidth, TRUE, fixed,,, "\t"];
IO.PutF[cmd.out, "%l%g%l\n", IO.rope["b"], IO.rope[ops[n].name], IO.rope["B"]];
names ¬ NIL;
}
ELSE names ¬ CONS[ops[n].name, names];
ENDLOOP;
ColumnLs.ColumnateGivenColumnWidth[cmd, names, colWidth, TRUE, fixed,,, "\t"];
};
Eq: PROC [r1, r2: ROPE] RETURNS [BOOL] ~ {RETURN[Rope.Equal[r1, r2, FALSE]]};
GetOp: PROC [name: ROPE] RETURNS [op: Op ¬ [NIL, NIL, NIL]] ~ {
IF ops # NIL THEN FOR i: NAT IN [0..ops.length) DO
IF Eq[name, ops[i].name] THEN {op ¬ ops[i]; EXIT};
ENDLOOP;
};
Error: ERROR = CODE;
Dispatch: Commander.CommandProc ~ {
Check: PROC RETURNS [ok: BOOL ¬ TRUE] ~ {
Test: PROC [name: ROPE] ~ {
IF GetOp[name].proc = NIL THEN {
ok ¬ FALSE;
IO.PutF1[cmd.out, "no such option: %g\n", IO.rope[name]];
};
};
Test[args[1]];
FOR i: NAT IN [2..args.argc-1) DO IF Eq[args[i], delimiter] THEN Test[args[i+1]]; ENDLOOP;
};
Reject: PROC [reason: ROPE] RETURNS [reject: BOOL ¬ FALSE] ~ {
IO.PutRope[cmd.out, Rope.Concat[reason, "\n"]];
result ¬ $Failure;
};
DoOps: PROC ~ {
ENABLE {
UNCAUGHT => {
IO.PutRope[cmd.out, "unknown error"];
GOTO Bad;
};
Error => GOTO Bad;
};
DoOp: PROC [arg: INTEGER] ~ {
op: Op ¬ GetOp[cmd.command ¬ args[arg]];
cmd.commandLine ¬ NIL;
FOR i: NAT IN [arg+1..args.argc) DO
IF Eq[args[i], delimiter]
THEN EXIT
ELSE cmd.commandLine ¬ Rope.Cat[cmd.commandLine, " ", args[i]];
ENDLOOP;
IF (msg ¬ op.proc[cmd].msg) # NIL THEN {
IO.PutF1[cmd.out, "%g\n", IO.rope[msg]];
Error;
};
};
DoOp[1];
FOR a: NAT IN [2..args.argc-1) DO IF Eq[args[a], delimiter] THEN DoOp[a+1]; ENDLOOP;
EXITS Bad => NULL;
};
args: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd, leaveQuotes];
SELECT TRUE FROM
args.argc < 2 OR Rope.IsEmpty[args[1]] => RETURN[$Failure, "no function specified"];
Eq[args[1], "?"] => {PrintOps[cmd]; RETURN};
NOT Check[] => RETURN[$Failure];
args.argc > 2 AND Eq[args[2], "?"] => RETURN[, Rope.Concat["Usage:", GetOp[args[1]].usage]];
ENDCASE;
[] ¬ PreDebug.Protect[DoOps, Reject];
};
Start Code
usage: ROPE ~ "
2d <function> [arguments] -- multiple functions may be comma separated
'2d ?' lists functions; '2d <function> ?' prints the function usage message";
Commander.Register["2d", Dispatch, usage];
END.