LarkWorkImpl.mesa
L. Stewart, December 22, 1983 1:55 pm
DIRECTORY
Buttons USING [SetDisplayStyle],
Commander USING [CommandObject, Handle],
CommandTool USING [ArgHandleObject, ArgumentVector, Failed, Parse],
IO USING [Error, PutF, PutFR, PutChar, PutRope, rope, STREAM],
LarkControl USING [LarkData, PaintMode],
LarkWork,
List USING [CompareProc, Sort],
Process USING [Detach],
ReadEvalPrint USING [ClientProc, CreateViewerEvaluator, Handle, MainLoop, Stop],
Rope USING [Compare, Concat, Equal, Fetch, Length, ROPE, Run];
LarkWorkImpl: CEDAR MONITOR
IMPORTS Buttons, CommandTool, IO, LarkControl, List, Process, ReadEvalPrint, Rope
EXPORTS LarkWork =
BEGIN
registry: LIST OF REF ANY ← NIL;
ProcObject:
TYPE =
RECORD [
proc: LarkWork.LarkWorkProc ← NIL,
caseMatters: BOOL ← FALSE,
key: Rope.ROPE ← NIL,
doc: Rope.ROPE ← NIL,
usage: Rope.ROPE ← NIL
];
RegisterLarkWorkProc:
PUBLIC
PROC [proc: LarkWork.LarkWorkProc, key: Rope.
ROPE, caseMatters:
BOOL ←
FALSE, doc: Rope.
ROPE ←
NIL, usage: Rope.
ROPE ←
NIL] = {
FOR rl:
LIST
OF
REF
ANY ← registry, rl.rest
WHILE rl #
NIL
DO
pr: REF ProcObject ← NARROW[rl.first];
IF Rope.Equal[key,pr.key,
TRUE]
AND pr.caseMatters = caseMatters
THEN {
pr.proc ← proc;
pr.doc ← doc;
pr.usage ← usage;
RETURN;
};
ENDLOOP;
registry ← CONS[NEW[ProcObject ← [proc, caseMatters, key, doc, usage]], registry];
};
MaybeCreateWorkArea:
PUBLIC
PROC [lark: LarkControl.LarkData]
RETURNS [result: Rope.
ROPE] = {
IF lark.eval # NIL THEN RETURN["There is already an open work area\n"];
lark.eval ← ReadEvalPrint.CreateViewerEvaluator[clientProc: InteractiveProc, prompt: "%% ", info: [name: Rope.Concat["Debug ", lark.nameRope], column: right, iconic: FALSE], clientData: lark];
lark.h.log ← lark.eval.out;
IF lark.debug # NIL THEN Buttons.SetDisplayStyle[button: lark.debug, style: $WhiteOnBlack];
TRUSTED { Process.Detach[FORK RunWorkArea[lark]]; };
RETURN[IO.PutFR["Debug %g\n", IO.rope[lark.nameRope]]];
};
MaybeShutDownWorkArea:
PUBLIC
PROC [lark: LarkControl.LarkData]
RETURNS [result: Rope.
ROPE] = {
IF lark.eval = NIL THEN RETURN["No work area exists\n"]
ELSE ReadEvalPrint.Stop[lark.eval];
};
RunWorkArea:
PROC [lark: LarkControl.LarkData] = {
eval: ReadEvalPrint.Handle;
ReadEvalPrint.MainLoop[lark.eval, FALSE, NIL];
eval ← lark.eval;
lark.h.log ← lark.world.out;
lark.eval ← NIL;
IF eval.viewer # NIL AND NOT eval.viewer.destroyed AND eval.out # NIL THEN eval.out.PutRope["Destroy this viewer\n" ! IO.Error => CONTINUE];
IF lark.debug # NIL THEN Buttons.SetDisplayStyle[button: lark.debug, style: $BlackOnWhite];
lark.larkMode ← 'U;
LarkControl.PaintMode[lark];
};
ReParse:
PROC [r: Rope.
ROPE]
RETURNS [argv: CommandTool.ArgumentVector] = {
orig: CommandTool.ArgumentVector;
cmd: Commander.Handle ← NEW[Commander.CommandObject ← []];
cmd.commandLine ← r;
orig ← CommandTool.Parse[cmd ! CommandTool.Failed => CONTINUE];
IF orig = NIL THEN RETURN[NIL];
argv ← NEW[CommandTool.ArgHandleObject[orig.argc - 1]];
FOR i:
NAT
IN [0..argv.argc)
DO
argv[i] ← orig[i+1];
ENDLOOP;
};
InteractiveProc: ReadEvalPrint.ClientProc = {
lark: LarkControl.LarkData ← NARROW[h.clientData];
argv: CommandTool.ArgumentVector ← ReParse[command];
cmd: REF ProcObject ← NIL;
matchLength: INT;
cmdLength: INT;
foundMoreThanOne: BOOL ← FALSE;
IF argv = NIL OR argv.argc = 0 THEN RETURN;
cmdLength ← argv[0].Length[];
IF cmdLength = 0 THEN RETURN;
FOR rl:
LIST
OF
REF
ANY ← registry, rl.rest
WHILE rl #
NIL
DO
pr: REF ProcObject ← NARROW[rl.first];
keyLength: INT ← pr.key.Length[];
IF cmdLength > keyLength THEN LOOP;
matchLength ← Rope.Run[s1: argv[0], s2: pr.key, case: pr.caseMatters];
IF matchLength = keyLength
AND cmdLength = matchLength
THEN {
cmd ← pr;
EXIT;
};
IF matchLength = cmdLength
THEN {
IF cmd = NIL THEN cmd ← pr
ELSE foundMoreThanOne ← TRUE;
};
REPEAT
FINISHED => IF foundMoreThanOne THEN RETURN["Ambiguous command\n"];
ENDLOOP;
IF cmd # NIL THEN RETURN[cmd.proc[lark: lark, argv: argv, capital: argv[0].Fetch[0] NOT IN ['a..'z]]];
RETURN["Not found\n"];
};
Built in commands
Quit: LarkWork.LarkWorkProc = {
ReadEvalPrint.Stop[lark.eval];
};
CommandList: LarkWork.LarkWorkProc = {
out: IO.STREAM ← lark.h.log;
SortRegistry[];
FOR rl:
LIST
OF
REF
ANY ← registry, rl.rest
WHILE rl #
NIL
DO
pr: REF ProcObject ← NARROW[rl.first];
IF pr.proc #
NIL
THEN {
out.PutRope[pr.key];
out.PutChar[' ];
};
ENDLOOP;
out.PutChar['\n];
};
Help: LarkWork.LarkWorkProc = {
out: IO.STREAM ← lark.h.log;
matchRope: Rope.ROPE ← NIL;
SortRegistry[];
IF argv.argc > 1 THEN matchRope ← argv[1];
FOR rl:
LIST
OF
REF
ANY ← registry, rl.rest
WHILE rl #
NIL
DO
pr: REF ProcObject ← NARROW[rl.first];
IF pr.proc #
NIL
THEN {
IF Rope.Run[s1: pr.key, s2: matchRope, case: FALSE] = matchRope.Length[] THEN out.PutF["%-10g: %g\n", IO.rope[pr.key], IO.rope[pr.doc]];
};
ENDLOOP;
};
Usage: LarkWork.LarkWorkProc = {
out: IO.STREAM ← lark.h.log;
matchRope: Rope.ROPE ← NIL;
SortRegistry[];
IF argv.argc > 1 THEN matchRope ← argv[1];
FOR rl:
LIST
OF
REF
ANY ← registry, rl.rest
WHILE rl #
NIL
DO
pr: REF ProcObject ← NARROW[rl.first];
IF pr.proc #
NIL
THEN {
IF Rope.Run[s1: pr.key, s2: matchRope, case: FALSE] = matchRope.Length[] THEN out.PutF["%-10g: %g\n", IO.rope[pr.key], IO.rope[pr.usage]];
};
ENDLOOP;
};
SortRegistry:
PROC = {
MyCompare: List.CompareProc = {
a: REF ProcObject ← NARROW[ref1];
b: REF ProcObject ← NARROW[ref2];
RETURN[Rope.Compare[a.key, b.key]];
};
registry ← List.Sort[list: registry, compareProc: MyCompare];
};
RegisterLarkWorkProc[proc: Quit, key: "Quit", caseMatters: FALSE, doc: "Close work area"];
RegisterLarkWorkProc[proc: CommandList, key: "?", caseMatters: FALSE, doc: "List available commands"];
RegisterLarkWorkProc[proc: Help, key: "Help", caseMatters: FALSE, doc: "Command documentation", usage: "Help {partialCommandName}"];
RegisterLarkWorkProc[proc: Usage, key: "Usage", caseMatters: FALSE, doc: "Command Usage", usage: "Usage {partialCommandName}"];
END.
April 25, 1983 7:36 pm, LCS, created
July 6, 1983 3:58 pm, LCS, complete match should now succeed
December 22, 1983 1:55 pm, LCS, Cedar 5