PropertyCommandsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
L. Stewart, January 17, 1984 4:29 pm
Russ Atkinson (RRA) March 5, 1985 5:39:23 pm PST
DIRECTORY
AMBridge USING [TVForReferent],
Atom USING [MakeAtom],
Commander USING [CommandProc, Register],
CommandTool USING [ArgumentVector, Failed, Parse],
Convert USING [Error, IntFromRope],
IO USING [PutChar, PutRope, STREAM],
List USING [AList, Assoc, DottedPair, PutAssoc],
PrintTV USING [Print],
Process USING [CheckForAbort],
ProcessProps USING [GetPropList],
Rope USING [Equal, Fetch, Length, ROPE, Substr];
PropertyCommandsImpl: CEDAR PROGRAM
IMPORTS AMBridge, Atom, Commander, CommandTool, Convert, IO, List, PrintTV, Process, ProcessProps, Rope = BEGIN
Properties: Commander.CommandProc = TRUSTED {
depth: INT ← 5;
width: INT ← 32;
props: List.AList;
i: NAT ← 1;
token: Rope.ROPE;
any: BOOLFALSE;
verboseFlag: BOOLFALSE;
key: REF ANY;
argv: CommandTool.ArgumentVector ← CommandTool.Parse[cmd
! CommandTool.Failed => { msg ← errorMsg; GO TO oops}];
{
IF cmd.procData.clientData = $ProcessProperties
THEN {
props ← ProcessProps.GetPropList[];
cmd.out.PutRope["process properties:\n"];
}
ELSE {
props ← cmd.propertyList;
cmd.out.PutRope["commander properties:\n"];
};
DO
Process.CheckForAbort[];
IF i >= argv.argc THEN EXIT;
token ← argv[i];
i ← i + 1;
IF token.Equal["-d", FALSE] THEN {
IF i = argv.argc THEN GOTO BadArgs;
depth ← Convert.IntFromRope[argv[i] ! Convert.Error => GOTO BadArgs];
IF width < 0 THEN GOTO BadArgs;
i ← i + 1;
LOOP;
};
IF token.Equal["-w", FALSE] THEN {
IF i = argv.argc THEN GOTO BadArgs;
width ← Convert.IntFromRope[argv[i] ! Convert.Error => GOTO BadArgs];
IF width < 0 THEN GOTO BadArgs;
i ← i + 1;
LOOP;
};
IF token.Equal["-v", FALSE] THEN {
verboseFlag ← TRUE;
LOOP;
};
any ← TRUE;
IF token.Length[] > 1 AND token.Fetch[0] = '$
THEN key ← Atom.MakeAtom[Rope.Substr[base: token, start: 1]]
ELSE key ← Atom.MakeAtom[token];
cmd.out.PutRope[token];
cmd.out.PutRope[" = "];
PrintTV.Print[tv: AMBridge.TVForReferent[NEW[REF ANY ← List.Assoc[key: key, aList: props]]], put: cmd.out, depth: depth, width: width, verbose: verboseFlag];
cmd.out.PutChar['\n];
ENDLOOP;
IF NOT any THEN {
PrintTV.Print[tv: AMBridge.TVForReferent[NEW[REF ANY ← props]], put: cmd.out, depth: depth, width: width, verbose: verboseFlag];
cmd.out.PutChar['\n];
};
EXITS
BadArgs => RETURN[$Failure, "Bad args"];
};
EXITS oops => result ← $Failure;
};
SetProperty: Commander.CommandProc = {
aList: List.AList;
key: REF ANY;
argv: CommandTool.ArgumentVector ← CommandTool.Parse[cmd, TRUE
! CommandTool.Failed => { msg ← errorMsg; GO TO oops}];
IF cmd.procData.clientData = $ProcessProperties
THEN aList ← ProcessProps.GetPropList[]
ELSE aList ← cmd.propertyList;
IF argv.argc # 3
THEN cmd.out.PutRope["Usage: SetProperty key value\n"]
ELSE {
dp: List.DottedPair;
val: REF ANY;
IF argv[1].Length[] > 1 AND argv[1].Fetch[0] = '$
THEN key ← Atom.MakeAtom[Rope.Substr[base: argv[1], start: 1]]
ELSE key ← Atom.MakeAtom[argv[1]];
val ← IF Rope.Equal[argv[2], "NIL"] THEN NIL ELSE argv[2];
dp ← FindLastProp[key: key, aList: aList];
IF dp # NIL
THEN dp.val ← val
ELSE [] ← List.PutAssoc[key: key, val: val, aList: aList];
};
EXITS oops => result ← $Failure;
};
FindLastProp: PROC [key: REF, aList: List.AList] RETURNS [dp: List.DottedPair ← NIL] = {
UNTIL aList = NIL DO
IF aList.first.key = key THEN dp ← NARROW[aList.first];
aList ← aList.rest;
ENDLOOP;
RETURN[dp];
};
Init: PROC = {
Commander.Register[key: "///Commands/GetProperties", proc: Properties, doc: "Display command tool property list"];
Commander.Register[key: "///Commands/GetProcessProperties", proc: Properties, doc: "Display process properties list", clientData: $ProcessProperties];
Commander.Register[key: "///Commands/SetProperty", proc: SetProperty, doc: "SetProperty propertyName value - change or add to the command tool property list"];
Commander.Register[key: "///Commands/SetProcessProperty", proc: SetProperty, doc: "SetProperty propertyName value - change or add to the process property list", clientData: $ProcessProperties];
};
Init[];
END.
January 17, 1984 4:29 pm, Stewart, change SetProperty to add FindLastProp