XNSPSCommanderImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Tim Diebert: April 10, 1987 10:49:08 am PDT
DIRECTORY
Ascii USING [BS, ControlA, ControlQ, ControlW, ControlX, CR, DEL, Digit, Letter, SP],
BasicTime USING [TimeNotKnown],
Convert USING [Error, IntFromRope, RopeFromInt],
IO USING [EndOfStream, EraseChar, GetChar, PutChar, PutF, PutRope, STREAM],
Rope USING [Compare, Concat, Fetch, FromChar, Length, ROPE, Run, Substr],
XNSPSCommander;
XNSPSCommanderImpl:
CEDAR
PROGRAM
IMPORTS Ascii, BasicTime, Convert, IO, Rope
EXPORTS XNSPSCommander
= BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Rubout: PUBLIC ERROR = CODE;
GetID:
PUBLIC
PROC [in, out:
STREAM, default:
ROPE, init:
ROPE ←
NIL, echo:
BOOL ←
TRUE]
RETURNS [id:
ROPE, c:
CHAR] = {
OPEN Ascii;
firstTime: BOOL ← init = NIL;
EraseAll:
PROC = {
IF echo
THEN
FOR i: INT DECREASING IN [0..id.Length[]) DO IO.EraseChar[out, id.Fetch[i]]; ENDLOOP;
id ← NIL;
};
Done:
PROC [c:
CHAR]
RETURNS [
BOOL] =
INLINE {
IF firstTime
THEN {
SELECT c
FROM
ControlA, BS, ControlQ, ControlW, ControlX, CR, SP, DEL => NULL;
ENDCASE => EraseAll[];
firstTime ← FALSE;
};
RETURN [c = SP OR c = CR OR c = '?]
};
id ← Rope.Concat[init, default];
IF echo THEN IO.PutRope[out, default];
c ← IO.GetChar[in];
UNTIL Done[c]
DO
SELECT c
FROM
DEL => ERROR Rubout;
ControlA,
BS => {
len: INT ← id.Length[];
IF len > 0
THEN {
len ← len - 1;
IF echo THEN IO.EraseChar[out, id.Fetch[len]];
id ← id.Substr[len: len];
};
};
ControlW, ControlQ => {
text to be backed up is of the form ...<non-alpha><alpha><non-alpha>, the <alpha> and following <non-alpha> are to be removed.
alpha: BOOL ← FALSE;
FOR i:
INT
DECREASING
IN [0..id.Length[])
DO
ch: CHAR = id.Fetch[i];
IF Ascii.Letter[ch] OR Ascii.Digit[ch] THEN alpha ← TRUE
ELSE IF alpha THEN {id ← id.Substr[len: i + 1]; EXIT};
IF echo THEN IO.EraseChar[out, ch];
REPEAT
FINISHED => id ← NIL;
ENDLOOP;
};
ControlX => EraseAll[];
ENDCASE => {
id ← Rope.Concat[id, Rope.FromChar[c]];
IF echo THEN IO.PutChar[out, c];
};
c ← IO.GetChar[in];
ENDLOOP;
};
commandList: XNSPSCommander.CommandList ← NIL;
RegisterCommand:
PUBLIC
PROC [info: XNSPSCommander.CommandInfo] = {
... registers the command so it can be found again.
new: XNSPSCommander.CommandList = LIST[info];
lag: XNSPSCommander.CommandList ← NIL;
FOR each: XNSPSCommander.CommandList ← commandList, each.rest
WHILE each #
NIL
DO
full: ROPE ← each.first.fullName;
SELECT Rope.Compare[info.fullName, full,
FALSE]
FROM
less => {
Insert new command
new.rest ← each;
EXIT;
};
equal => {
Replace old command
each.first ← info;
RETURN;
};
ENDCASE;
lag ← each;
ENDLOOP;
IF lag = NIL THEN commandList ← new ELSE lag.rest ← new;
};
GetCommandList:
PUBLIC
PROC
RETURNS [XNSPSCommander.CommandList] = {
RETURN [commandList];
};
GetCommand:
PUBLIC
PROC [in, out:
STREAM]
RETURNS [found: XNSPSCommander.CommandInfo] = {
May raise Rubout
prompt: ROPE = "\n> ";
BoolFalse: TYPE = BOOL ← FALSE;
prefix: ROPE ← NIL;
IO.PutRope[out, prompt];
DO
end: CHAR;
matches: { none, one, many } ← none;
uniqueLength: INT;
[id: prefix, c: end] ← GetID[in: in, out: out, default: NIL, init: prefix];
uniqueLength ← prefix.Length[];
IF end = '? THEN IO.PutChar[out, '?];
FOR each: XNSPSCommander.CommandList ← commandList, each.rest
WHILE each #
NIL
DO
c: XNSPSCommander.CommandInfo = each.first;
fullName: ROPE = c.fullName;
IF Rope.Run[s1: fullName, s2: prefix, case:
FALSE] = prefix.Length[]
THEN {
IF matches = none
THEN {
matches ← one;
uniqueLength ← Rope.Length[fullName];
found ← c;
IF end = '? THEN IO.PutRope[out, " ... one of:\n"];
}
ELSE {
stillMatches:
INT =
Rope.Run[s1: fullName, s2: found.fullName, case: FALSE];
uniqueLength ← MIN[uniqueLength, stillMatches];
matches ← many;
IF end = '? THEN IO.PutRope[out, ", "];
};
IF end = '? THEN IO.PutRope[out, fullName];
};
ENDLOOP;
IF end = '?
AND matches # none
THEN { IO.PutRope[out, prompt]; IO.PutRope[out, prefix] }
ELSE {
IF uniqueLength = prefix.Length[]
THEN {
SELECT matches
FROM
none => IO.PutRope[out, " ... command not found"];
one => EXIT;
many => IF uniqueLength # 0 THEN IO.PutRope[out, " ... ambiguous"];
ENDCASE => ERROR;
IO.PutRope[out, prompt]; IO.PutRope[out, prefix];
}
ELSE {
extra:
ROPE = Rope.Substr[
found.fullName, prefix.Length[], uniqueLength-prefix.Length[]];
IO.PutRope[out, extra];
SELECT matches
FROM
one => EXIT;
many => prefix ← Rope.Concat[prefix, extra];
ENDCASE => ERROR;
};
};
ENDLOOP;
};
GetArg:
PUBLIC
PROC [in, out:
STREAM, prompt, default:
ROPE, help:
PROC]
RETURNS [value:
ROPE ←
NIL] = {
DO
end: CHAR;
IO.PutRope[out, prompt];
IO.PutRope[out, value];
[id: value, c: end] ← GetID[in: in, out: out, default: default, init: value];
default ← NIL;
IF end = '? THEN help[] ELSE EXIT;
ENDLOOP;
};
Confirm:
PUBLIC
PROC[in, out:
STREAM]
RETURNS [
BOOL] = {
DO c:
CHAR =
IO.GetChar[in];
SELECT c
FROM
'y, 'Y, Ascii.CR => { IO.PutRope[out, "yes"]; RETURN [TRUE] };
'n, 'N => { IO.PutRope[out, "no"]; RETURN [FALSE] };
Ascii.DEL => ERROR Rubout[];
ENDCASE =>
IO.PutRope[out, "?\nConfirm by typing \"Y\" or CR, deny by typing \"N\", abort by typing DEL: "];
ENDLOOP;
};
GetNumber:
PUBLIC
PROC [in, out:
STREAM, default:
INT, max:
INT ←
LAST[
INT], prompt, help:
ROPE]
RETURNS [size:
INT ← 0] = {
Help: PROC = { IO.PutRope[out, help] };
sizeRope: ROPE ← Convert.RopeFromInt[default];
DO
ok: BOOL ← TRUE;
size ← 0;
sizeRope ← GetArg[ in: in, out: out, prompt: prompt, default: sizeRope, help: Help];
size ← Convert.IntFromRope[sizeRope ! Convert.Error => { ok ← FALSE; CONTINUE } ];
IF ~ok THEN { IO.PutRope[out, " ... not a number"]; LOOP };
IF size <= max
THEN RETURN
ELSE IO.PutF[out, " ... number should be less than %g", [integer[max]] ];
ENDLOOP;
};
ForceExit: ERROR = CODE;
DoCommand:
PROC [in, out:
STREAM, c: XNSPSCommander.CommandInfo]
RETURNS [exit:
BOOL ←
FALSE, overwritten:
BOOL ←
FALSE] = {
ENABLE {
Rubout => {
IO.PutRope[out, " XXX"];
GO TO leave
};
FS.Error => {
IO.PutRope[out, " ... \n "];
IO.PutRope[out,
IF error.explanation.Length[] # 0
THEN error.explanation
ELSE "FS.Error without a message: consult an expert"];
GO TO leave
};
BasicTime.TimeNotKnown => {
IO.PutRope[out, " ... I can't do that without knowing the current time."];
GO TO leave
};
ForceExit => {
exit ← TRUE;
GO TO leave
};
Overwritten => {
overwritten ← TRUE;
GO TO leave
};
};
c.commandProc[in, out];
EXITS leave => {};
};
TalkToUser:
PUBLIC
PROC[in, out:
STREAM] = {
IO.PutRope[out, "\n\nType \"?\" at any time if you need help.\n"];
DO
ENABLE {
ABORTED => EXIT;
Rubout => { IO.PutRope[out, " XXX"]; LOOP };
};
c: XNSPSCommander.CommandInfo = GetCommand[in: in, out: out
! IO.EndOfStream => EXIT];
exit, overwritten: BOOL;
[exit, overwritten] ← DoCommand[in, out, c];
IF exit THEN EXIT;
ENDLOOP;
};
QuitCommand:
PROC [in, out:
STREAM] = {
IO.PutRope[out, "\nAre you sure? "];
IF Confirm[in, out] THEN ERROR ForceExit;
};
RegisterCommand[[QuitCommand, "Quit"]];