ReadEvalPrintImpl.mesa
Copyright Ó 1984, 1986, 1987, 1989, 1992 by Xerox Corporation. All rights reserved.
Original version by P. Rovner March 30, 1983 3:34 pm
Doug Wyatt, December 16, 1986 6:48:55 pm PST
Russ Atkinson (RRA) January 21, 1987 12:49:58 pm PST
Michael Plass, October 4, 1989 9:48:16 am PDT
Bier, September 15, 1992 4:13 pm PDT
DIRECTORY
EditedStream USING [DeliverWhenProc, IsACR, SetDeliverWhen],
List USING [AList, DotCons],
IO USING [BreakProc, CharsAvail, Close, EndOf, EndOfStream, Error, Flush, GetChar, GetTokenRope, PutF, PutRope, Reset, Rubout, STREAM],
MBQueue USING [Create, CreateMenuEntry, Queue],
Menus USING [InsertMenuEntry, MenuProc],
Process USING [Abort, Detach, GetCurrent, InvalidProcess],
ProcessProps USING [AddPropList],
ReadEvalPrint,
Rope USING [Concat, Fetch, Length, ROPE],
RuntimeError USING [UNCAUGHT],
TypeScript USING [Create],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, ComputeColumn, FetchProp];
ReadEvalPrintImpl:
CEDAR
MONITOR
IMPORTS EditedStream, IO, List, MBQueue, Menus, Process, ProcessProps, Rope, RuntimeError, TypeScript, ViewerEvents, ViewerIO, ViewerOps
EXPORTS ReadEvalPrint
= BEGIN
Handle: TYPE = ReadEvalPrint.Handle;
ViewerInfoRec: TYPE = ReadEvalPrint.ViewerInfoRec;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
CreateViewerEvaluator:
PUBLIC
PROC [clientProc: ReadEvalPrint.ClientProc, prompt:
ROPE ¬
NIL, info: ViewerInfoRec, edited:
BOOL ¬
TRUE, deliverWhen: EditedStream.DeliverWhenProc ¬
NIL, clientData:
REF ¬
NIL, topLevel:
BOOL ¬
TRUE]
RETURNS [h: Handle] = {
viewer: ViewerClasses.Viewer;
h ¬ NEW[ReadEvalPrint.RObject ¬ []];
h.clientProc ¬ clientProc;
IF deliverWhen = NIL THEN deliverWhen ¬ EditedStream.IsACR;
h.deliverWhenProc ¬ deliverWhen;
h.menuHitQueue ¬ MBQueue.Create[];
h.prompt ¬ prompt;
h.viewer ¬ viewer ¬ TypeScript.Create[info: [name: info.name, label: info.label, column: SELECT info.column FROM $right => right, $color => color, ENDCASE => left, iconic: info.iconic], paint: FALSE];
h.clientData ¬ clientData;
h.topLevel ¬ topLevel;
ViewerOps.AddProp[viewer, $ReadEvalPrint, h];
[in: h.in, out: h.out]
¬ ViewerIO.CreateViewerStreams[name: NIL, viewer: viewer, editedStream: edited];
IF edited THEN EditedStream.SetDeliverWhen[h.in, deliverWhen];
Menus.InsertMenuEntry[menu: viewer.menu, line: 0, entry: MBQueue.CreateMenuEntry[q: h.menuHitQueue, name: "STOP!", proc: StopHit, clientData: h]];
ViewerOps.ComputeColumn[column: viewer.column];
};
CreateStreamEvaluator:
PUBLIC
PROC [clientProc: ReadEvalPrint.ClientProc, prompt:
ROPE ¬
NIL, in, out:
STREAM, deliverWhen: EditedStream.DeliverWhenProc ¬
NIL, clientData:
REF ¬
NIL, topLevel:
BOOL ¬
FALSE]
RETURNS [h: Handle] = {
h ¬ NEW[ReadEvalPrint.RObject ¬ []];
h.clientProc ¬ clientProc;
IF deliverWhen = NIL THEN deliverWhen ¬ EditedStream.IsACR;
h.deliverWhenProc ¬ deliverWhen;
h.prompt ¬ prompt;
h.in ¬ in;
h.out ¬ out;
h.clientData ¬ clientData;
h.topLevel ¬ topLevel;
};
Stop:
PUBLIC
PROC [h: Handle] = {
This eventually makes the process associated with the handle terminate.
h.terminateRequested ¬ TRUE;
};
MainLoop:
PUBLIC
PROC [h: Handle, forkAndDetach:
BOOL ¬
TRUE, properties: List.AList] = {
inner: PROC = { MainLoopInternal[h]; };
IF forkAndDetach
THEN
TRUSTED {
We can be recursive here, since at the next level we do not recurse.
Process.Detach[FORK MainLoop[h, FALSE, properties]];
RETURN;
};
Stuff the given properties on the current process.
properties ¬ CONS[List.DotCons[$StdIn, h.in], properties];
properties ¬ CONS[List.DotCons[$StdOut, h.out], properties];
properties ¬ CONS[List.DotCons[$ErrOut, h.out], properties];
ProcessProps.AddPropList[properties, inner];
};
MainLoopInternal:
PROC [h: Handle] = {
commandLine: ROPE ¬ NIL;
result: ROPE ¬ NIL;
rejectThisOne: BOOL ¬ FALSE;
in: STREAM ¬ h.in;
out: STREAM ¬ h.out;
breakProc:
IO.BreakProc = {
IF h.deliverWhenProc[char,
NIL, in,
NIL].activate
THEN RETURN [break] ELSE RETURN [other];
};
DoRead:
PROC
RETURNS [destroyed:
BOOL ¬
FALSE] = {
destroyed ¬ IO.EndOf[in ! RuntimeError.UNCAUGHT => {destroyed ¬ TRUE; CONTINUE}];
IF
NOT destroyed
THEN {
IO.PutF[out, h.prompt, [rope["b"]], [rope["B"]] ];
IF h.promptProc # NIL THEN h.promptProc[h];
GetLine[ ! IO.EndOfStream => CONTINUE];
};
};
GetLine:
PROC = {
Get a command line.
commandLine ¬
NIL;
NIL out the command line even if we get an error
commandLine ¬ IO.GetTokenRope[in, breakProc].token;
IF commandLine.Length[] # 0
THEN
IF
NOT h.deliverWhenProc[commandLine.Fetch[0],
NIL, in,
NIL].activate
THEN
commandLine ¬ Rope.Concat[commandLine, IO.GetTokenRope[in, breakProc].token];
};
TRUSTED {h.mainLoopProcess ¬ LOOPHOLE[Process.GetCurrent[], SAFE PROCESS]};
UNTIL h.terminateRequested
DO
aborted: BOOL ¬ FALSE;
syntaxError: BOOL ¬ FALSE;
rubout: BOOL ¬ FALSE;
Just in case the user alters these with intent.
in ¬ h.in;
out ¬ h.out;
IF in = NIL OR out = NIL THEN RETURN;
Try to read a `line' for the user. We try very hard to protect against errors, and to report the non-fatal ones. It is always fatal for the input stream to not be readable, for example. It is fatal to be aborted if not at topLevel. Rubouts should never be fatal.
IF DoRead[ !
ABORTED => {aborted ¬ TRUE; CONTINUE};
IO.Error => {
IF ec = StreamClosed THEN EXIT;
WITH h.viewer
SELECT
FROM
viewer: ViewerClasses.Viewer => IF viewer.destroyed THEN EXIT;
ENDCASE => EXIT;
IF ec = SyntaxError THEN {syntaxError ¬ TRUE; CONTINUE};
};
IO.EndOfStream => {
WITH h.viewer
SELECT
FROM
viewer: ViewerClasses.Viewer => IF viewer.destroyed THEN EXIT;
ENDCASE => EXIT;
IF stream = in THEN EXIT;
};
IO.Rubout => {rubout ¬ TRUE; CONTINUE};
] THEN EXIT;
{
Here we handle the actual work of the world, as well as rubout and syntaxError reporting. We try to guard against errors when dealing with rubout and syntaxError reporting, but the user must not be overly protected against anything except ABORTED.
ENABLE ABORTED => {aborted ¬ TRUE; GO TO out};
SELECT
TRUE
FROM
rubout => {
ENABLE RuntimeError.UNCAUGHT => GO TO out;
IF h.ruboutProc #
NIL
THEN h.ruboutProc[h]
ELSE {
msg: ROPE ¬ " -- <del>\n";
IF h.readIOSignalRope # NIL THEN msg ¬ h.readIOSignalRope;
EatIt[in];
IO.PutRope[out, msg];
};
};
syntaxError => {
ENABLE RuntimeError.UNCAUGHT => GO TO out;
EatIt[in];
IO.PutRope[out, " -- Syntax error!\n"];
};
commandLine #
NIL
AND
NOT aborted => {
result ¬ h.clientProc[h, commandLine];
IF result #
NIL
THEN {
IO.PutRope[out, result];
We use PutF to handle % codes registered by the client.
result ¬ NIL;
IO.PutRope[out, "\n"];
};
};
ENDCASE => {};
EXITS out => {};
};
IF aborted
THEN {
msg: ROPE ¬ " -- Aborted.\n";
IF h.evalABORTEDRope # NIL THEN msg ¬ h.evalABORTEDRope;
IO.PutRope[out, msg ! RuntimeError.UNCAUGHT => CONTINUE];
IO.Flush[out ! RuntimeError.UNCAUGHT => CONTINUE];
EatIt[in ! ABORTED => CONTINUE];
IF
NOT h.topLevel
THEN {
IF in #
NIL
THEN
IO.Close[in
! RuntimeError.UNCAUGHT => CONTINUE; IO.Error => CONTINUE];
EXIT;
};
};
ENDLOOP;
};
Implementation private procedures
StopHit: Menus.MenuProc =
TRUSTED {
[parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
h: Handle ¬ NARROW[clientData, Handle];
Process.Abort[h.mainLoopProcess ! Process.InvalidProcess => CONTINUE];
};
EatIt:
PROC [st:
STREAM] = {
This little helper routine eats all characters from an input stream until there are no more available. If the stream is NIL or any IO error occurs, then we just exit.
IF st #
NIL
THEN {
ENABLE {
IO.Error => GO TO done;
IO.EndOfStream => GO TO done;
RuntimeError.UNCAUGHT => GO TO done;
};
IO.Reset[st];
WHILE
IO.CharsAvail[st] > 0
DO
[] ¬ IO.GetChar[st];
IO.Reset[st];
ENDLOOP;
EXITS done => {};
};
};
ViewerEvent: ViewerEvents.EventProc =
TRUSTED {
SELECT event
FROM
destroy => {
prop: REF ¬ ViewerOps.FetchProp[viewer, $ReadEvalPrint];
IF prop # NIL THEN Stop[NARROW[prop, Handle]];
};
ENDCASE;
};
Init:
PROC = {
[] ¬ ViewerEvents.RegisterEventProc[proc: ViewerEvent, event: destroy, filter: $Typescript];
};
END.