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 => { 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] = { 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 => { new.rest _ each; EXIT; }; equal => { 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] = { 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 }; BasicTime.TimeNotKnown => { IO.PutRope[out, " ... I can't do that without knowing the current time."]; GO TO leave }; ForceExit => { exit _ 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"]]; END. ”XNSPSCommanderImpl.mesa Copyright Σ 1987 by Xerox Corporation. All rights reserved. Tim Diebert: April 10, 1987 10:49:08 am PDT ******** Input subroutines ******** text to be backed up is of the form ..., the and following are to be removed. ... registers the command so it can be found again. Insert new command Replace old command May raise Rubout 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 }; Overwritten => { overwritten _ TRUE; GO TO leave }; Κ ^˜codešœ™Kšœ<™Kšœ œœœ˜4Kšœœœ ˜šœ˜ Kšœ_˜a——Kšœ˜—Kšœ˜—K˜K˜šŸ œœœ œ œœœœœœœ ˜|KšŸœœœ˜'Kšœ œ ˜.š˜Kšœœœ˜Kšœ ˜ KšœT˜TKšœ>œœ˜RKšœœœ$œ˜;šœ ˜Kšœ˜ KšœœB˜I—Kšœ˜—Kšœ˜—K˜KšŸ œœœ˜K˜šŸ œœ œ  œœœœœ˜|šœ˜šœ ˜ Kšœ˜Kšœœ˜ Kšœ˜—šœ ™ Kšœ™šœ™šœ™!Kšœ™Kšœ2™6——Kšœœ™ Kšœ™—šœ˜KšœH˜JKšœœ˜ Kšœ˜—šœ˜Kšœœ˜ Kšœœ˜ Kšœ˜—šœ™Kšœœ™Kšœœ™ Kšœ™—Kšœ˜—Kšœ˜Kšœ ˜Kšœ˜K˜—K˜šŸ œœœ œ˜,Kšœ@˜Bš˜šœ˜Kšœœ˜Kšœ œœ˜,Kšœ˜—Kšœ>œœ˜VKšœœ˜Kšœ,˜,Kšœœœ˜Kšœ˜—Kšœ˜—K˜šŸ œœ œ˜'Kšœ"˜$Kšœœœ ˜)Kšœ˜K˜—Kšœ'˜'K˜—Kšœ˜—…—š&Œ