CommandToolParseImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Gifford on June 18, 1982 10:55 am
Paul Rovner on July 20, 1983 2:39 pm
Stewart on January 17, 1984 4:30 pm
Swinehart, June 25, 1984 2:48:53 pm PDT
Russ Atkinson, February 6, 1985 4:27:32 pm PST
DIRECTORY
Atom USING [MakeAtom],
Commander USING [Handle, GetProperty],
CommandTool,
CommandToolExtras,
Convert USING [Error, IntFromRope],
FileNames USING [Directory, ResolveRelativePath],
FS USING [AccessOptions, EnumerateForNames, Error, NameProc, StreamOpen],
IO USING [STREAM],
List USING [Assoc, PutAssoc],
ProcessProps USING [GetPropList],
PrincOpsUtils USING [LongCOPY],
Rope USING [Cat, Concat, Equal, Fetch, Find, Flatten, FromRefText, IsEmpty, Length, Replace, ROPE, Size, SkipTo, Substr];
CommandToolParseImpl: CEDAR PROGRAM
IMPORTS Atom, Commander, CommandTool, Convert, FileNames, FS, List, PrincOpsUtils, ProcessProps, Rope
EXPORTS CommandTool, CommandToolExtras = {
OPEN CommandTool;
Handle: TYPE = Commander.Handle;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Failed: PUBLIC ERROR [errorMsg: ROPE] = CODE;
ParseRecord: TYPE = RECORD [
argumentVector: CommandTool.ArgumentVector ← NIL,
The arguments to the command. argumentVector.argc is the number of arguments, argumentVector[0] is the command
argumentPointer: INT ← -1
position of last fetched argument (initially none fetched)
];
GetParseRecord: PROC [cmd: Handle] RETURNS [pr: REF ParseRecord] = {
pr ← NARROW[List.Assoc[key: $ArgumentVector, aList: cmd.propertyList]];
IF pr = NIL OR (pr.argumentVector.argc > 0 AND pr.argumentVector[0] # cmd.command) THEN {
pr ← NEW[ParseRecord];
pr.argumentVector ← Parse[cmd ! Failed => CONTINUE];
IF pr.argumentVector = NIL THEN pr.argumentVector ← NEW[CommandTool.ArgHandleObject[0]];
pr.argumentPointer ← 0;
cmd.propertyList ← List.PutAssoc[key: $ArgumentVector, val: pr, aList: cmd.propertyList];
};
};
NumArgs: PUBLIC PROC [cmd: Handle] RETURNS [INT] = {
pp: REF ParseRecord ← GetParseRecord[cmd];
RETURN[pp.argumentVector.argc];
};
NextArgument: PUBLIC PROC [cmd: Handle] RETURNS [ROPE] = {
pp: REF ParseRecord ← GetParseRecord[cmd];
n: NAT ← pp.argumentPointer + 1;
IF pp = NIL OR n >= pp.argumentVector.argc THEN RETURN[NIL];
pp.argumentPointer ← n;
RETURN[pp.argumentVector[n]];
};
ArgN: PUBLIC PROC [cmd: Handle, n: INT] RETURNS [ROPE] = {
pp: REF ParseRecord ← GetParseRecord[cmd];
IF pp = NIL OR n < 0 OR n >= pp.argumentVector.argc THEN RETURN[NIL];
pp.argumentPointer ← n;
RETURN[pp.argumentVector[n]];
};
RegistrationDirectory: PUBLIC PROC [cmd: Handle] RETURNS [dir: ROPE] = {
dir ← FileNames.Directory[cmd.command];
IF dir.IsEmpty[] THEN RETURN["///"];
};
Parse: PUBLIC PROC [cmd: Handle, switchChar: CHAR ← '-] RETURNS [argv: ArgumentVector] = {
argv ← InnerParse[commands: cmd.commandLine, switchchar: switchChar];
IF argv # NIL THEN argv[0] ← cmd.command;
};
AmpersandSubstitution: PUBLIC PROC [cmd: Handle] = {
AmpersandProc: PROC [thingName: ROPE] RETURNS [ROPE] = {
arg: ATOM ← Atom.MakeAtom[thingName];
value: REF ANY;
value ← Commander.GetProperty[key: arg, aList: ProcessProps.GetPropList[]];
IF value = NIL OR NOT ISTYPE[value, ROPE] THEN value ← Commander.GetProperty[key: arg, aList: cmd.propertyList];
IF NOT ISTYPE[value, ROPE] THEN RETURN[Rope.Concat["&", thingName]];
RETURN[NARROW[value, ROPE]];
};
Letters: PROC [c: CHAR] RETURNS [keep: BOOL] = {
RETURN [c IN ['a..'z] OR c IN ['A..'Z] OR c IN ['0..'9]];
};
cmd.commandLine ← LookForThings[line: cmd.commandLine, thingChar: '&, charPredicate: Letters, proc: AmpersandProc];
};
DollarSubstitution: PUBLIC PROC [cmd: Handle] = {
commandersArguments: ArgumentVector ← NARROW[Commander.GetProperty[key: $CommandFileArguments, aList: cmd.propertyList], ArgumentVector];
highest: INT ← -1;
DollarProc: PROC [thingName: ROPE] RETURNS [ROPE] = {
value: ROPE ← NIL;
failed: BOOLFALSE;
argument: INT;
IF thingName.Equal["Rest"]
THEN {
IF commandersArguments = NIL THEN RETURN [NIL];
FOR i: INT IN (highest..commandersArguments.argc) DO
value ← Rope.Cat[value, commandersArguments[i], " "];
ENDLOOP;
RETURN[value];
}
ELSE {
argument ← Convert.IntFromRope[thingName ! Convert.Error => {
value ← Rope.Concat["$", thingName];
failed ← TRUE;
CONTINUE;
}];
IF failed THEN RETURN[value];
IF commandersArguments = NIL OR commandersArguments.argc <= argument + 1 THEN RETURN [NIL];
IF argument > highest THEN highest ← argument;
RETURN[commandersArguments[argument + 1]];
};
};
Letters: PROC [c: CHAR] RETURNS [keep: BOOL] = {
RETURN [c IN ['a..'z] OR c IN ['A..'Z] OR c IN ['0..'9]];
};
cmd.commandLine ← LookForThings[line: cmd.commandLine, thingChar: '$, charPredicate: Letters, proc: DollarProc];
};
StarExpansion: PUBLIC PROC [cmd: Handle] = {
token: ROPE;
listOfTokens: LIST OF ROPENIL;
uecpArgv: ArgumentVector;
IF cmd.commandLine.Find["*"] = -1 THEN RETURN;
uecpArgv ← InnerParse[commands: cmd.commandLine];
FOR i: NAT IN [1..uecpArgv.argc) DO
err: ROPENIL;
token ← uecpArgv[i];
IF Rope.Find[token, "*"] # -1 THEN {
ENABLE FS.Error => IF error.group # bug THEN {err ← error.explanation; GO TO oops};
ConsProc: FS.NameProc = {
listOfTokens ← CONS[fullFName, listOfTokens]; -- on front of list
RETURN[TRUE];
};
FS.EnumerateForNames[pattern: FileNames.ResolveRelativePath[token], proc: ConsProc];
EXITS oops => ERROR CommandTool.Failed[err];
}
ELSE listOfTokens ← CONS[token, listOfTokens]; -- on front of list
ENDLOOP;
Now the tokens must be glued back together again, but the listOfTokens is in reverse order
cmd.commandLine ← "\n";
WHILE listOfTokens # NIL DO
cmd.commandLine ← Rope.Cat[" ", listOfTokens.first, cmd.commandLine];
listOfTokens ← listOfTokens.rest;
ENDLOOP;
cmd.commandLine ← Rope.Flatten[cmd.commandLine];
};
IORedirection: PUBLIC PROC [cmd: Handle] RETURNS [inRedirected: BOOLFALSE, outRedirected: BOOLFALSE] = {
token: ROPE;
listOfTokens: LIST OF ROPENIL;
uecpArgv: ArgumentVector;
i: NAT;
{
IF cmd.commandLine.SkipTo[pos: 0, skip: "<>"] = cmd.commandLine.Length[] THEN RETURN;
uecpArgv ← InnerParse[commands: cmd.commandLine];
IF uecpArgv = NIL THEN ERROR Failed["Command line parse failure"];
cmd.commandLine ← NIL;
i ← 1;
DO
IF i = uecpArgv.argc THEN EXIT;
token ← uecpArgv[i];
i ← i + 1;
SELECT TRUE FROM
Rope.Equal[token, "<"] => {
IF i = uecpArgv.argc THEN GO TO FailSyntax;
IF inRedirected THEN GO TO FailDouble;
cmd.in ← OpenRedirect[uecpArgv[i], $read];
i ← i + 1;
inRedirected ← TRUE;
LOOP;
};
Rope.Equal[token, ">"] => {
IF i = uecpArgv.argc THEN GO TO FailSyntax;
IF outRedirected THEN GO TO FailDouble;
cmd.out ← OpenRedirect[uecpArgv[i], $create];
i ← i + 1;
outRedirected ← TRUE;
LOOP;
};
Rope.Equal[token, ">>"] => {
IF i = uecpArgv.argc THEN GO TO FailSyntax;
IF outRedirected THEN GO TO FailDouble;
cmd.out ← OpenRedirect[uecpArgv[i], $append];
i ← i + 1;
outRedirected ← TRUE;
LOOP;
};
ENDCASE => cmd.commandLine ← Rope.Cat[cmd.commandLine, " ", token];
ENDLOOP;
cmd.commandLine ← Rope.Flatten[Rope.Concat[cmd.commandLine, "\n"]];
EXITS
FailDouble => ERROR Failed["I/O redirected twice"];
FailSyntax => ERROR Failed["redirection without filename"];
};
};
ParseToList: PUBLIC PROC [cmd: Handle, switchChar: CHAR ← '-] RETURNS [list: LIST OF ROPE, length: NAT ← 0] = {
uecpArgv: ArgumentVector ← InnerParse[commands: cmd.commandLine, switchchar: switchChar];
IF uecpArgv = NIL THEN RETURN[NIL];
length ← 0;
FOR i: NAT DECREASING IN [1..uecpArgv.argc) DO
list ← CONS[uecpArgv[i], list]; -- on front of list
length ← length + 1;
ENDLOOP;
};
LookForThings: PROC [line: ROPE, thingChar: CHAR, charPredicate: PROC [c: CHAR] RETURNS [keep: BOOL], proc: PROC [thingName: ROPE] RETURNS [ROPE]] RETURNS [ROPE] = {
state: {outside, insideQuotes, insideThing} ← outside;
c: CHAR;
i: INT ← 0;
thingPosition: INT;
WHILE i < line.Length[] DO
c ← line.Fetch[i];
SELECT state FROM
outside => {
SELECT c FROM
'" => {
state ← insideQuotes;
};
thingChar => {
state ← insideThing;
thingPosition ← i;
};
ENDCASE;
};
insideQuotes => {
IF c = '" THEN {
IF line.Length[] > (i + 1) AND line.Fetch[i+1] = '" THEN i ← i + 1
ELSE state ← outside;
};
};
insideThing => {
IF NOT charPredicate[c] THEN {
thingName: ROPE ← Rope.Substr[base: line, start: thingPosition + 1, len: i - thingPosition - 1];
thingValue: ROPE ← proc[thingName: thingName];
line ← line.Replace[start: thingPosition, len: IF c = thingChar THEN thingName.Length[] + 2 ELSE thingName.Length[] + 1, with: thingValue];
i ← thingPosition + thingValue.Length[];
state ← outside;
};
};
ENDCASE => ERROR;
i ← i + 1;
ENDLOOP;
IF state = insideQuotes THEN ERROR Failed["Mismatched quotes"];
RETURN[line];
};
OpenRedirect: PROC [fileName: ROPE, accessOptions: FS.AccessOptions] RETURNS [stream: STREAMNIL] = {
errorMsg: ROPE;
fileName ← FileNames.ResolveRelativePath[fileName];
stream ← FS.StreamOpen[fileName: fileName, accessOptions: accessOptions, keep: 2
! FS.Error => IF error.group = user THEN { errorMsg ← error.explanation; CONTINUE }];
IF stream = NIL THEN
ERROR Failed[Rope.Concat["Can't redirect I/O: ", errorMsg]];
};
UnmatchedQuote: ERROR = CODE;
CPData: TYPE = RECORD [
ch: CHAR ← ' , -- first char of next token; initially blank
swChar: CHAR, -- switch character
ropeIndex: LONG INTEGER ← 0, -- index into Rope command line
rope: ROPENIL, -- command line passed from client
done: BOOLFALSE, -- used up all of command line
argC: INT ← 0, -- number of tokens found
args: LIST OF ROPENIL -- list of tokens
];
InnerParse: PROC [commands: ROPE, switchchar: CHAR ← '-] RETURNS [argv: ArgumentVector] = {
cpd: REF CPData ← NEW[CPData];
Fooey: PROC RETURNS [LIST OF ROPE, INT] = {
r: ROPE ← IGet[cpd];
IF r = NIL THEN RETURN [NIL, 1]
ELSE {
n: LIST OF ROPE;
c: INT;
[n, c] ← Fooey[];
RETURN [CONS[r, n], c+1];
};
};
cpd.swChar ← switchchar;
cpd.rope ← commands;
argv ← NIL;
[cpd.args, cpd.argC] ← Fooey[! UnmatchedQuote => GOTO Lose];
argv ← NEW[ArgHandleObject[cpd.argC]];
argv[0] ← "";
FOR i: NAT IN [1..argv.argc) DO
argv[i] ← cpd.args.first;
cpd.args ← cpd.args.rest;
ENDLOOP;
EXITS
Lose => Failed["Misatched quotes"];
};--Parse
IGet: PROC [cpd: REF CPData] RETURNS [result: ROPE] = {
Returns next token.
This scanner
(1) ignores leading blanks,
(2) returns a quoted token intact (excluding the quotes),
(3) returns an unquoted token delimited by a blank (not included)
or switchchar (included in next token), the default switchchar is '/
(4) returns NIL at CR or end of file.
(5) if the switchchar is '- then it must be preceded by a blank
chlook: CHAR;
workstr: REF TEXT;
delimiter for token: either blank, meaning blank
or switchchar (usually '/),
or '", or '", meaning '" not followed by another '".
RopeWP: PROC [c: CHAR] = {
IF workstr=NIL THEN workstr ← NEW[TEXT[40]];
IF workstr.length >= workstr.maxLength THEN TRUSTED {
old: REF TEXT ← workstr;
workstr ← NEW[TEXT[2*old.maxLength]];
PrincOpsUtils.LongCOPY[
from: LOOPHOLE[old, LONG POINTER] + 2, nwords: (old.maxLength + 1)/2,
to: LOOPHOLE[workstr, LONG POINTER] + 2];
workstr.length ← old.length;
};
workstr[workstr.length] ← c;
workstr.length ← SUCC[workstr.length];
};
WHILE (cpd.ch = ' OR cpd.ch = ' ) AND GetCh[cpd] DO ENDLOOP;
IF cpd.done OR cpd.ch = '\n THEN RETURN[NIL];
chlook ← ' ;
IF cpd.ch = '" THEN {
[] ← GetCh[cpd];
chlook ← '";
};
DO
IF cpd.done OR (chlook # '" AND cpd.ch = '\n) THEN GOTO EOL;
SELECT chlook FROM
' , '  => SELECT cpd.ch FROM
' , '" => IF workstr#NIL THEN EXIT;
cpd.swChar => IF cpd.ch#'- AND workstr#NIL THEN EXIT;
ENDCASE;
'" => SELECT cpd.ch FROM
'" => IF (NOT GetCh[cpd]) OR (cpd.ch # '") THEN EXIT;
ENDCASE;
ENDCASE => ERROR;
ch now contains a character to be included in the token
RopeWP[cpd.ch];
IF NOT GetCh[cpd] THEN GOTO EOL;
REPEAT
EOL => IF chlook = '" THEN ERROR UnmatchedQuote;
ENDLOOP;
IF workstr = NIL OR workstr.length=0 THEN RETURN [NIL];
result ← Rope.FromRefText[workstr];
};--IGet
GetCh: PROC [cpd: REF CPData] RETURNS [BOOL] = {
IF cpd.ropeIndex >= Rope.Size[cpd.rope] THEN GOTO EOS;
cpd.ch ← Rope.Fetch[cpd.rope, cpd.ropeIndex];
cpd.ropeIndex ← SUCC[cpd.ropeIndex];
RETURN [TRUE];
EXITS
EOS => {
cpd.done ← TRUE;
cpd.ch ← ' ;
RETURN [FALSE];
};
}; -- GetCh
}.-- UECPImpl
CHANGE LOG
Created by Stewart on 19-Mar-82 17:31
Rename Open to Parse by Gifford 23-Mar-82 14:46:08
CEDAR PROGRAM, Schroeder, September 17, 1982 3:20 pm
October 5, 1983 4:05 pm, Stewart
 renamed Parse to InnerParse. Handles TAB now (interpreted like SP)
 added new Parse routine
December 2, 1983 10:22 pm, Stewart
 Fixed LookForThings to eat the trailing character if it is the same as the thingChar
January 17, 1984 11:52 am, Stewart, added $Rest
December 3, 1984 2:34:45 pm PST, Russ Atkinson
fixed bugs in NextArgument, GetParseRecord; cleaned up some formatting,