<> <> <> <> <> <<>> <<-- CreateViewerStreams should not raise IO.Error[$Failure], should not raise FS.Error?>> <<-- Should Destroy of a viewer cause implicit Close?>> <<-- WasAStreamViewerDestroyed seems to require monitor protection in its access to the stream.>> <<-- Why is Close not implemented for Viewer streams?>> <<-- What if node goes away in AppendBufferChar?>> <<-- Edited stream backup does not allow backup past ready chars, should it?>> <<-- SetEcho with stream in the backed-up state should be some sort of error?>> DIRECTORY Ascii, Atom, FS USING [StreamOpen], EditedStream, IO, IOClasses USING [CreateDribbleOutputStream], IOUtils, MessageWindow USING [Append, Clear], RefText, Rope, TiogaOps USING [GetRope, GetTextKey, LastLocWithin, Location, PutTextKey, Ref, ViewerDoc], TypeScript USING [BackSpace, ChangeLooks, CharsAvailable, Create, Destroyed, Flush, GetChar, IsATypeScript, PutChar, TypeIn, WaitUntilCharsAvail], ViewerClasses USING [Viewer], ViewerEvents USING [EventProc, RegisterEventProc], ViewerIO USING [], ViewerOps USING [AddProp, FetchProp]; ViewerIOImpl: CEDAR PROGRAM IMPORTS Atom, EditedStream, FS, IO, IOClasses, IOUtils, MessageWindow, RefText, Rope, TiogaOps, TypeScript, ViewerEvents, ViewerOps EXPORTS ViewerIO = BEGIN STREAM: TYPE = IO.STREAM; ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; StreamProcs: TYPE = IO.StreamProcs; DeliverWhenProc: TYPE = EditedStream.DeliverWhenProc; TypeOfGetDeliverWhen: TYPE = PROC [self: STREAM] RETURNS [proc: DeliverWhenProc, context: REF ANY]; TypeOfSetDeliverWhen: TYPE = PROC [self: STREAM, proc: DeliverWhenProc, context: REF ANY]; TypeOfAppendBufferChars: TYPE = PROC [stream: STREAM, chars: ROPE]; TypeOfUnAppendBufferChars: TYPE = PROC [stream: STREAM, nChars: NAT]; TypeOfSetMode: TYPE = PROC [stream: STREAM, stuff: ROPE, pendingDelete: BOOL, echoAsterisks: BOOL]; <> <> ViewerStreamData: TYPE = REF ViewerStreamDataRecord; <> ViewerStreamDataRecord: TYPE = RECORD [ viewer: Viewer, echoStream: STREAM _ NIL ]; ViewerInStreamProcs: REF StreamProcs; ViewerOutStreamProcs: REF StreamProcs; ViewerOutPFProcs: IOUtils.PFProcs; <> CreateViewerStreams: PUBLIC PROC [ name: ROPE, viewer: Viewer, backingFile: ROPE, editedStream: BOOL] RETURNS [in: STREAM, out: STREAM] = { streams: LIST OF STREAM; IF viewer = NIL THEN viewer _ TypeScript.Create[info: [name: name, iconic: FALSE]] ELSE IF NOT TypeScript.IsATypeScript[viewer] THEN ERROR IO.Error[$Failure, NIL]; in _ IO.CreateStream[ streamProcs: ViewerInStreamProcs, streamData: NEW[ViewerStreamDataRecord _ [viewer: viewer]]]; IOUtils.StoreData[in, $Name, name]; out _ IO.CreateStream[ streamProcs: ViewerOutStreamProcs, streamData: NEW[ViewerStreamDataRecord _ [viewer: viewer]]]; IOUtils.StoreData[out, $Name, name]; [] _ IOUtils.SetPFProcs[out, ViewerOutPFProcs]; IF backingFile # NIL THEN out _ IOClasses.CreateDribbleOutputStream[ output1: out, output2: FS.StreamOpen[fileName: backingFile, accessOptions: $create]]; streams _ NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $Streams]]; streams _ CONS[in, CONS[out, streams]]; ViewerOps.AddProp[viewer: viewer, prop: $Streams, val: streams]; IF editedStream THEN in _ CreateEditedViewerStream[in: in, echoTo: out, deliverWhen: EditedStream.IsACR] ELSE EditedStream.SetEcho[self: in, echoTo: out]; }; GetViewerFromStream: PUBLIC PROC [stream: STREAM] RETURNS [Viewer] = { WHILE stream # NIL DO WITH stream.streamData SELECT FROM r: ViewerStreamData => RETURN[r.viewer] ENDCASE => stream _ stream.backingStream; ENDLOOP; RETURN [NIL]; }; WasAStreamViewerDestroyed: ViewerEvents.EventProc = { streams: LIST OF STREAM = NARROW[ViewerOps.FetchProp[viewer, $Streams]]; v: Viewer _ viewer; IF streams = NIL THEN RETURN; WHILE (v _ v.link) # NIL AND (v # viewer) DO -- split viewer IF NOT v.destroyed THEN { <> FOR l: LIST OF STREAM _ streams, l.rest UNTIL l = NIL DO data: ViewerStreamData = NARROW[l.first.streamData]; data.viewer _ v; ENDLOOP; ViewerOps.AddProp[v, $Streams, streams]; RETURN; }; ENDLOOP; }; <> ViewerGetChar: PROC [self: STREAM] RETURNS [char: CHAR] = { data: ViewerStreamData = NARROW[self.streamData]; IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self]; char _ TypeScript.GetChar[data.viewer ! TypeScript.Destroyed => IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self] ELSE RETRY]; <> IF data.echoStream # NIL THEN data.echoStream.PutChar[char]; }; ViewerEndOf: PROC [self: STREAM] RETURNS [BOOL] = CHECKED { data: ViewerStreamData = NARROW[self.streamData]; IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self]; RETURN[FALSE]; }; ViewerCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = { data: ViewerStreamData = NARROW[self.streamData]; viewer: Viewer _ data.viewer; IF viewer = NIL OR viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self]; IF wait THEN { TypeScript.WaitUntilCharsAvail[viewer ! TypeScript.Destroyed => IF viewer.destroyed THEN ERROR IO.Error[StreamClosed, self] ELSE RETRY]; RETURN[1] } ELSE RETURN[IF TypeScript.CharsAvailable[viewer] THEN 1 ELSE 0]; }; ViewerSetEcho: PROC [self: STREAM, echoTo: STREAM] = { data: ViewerStreamData = NARROW[self.streamData]; IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self]; data.echoStream _ echoTo; }; ViewerGetEcho: PROC [self: STREAM] RETURNS [oldEcho: STREAM] = { data: ViewerStreamData = NARROW[self.streamData]; IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self]; RETURN [data.echoStream]; }; <

> ViewerPutChar: PROC[self: STREAM, char: CHAR] = { data: ViewerStreamData = NARROW[self.streamData]; IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self]; TypeScript.PutChar[data.viewer, char ! TypeScript.Destroyed => IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self] ELSE RETRY]; }; ViewerFlush: PROC[self: STREAM] = { data: ViewerStreamData = NARROW[self.streamData]; IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self]; TypeScript.Flush[data.viewer]; }; ViewerEraseChar: PROC[self: STREAM, char: CHAR] = { data: ViewerStreamData = NARROW[self.streamData]; WHILE data.viewer.destroyed DO IF data.viewer.link # NIL THEN data.viewer _ data.viewer.link ELSE ERROR IO.Error[$StreamClosed, self]; ENDLOOP; TypeScript.BackSpace[data.viewer]; }; ViewerReset: PROC [self: STREAM] = { <> ENABLE TypeScript.Destroyed => GO TO bye; data: ViewerStreamData = NARROW[self.streamData]; viewer: Viewer = data.viewer; IF viewer = NIL OR viewer.destroyed THEN RETURN; TypeScript.ChangeLooks[viewer, ' ]; <> DO IF NOT TypeScript.CharsAvailable[viewer] THEN GO TO bye; [] _ TypeScript.GetChar[viewer]; ENDLOOP; EXITS bye => {}; }; ViewerSetLooks: IOUtils.PFCodeProc = { viewer: Viewer = GetViewerFromStream[stream]; looks: ROPE _ NIL; IF viewer = NIL THEN ERROR IO.Error[$NotImplementedForThisStream, stream]; TRUSTED { WITH v: val SELECT FROM null => NULL; atom => looks _ Atom.GetPName[v.value]; rope => looks _ v.value; character => looks _ Rope.FromChar[v.value]; ENDCASE => ERROR IO.Error[$NotImplementedForThisStream, stream] }; FOR i: INT IN [0..Rope.Length[looks]) DO TypeScript.ChangeLooks[viewer, Rope.Fetch[looks, i]]; ENDLOOP; }; <> Location: TYPE = TiogaOps.Location; EditedViewerStreamData: TYPE = REF EditedViewerStreamRecord; EditedViewerStreamRecord: TYPE = RECORD[ ready: REF TEXT, readyPos: INT _ 0, -- ready[readyPos .. ready.length) are the already-activated characters buffer: REF TEXT, echoStream: STREAM, deliverWhen: DeliverWhenProc, context: REF ANY, bufferIsConsistent: BOOL _ FALSE, viewer: Viewer, node: TiogaOps.Ref ]; EditedViewerStreamProcs: REF StreamProcs; CreateEditedViewerStream: PROC [ in: STREAM, echoTo: STREAM, deliverWhen: DeliverWhenProc, context: REF ANY _ NIL] RETURNS [STREAM] = { <> <> data: EditedViewerStreamData; data _ NEW[EditedViewerStreamRecord _ [ buffer: NEW[TEXT[256]], ready: NEW[TEXT[256]], readyPos: 0, echoStream: echoTo, deliverWhen: deliverWhen, context: context, viewer: NARROW[in.streamData, ViewerStreamData].viewer, node: NIL]]; RETURN [IO.CreateStream[ streamProcs: EditedViewerStreamProcs, streamData: data, backingStream: in]] }; GetBuffer: PUBLIC PROC [editedViewerStream: STREAM] RETURNS [REF TEXT] = { data: EditedViewerStreamData = NARROW[editedViewerStream.streamData]; GetCurrentBuffer1[data]; RETURN [data.buffer]; }; TypeChars: PUBLIC PROC [editedViewerStream: STREAM, chars: ROPE] = { data: EditedViewerStreamData = NARROW[editedViewerStream.streamData]; TypeScript.TypeIn[data.viewer, chars]; }; GetCurrentBuffer: PROC [data: EditedViewerStreamData] = INLINE { <> <> <> IF data.bufferIsConsistent THEN RETURN ELSE GetCurrentBuffer1[data]; }; GetCurrentBuffer1: PROC [data: EditedViewerStreamData] = { r: ROPE; loc: Location; data.buffer.length _ 0; data.bufferIsConsistent _ TRUE; IF data.node = NIL THEN RETURN; TypeScript.Flush[data.viewer]; r _ TiogaOps.GetRope[data.node]; loc _ TiogaOps.GetTextKey[node: data.node, key: data]; IF loc.node # data.node THEN ERROR; { <<-- RefText.AppendRope[to: data.buffer, from: r, start: loc.where + 1];>> Put: PROC [c: CHAR] RETURNS [quit: BOOL] = { data.buffer _ RefText.InlineAppendChar[data.buffer, c]; RETURN [quit: FALSE] }; [] _ Rope.Map[base: r, start: loc.where + 1, len: INT.LAST, action: Put]; }; }; EditedViewerStreamAppendBufferChars: PROC [stream: STREAM, chars: ROPE] = { data: EditedViewerStreamData = NARROW[stream.streamData]; Append1: PROC [c: CHAR] RETURNS [quit: BOOL] = { AppendBufferChar[data, c]; RETURN [quit: FALSE] }; GetCurrentBuffer1[data]; [] _ chars.Map[action: Append1]; }; AppendBufferChar: PROC [data: EditedViewerStreamData, char: CHAR] = INLINE { <> loc: Location; data.buffer _ RefText.InlineAppendChar[data.buffer, char]; IF data.node = NIL THEN { TypeScript.Flush[data.viewer]; loc _ TiogaOps.LastLocWithin[TiogaOps.ViewerDoc[data.viewer]]; <> IF loc.where = 0 THEN data.echoStream.PutChar[' ] ELSE loc.where _ loc.where - 1; }; data.echoStream.PutChar[char]; IF data.node = NIL THEN { TypeScript.Flush[data.viewer]; TiogaOps.PutTextKey[node: loc.node, where: loc.where, key: data]; <> data.node _ loc.node; }; }; EditedViewerStreamUnAppendBufferChars: PROC [stream: STREAM, nChars: NAT] = { data: EditedViewerStreamData = NARROW[stream.streamData]; GetCurrentBuffer1[data]; FOR i: NAT IN [0 .. MIN[nChars, data.buffer.length]) DO UnAppendBufferChar[data] ENDLOOP; }; UnAppendBufferChar: PROC [data: EditedViewerStreamData] = INLINE { <> char: CHAR = data.buffer[data.buffer.length - 1]; data.echoStream.EraseChar[char]; data.buffer.length _ data.buffer.length - 1; IF data.buffer.length = 0 THEN data.node _ NIL; }; EditedViewerStreamSetMode: PROC [stream: STREAM, stuff: ROPE, pendingDelete: BOOL, echoAsterisks: BOOL] = { data: EditedViewerStreamData = NARROW[stream.streamData]; data.buffer.length _ 0; data.readyPos _ data.ready.length; EditedViewerStreamAppendBufferChars[stream, stuff]; }; EditedViewerStreamGetDeliverWhen: PROC [self: STREAM] RETURNS [proc: DeliverWhenProc, context: REF ANY] = { data: EditedViewerStreamData = NARROW[self.streamData]; RETURN [data.deliverWhen, data.context]; }; EditedViewerStreamSetDeliverWhen: PROC [self: STREAM, proc: DeliverWhenProc, context: REF ANY] = { data: EditedViewerStreamData = NARROW[self.streamData]; data.deliverWhen _ proc; data.context _ context; }; EditedViewerStreamGetChar: PROC [self: STREAM] RETURNS [char: CHAR] = { data: EditedViewerStreamData = NARROW[self.streamData]; IsEditCommand: PROC [char: CHAR] RETURNS [BOOL] = { RETURN [SELECT char FROM Ascii.DEL, Ascii.ControlA, Ascii.BS, Ascii.ControlW, Ascii.ControlQ => TRUE, ENDCASE => FALSE]; }; BackChar: PROC = { <> IF data.buffer.length > 0 THEN { UnAppendBufferChar[data]; } }; BackWord: PROC = { <> alphaSeen: BOOL _ FALSE; UNTIL data.buffer.length = 0 DO SELECT data.buffer[data.buffer.length - 1] FROM IN ['A..'Z], IN ['a..'z], IN ['0..'9] => alphaSeen _ TRUE; ENDCASE => IF alphaSeen THEN EXIT; UnAppendBufferChar[data]; ENDLOOP; }; BackLine: PROC = { <> UNTIL data.buffer.length = 0 DO IF data.buffer[data.buffer.length - 1] = IO.CR THEN EXIT; UnAppendBufferChar[data]; ENDLOOP; }; DO IF data.readyPos < data.ready.length THEN { char _ data.ready[data.readyPos]; data.readyPos _ data.readyPos + 1; RETURN [char]; }; { appendChar, activate: BOOL; char _ self.backingStream.GetChar[ ! IO.EndOfStream => IF data.buffer.length = 0 THEN REJECT ELSE GOTO activateBuffer]; <> [appendChar: appendChar, activate: activate] _ data.deliverWhen[char, NIL --data.buffer--, self, data.context]; IF appendChar THEN { SELECT char FROM Ascii.DEL => { ENABLE UNWIND => data.buffer.length _ 0; ERROR EditedStream.Rubout[self]; }; Ascii.ControlA, Ascii.BS => { GetCurrentBuffer1[data]; BackChar[] }; Ascii.ControlW => { GetCurrentBuffer1[data]; BackWord[] }; Ascii.ControlQ => { GetCurrentBuffer1[data]; BackLine[] }; Ascii.ESC => { GetCurrentBuffer1[data]; IF data.buffer.length = 0 THEN { FOR i: NAT IN [0..data.ready.length-1) DO AppendBufferChar[data, data.ready[i]]; ENDLOOP } }; ENDCASE => { IF data.buffer.length = 0 THEN GetCurrentBuffer1[data]; AppendBufferChar[data, char]; } }; IF activate THEN GOTO activateBuffer; EXITS activateBuffer => { GetCurrentBuffer1[data]; data.ready.length _ 0; data.ready _ RefText.Append[data.ready, data.buffer]; data.readyPos _ 0; data.buffer.length _ 0; data.node _ NIL; } } ENDLOOP; }; EditedViewerStreamEndOf: PROC [self: STREAM] RETURNS [BOOL] = { data: EditedViewerStreamData = NARROW[self.streamData]; RETURN[data.readyPos = data.ready.length AND self.backingStream.EndOf[]]; }; EditedViewerStreamCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = { data: EditedViewerStreamData = NARROW[self.streamData]; IF data.readyPos < data.ready.length THEN RETURN [data.ready.length-data.readyPos]; RETURN[self.backingStream.CharsAvail[wait]]; }; EditedViewerStreamBackup: PROC [self: STREAM, char: CHAR] = { <> data: EditedViewerStreamData = NARROW[self.streamData]; IF data.readyPos = 0 OR data.ready[data.readyPos - 1] # char THEN ERROR IO.Error[$IllegalBackup, self]; data.readyPos _ data.readyPos - 1; }; EditedViewerStreamSetEcho: PROC [self: STREAM, echoTo: STREAM] = { data: EditedViewerStreamData = NARROW[self.streamData]; IF echoTo = NIL THEN RETURN; -- ignore request to turn off echoing IF data.echoStream # echoTo THEN ERROR IO.Error[$Failure, self]; <> }; EditedViewerStreamGetEcho: PROC [self: STREAM] RETURNS [STREAM] = { data: EditedViewerStreamData = NARROW[self.streamData]; RETURN [data.echoStream]; }; EditedViewerStreamReset: PROC [self: STREAM] = { data: EditedViewerStreamData = NARROW[self.streamData]; data.node _ NIL; data.buffer.length _ 0; data.ready.length _ 0; data.readyPos _ 0; self.backingStream.Reset[]; data.echoStream.Reset[]; }; <> MessageWindowStreamProcs: REF StreamProcs; CreateMessageWindowStream: PUBLIC PROC [] RETURNS [STREAM] = { RETURN[IO.CreateStream[ streamProcs: MessageWindowStreamProcs, backingStream: IO.ROS[], streamData: NIL]]; }; MessageWindowStreamFlush: PROC[self: STREAM] = { r: ROPE _ self.backingStream.RopeFromROS[close: FALSE]; i: INT _ 0; self.backingStream.Reset[]; WHILE (i _ Rope.Find[s1: r, s2: "\n", pos1: i]) # -1 DO r _ Rope.Replace[base: r, start: i, len: 1, with: " "]; ENDLOOP; MessageWindow.Append[message: r, clearFirst: TRUE] }; MessageWindowStreamReset: PROC[self: STREAM] = { self.backingStream.Reset[]; MessageWindow.Clear[] }; <> [] _ ViewerEvents.RegisterEventProc [ proc: WasAStreamViewerDestroyed, filter: $Typescript, event: $destroy]; ViewerInStreamProcs _ EditedStream.AddStreamProcs[to: IO.CreateStreamProcs[ variety: $input, class: $ViewersInput, getChar: ViewerGetChar, endOf: ViewerEndOf, charsAvail: ViewerCharsAvail, reset: ViewerReset], setEcho: ViewerSetEcho, getEcho: ViewerGetEcho]; ViewerOutStreamProcs _ IO.CreateStreamProcs[ variety: $output, class: $ViewersOutput, putChar: ViewerPutChar, flush: ViewerFlush, eraseChar: ViewerEraseChar, reset: ViewerReset]; ViewerOutPFProcs _ IOUtils.CopyPFProcs[NIL]; [] _ IOUtils.SetPFCodeProc[ViewerOutPFProcs, 'l, ViewerSetLooks]; EditedViewerStreamProcs _ EditedStream.AddStreamProcs[to: IO.CreateStreamProcs[ variety: $input, class: $EditedViewer, getChar: EditedViewerStreamGetChar, endOf: EditedViewerStreamEndOf, charsAvail: EditedViewerStreamCharsAvail, backup: EditedViewerStreamBackup, reset: EditedViewerStreamReset], setEcho: EditedViewerStreamSetEcho, getEcho: EditedViewerStreamGetEcho]; IOUtils.StoreProc[EditedViewerStreamProcs, $GetDeliverWhen, NEW[TypeOfGetDeliverWhen _ EditedViewerStreamGetDeliverWhen]]; IOUtils.StoreProc[EditedViewerStreamProcs, $SetDeliverWhen, NEW[TypeOfSetDeliverWhen _ EditedViewerStreamSetDeliverWhen]]; IOUtils.StoreProc[EditedViewerStreamProcs, $AppendBufferChars, NEW[TypeOfAppendBufferChars _ EditedViewerStreamAppendBufferChars]]; IOUtils.StoreProc[EditedViewerStreamProcs, $UnAppendBufferChars, NEW[TypeOfUnAppendBufferChars _ EditedViewerStreamUnAppendBufferChars]]; IOUtils.StoreProc[EditedViewerStreamProcs, $SetMode, NEW[TypeOfSetMode _ EditedViewerStreamSetMode]]; MessageWindowStreamProcs _ IO.CreateStreamProcs[ variety: $output, class: $MessageWindow, flush: MessageWindowStreamFlush, reset: MessageWindowStreamReset ]; END.