ViewerIOImpl.mesa
-- 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.
-- Does access to data.viewer.destroyed require monitor protection?
-- 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?
Last edited by:
MBrown on December 16, 1983 4:42 pm
DIRECTORY
Ascii,
Atom,
FS USING [StreamOpen],
EditedStream,
IO,
IOClasses USING [CreateDribbleOutputStream],
IOUtils,
MessageWindow USING [Append, Clear],
RefText,
Rope,
TiogaOps USING [GetRope, GetTextKey, LastLocWithin, PutTextKey, ViewerDoc, Location, Offset, Ref],
TypeScript USING [BackSpace, CharsAvailable, ChangeLooks, Create, Flush, GetChar, PutChar, Reset, WaitUntilCharsAvail, IsATypeScript, Destroyed, TypeIn],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerIO USING [],
ViewerIOExtras USING [],
ViewerOps USING [AddProp, FetchProp];
ViewerIOImpl: CEDAR PROGRAM
IMPORTS Atom, EditedStream, FS, IO, IOClasses, IOUtils, MessageWindow, RefText, Rope, TiogaOps, TypeScript, ViewerEvents, ViewerOps
EXPORTS ViewerIO, ViewerIOExtras
= 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];
Viewer Input and Output Streams (Typescript)
Types
ViewerStreamData: TYPE = REF ViewerStreamDataRecord;
This type is used for both input and output stream; the echoStream field is ignored for output streams. A ViewerStreamDataRecord is not shared between multiple streams.
ViewerStreamDataRecord: TYPE = RECORD [
viewer: Viewer,
echoStream: STREAM ← NIL
];
ViewerInStreamProcs: REF StreamProcs;
ViewerOutStreamProcs: REF StreamProcs;
ViewerOutPFProcs: IOUtils.PFProcs;
Creation
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 {
make all streams attached to the viewer about to be destroyed attached to this undestroyed child
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;
};
Input procs
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 a split viewer is destroyed while a process is inside of a call to TypeScript.GetChar on that viewer, TypeScript.Destroyed is raised in that process. Before TypeScript.Destroyed is raised, data.viewer on any stream for this viewer will have been replaced by one of the other viewers (viewers calls WasAStreamViewerDestroyed below); hence the RETRY will call TypeScript.GetChar on another viewer. The same logic is used in ViewerCharsAvail and ViewerPutChar.
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];
IF data.viewer.destroyed THEN ERROR IO.Error[$StreamClosed, self];
IF wait THEN {
TypeScript.WaitUntilCharsAvail[data.viewer ! TypeScript.Destroyed =>
IF data.viewer.destroyed THEN ERROR IO.Error[StreamClosed, self] ELSE RETRY];
RETURN[1]
}
ELSE RETURN[IF TypeScript.CharsAvailable[data.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];
};
Output procs
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] = {
data: ViewerStreamData = NARROW[self.streamData];
TypeScript.Reset[data.viewer];
};
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;
};
Edited Viewer Input Stream (Editable Typescript)
Location: TYPE = TiogaOps.Location;
Offset: TYPE = TiogaOps.Offset;
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] = {
in is a Viewer input stream and EditedStream.GetEcho[in] = NIL.
echoTo is a Viewer output stream for the same viewer as in, or is a dribble 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 {
Called from EditedViewerStreamAppendBufferChars, EditedViewerStreamUnAppendBufferChars, EditedViewerStreamGetChar
Makes data.buffer consistent with current state of the underlying viewer
This is the only proc that tests the state of data.bufferIsConsistent
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;
data.buffer ← RefText.AppendRope[to: data.buffer, from: r, start: loc.where + 1];
};
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 {
Assumes data.buffer is consistent
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]];
What if node goes away?
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];
What if node goes away?
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 {
Assumes data.buffer is consistent
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 = {
erases last character, if any, in buffer
IF data.buffer.length > 0 THEN {
UnAppendBufferChar[data];
}
};
BackWord: PROC = {
erases last "word" (consecutive run of letters and numbers), if any, in buffer
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 = {
erases buffer back to (not including) previous CR, if any
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];
-- GetCurrentBuffer[data];
[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] = {
looks wrong ... why can't you backup past ready chars?
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];
Can't change echo stream, because "truth" about buffered characters is stored in Tioga document behind echo stream.
};
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[];
};
Message Window Stream
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[];
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[]
};
Module Initialization
[] ← ViewerEvents.RegisterEventProc [
proc: WasAStreamViewerDestroyed, filter: $Typescript, event: $destroy];
ViewerInStreamProcs ← EditedStream.AddStreamProcs[to: IO.CreateStreamProcs[
variety: $input, class: $ViewersInput,
getChar: ViewerGetChar,
endOf: ViewerEndOf,
charsAvail: ViewerCharsAvail],
setEcho: ViewerSetEcho,
getEcho: ViewerGetEcho];
ViewerOutStreamProcs ← IO.CreateStreamProcs[
variety: $output, class: $ViewersOutput,
putChar: ViewerPutChar,
flush: ViewerFlush,
eraseChar: ViewerEraseChar];
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.