<> <> <> <> DIRECTORY EditedStream USING [DeliverWhenProc, IsACR, Rubout, SetDeliverWhen], IO USING [BreakProc, CharsAvail, Close, EndOf, EndOfStream, Error, Flush, GetChar, GetTokenRope, PutF, PutRope, Reset, STREAM], List USING [AList], MBQueue USING [Create, CreateMenuEntry, Queue], Menus USING [InsertMenuEntry, MenuProc], Process USING [Abort, Detach, GetCurrent, InvalidProcess], ProcessProps USING [PushPropList], ReadEvalPrint, Rope USING [ROPE, Concat, Length, Fetch], RuntimeError USING [UNCAUGHT], TypeScript USING [Create], ViewerClasses USING [Viewer, ViewerRec], ViewerEvents USING [EventProc, RegisterEventProc], ViewerIO USING [CreateViewerStreams], ViewerOps USING [AddProp, ComputeColumn, FetchProp]; ReadEvalPrintImpl: CEDAR MONITOR IMPORTS EditedStream, IO, MBQueue, Menus, Process, ProcessProps, Rope, RuntimeError, TypeScript, ViewerEvents, ViewerIO, ViewerOps EXPORTS ReadEvalPrint = BEGIN Handle: TYPE = ReadEvalPrint.Handle; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; CreateViewerEvaluator: PUBLIC PROC [clientProc: ReadEvalPrint.ClientProc, prompt: ROPE _ NIL, info: ViewerClasses.ViewerRec _ [], edited: BOOL _ TRUE, deliverWhen: EditedStream.DeliverWhenProc _ NIL, clientData: REF _ NIL, topLevel: BOOL _ TRUE] RETURNS [h: Handle] = { 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 _ TypeScript.Create[info: info, paint: FALSE]; h.clientData _ clientData; h.topLevel _ topLevel; ViewerOps.AddProp[h.viewer, $ReadEvalPrint, h]; [in: h.in, out: h.out] _ ViewerIO.CreateViewerStreams[name: NIL, viewer: h.viewer, editedStream: edited]; IF edited THEN EditedStream.SetDeliverWhen[h.in, deliverWhen]; Menus.InsertMenuEntry[menu: h.viewer.menu, line: 0, entry: MBQueue.CreateMenuEntry[q: h.menuHitQueue, name: "STOP!", proc: StopHit, clientData: h]]; ViewerOps.ComputeColumn[column: info.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] = { <> h.terminateRequested _ TRUE; }; MainLoop: PUBLIC PROC [h: Handle, forkAndDetach: BOOL _ TRUE, properties: List.AList] = { inner: PROC = { MainLoopInternal[h]; }; IF forkAndDetach THEN TRUSTED { <> Process.Detach[FORK MainLoop[h, FALSE, properties]]; RETURN; }; <> IF properties # NIL THEN ProcessProps.PushPropList[properties, inner] ELSE 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 = { <> commandLine _ NIL; <> 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; <> in _ h.in; out _ h.out; IF in = NIL OR out = NIL THEN RETURN; <> IF DoRead[ ! ABORTED => {aborted _ TRUE; CONTINUE}; IO.Error => { IF ec = StreamClosed THEN EXIT; IF h.viewer = NIL OR h.viewer.destroyed THEN EXIT; IF ec = SyntaxError THEN {syntaxError _ TRUE; CONTINUE}; }; IO.EndOfStream => { IF h.viewer = NIL OR h.viewer.destroyed THEN EXIT; IF stream = in THEN EXIT; }; EditedStream.Rubout => {rubout _ TRUE; CONTINUE}; ] THEN EXIT; { <> 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 _ " -- \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.PutF[out, result]; <> 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; }; <> <<>> 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] = { <> 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]; }; <> Init[]; END.