IOEditedStreamImpl:
CEDAR
PROGRAM
IMPORTS IO, IOUtils, RefText, Rope, RuntimeError
EXPORTS EditedStream
SHARES IO --for representation of StreamProcs
= BEGIN
STREAM: TYPE = IO.STREAM;
ROPE: TYPE = Rope.ROPE;
StreamProcs: TYPE = IO.StreamProcs;
TypeOfSetEcho: TYPE = PROC [self: STREAM, echoTo: STREAM];
TypeOfGetEcho: TYPE = PROC [self: STREAM] RETURNS [oldEcho: STREAM];
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 ← NIL];
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];
InlineLookupProc:
PROC [self:
STREAM, operation:
ATOM]
RETURNS [proc:
REF
ANY]
= INLINE {
FOR l: Atom.PropList ← self.streamProcs.propList, l.rest
UNTIL l =
NIL
DO
IF l.first.key = operation THEN RETURN[l.first.val];
ENDLOOP;
};
GetDeliverWhen:
PUBLIC
PROC [self:
STREAM]
RETURNS [proc: DeliverWhenProc, context:
REF
ANY] = {
p: REF ANY = InlineLookupProc[self, $GetDeliverWhen];
IF p #
NIL
THEN { [proc, context] ← (
NARROW[p,
REF TypeOfGetDeliverWhen])^ [self];
RETURN }
ELSE ERROR IO.Error[$NotImplementedForThisStream, self];
};
SetDeliverWhen:
PUBLIC
PROC [self:
STREAM, proc: DeliverWhenProc, context:
REF
ANY] = {
p: REF ANY = InlineLookupProc[self, $SetDeliverWhen];
IF p #
NIL
THEN { (
NARROW[p,
REF TypeOfSetDeliverWhen])^ [self, proc, context];
RETURN }
ELSE ERROR IO.Error[$NotImplementedForThisStream, self];
};
AppendBufferChars:
PUBLIC
PROC [stream:
STREAM, chars:
ROPE] = {
p: REF ANY = InlineLookupProc[stream, $AppendBufferChars];
IF p #
NIL
THEN { (
NARROW[p,
REF TypeOfAppendBufferChars])^ [stream, chars];
RETURN }
ELSE ERROR IO.Error[$NotImplementedForThisStream, stream];
};
UnAppendBufferChars:
PUBLIC
PROC [stream:
STREAM, nChars:
NAT] = {
p: REF ANY = InlineLookupProc[stream, $UnAppendBufferChars];
IF p #
NIL
THEN { (
NARROW[p,
REF TypeOfUnAppendBufferChars])^ [stream, nChars];
RETURN }
ELSE ERROR IO.Error[$NotImplementedForThisStream, stream];
};
SetMode:
PUBLIC
PROC [stream:
STREAM, stuff:
ROPE, pendingDelete:
BOOL,
echoAsterisks: BOOL] = {
p: REF ANY = InlineLookupProc[stream, $SetMode];
IF p #
NIL
THEN { (
NARROW[p,
REF TypeOfSetMode])^ [stream, stuff, pendingDelete, echoAsterisks];
RETURN }
ELSE ERROR IO.Error[$NotImplementedForThisStream, stream];
};
Edited Input Stream
EditedStreamData: TYPE = REF EditedStreamRecord;
EditedStreamRecord:
TYPE =
RECORD[
ready: REF TEXT,
readyPos: INT ← 0, -- ready[readyPos .. ready.length) are the already-activated characters
buffer: REF TEXT,
echoStream: STREAM ← NIL,
deliverWhen: DeliverWhenProc,
context: REF ANY,
echoAsterisks: BOOL ← FALSE,
pendingDelete: BOOL ← FALSE
];
EditedStreamProcs: REF StreamProcs;
IsACR:
PUBLIC DeliverWhenProc = {
RETURN [appendChar: TRUE, activate: char = IO.CR]
};
Create:
PUBLIC
PROC [in:
STREAM, echoTo:
STREAM, deliverWhen: DeliverWhenProc, context:
REF ANY]
RETURNS [STREAM] = {
h:
STREAM ← IO.CreateStream[
streamProcs: EditedStreamProcs,
streamData:
NEW[EditedStreamRecord ← [
buffer: NEW[TEXT[256]],
ready: NEW[TEXT[256]],
deliverWhen: deliverWhen, context: context]],
backingStream: in
];
SetEcho[in, NIL];
SetEcho[h, echoTo];
RETURN [h]
};
EditedStreamAppendBufferChars:
PROC [stream:
STREAM, chars:
ROPE] = {
data: EditedStreamData = NARROW[stream.streamData];
Append1:
PROC [c:
CHAR]
RETURNS [quit:
BOOL] = {
AppendBufferChar[data, c]; RETURN [quit: FALSE] };
[] ← chars.Map[action: Append1];
};
AppendBufferChar:
PROC [data: EditedStreamData, char:
CHAR] =
INLINE {
data.buffer ← RefText.InlineAppendChar[data.buffer, char];
IF data.echoStream #
NIL
THEN {
IF data.echoAsterisks AND char > IO.SP THEN data.echoStream.PutChar['*]
ELSE data.echoStream.PutChar[char];
};
};
EditedStreamUnAppendBufferChars:
PUBLIC
PROC [stream:
STREAM, nChars:
NAT] = {
data: EditedStreamData = NARROW[stream.streamData];
FOR i:
NAT
IN [0 ..
MIN[nChars, data.buffer.length])
DO
UnAppendBufferChar[data]
ENDLOOP;
};
UnAppendBufferChar:
PROC [data: EditedStreamData] =
INLINE {
IF data.echoStream #
NIL
THEN {
char: CHAR = data.buffer[data.buffer.length - 1];
IF data.echoAsterisks AND char > IO.SP THEN data.echoStream.EraseChar['*]
ELSE data.echoStream.EraseChar[char]
};
data.buffer.length ← data.buffer.length - 1;
};
EditedStreamSetMode:
PROC [stream:
STREAM, stuff:
ROPE, pendingDelete:
BOOL,
echoAsterisks: BOOL] = {
data: EditedStreamData = NARROW[stream.streamData];
data.buffer.length ← 0;
data.readyPos ← data.ready.length;
data.pendingDelete ← pendingDelete;
data.echoAsterisks ← echoAsterisks;
AppendBufferChars[stream, stuff];
};
EditedStreamGetDeliverWhen:
PROC [self:
STREAM]
RETURNS [proc: DeliverWhenProc, context:
REF ANY] = {
data: EditedStreamData = NARROW[self.streamData];
RETURN [data.deliverWhen, data.context];
};
EditedStreamSetDeliverWhen:
PROC [self:
STREAM, proc: DeliverWhenProc, context:
REF ANY] = {
data: EditedStreamData = NARROW[self.streamData];
data.deliverWhen ← proc; data.context ← context;
};
EditedStreamGetChar:
PROC [self:
STREAM]
RETURNS [char:
CHAR] = {
data: EditedStreamData = 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];
[appendChar: appendChar, activate: activate] ←
data.deliverWhen[char, data.buffer, self, data.context];
IF data.pendingDelete
THEN {
data.pendingDelete ← FALSE;
IF
NOT activate
AND appendChar
AND
NOT IsEditCommand[char]
THEN
UnAppendBufferChars[self, data.buffer.length];
};
IF appendChar
THEN {
SELECT char
FROM
Ascii.
DEL => {
ENABLE
UNWIND => data.buffer.length ← 0;
ERROR Rubout[self];
};
Ascii.ControlA, Ascii.BS => BackChar[];
Ascii.ControlW => BackWord[];
Ascii.ControlQ => BackLine[];
Ascii.
ESC =>
IF data.buffer.length = 0
THEN {
FOR i:
NAT
IN [0..data.ready.length-1)
DO
AppendBufferChar[data, data.ready[i]];
ENDLOOP
};
ENDCASE => AppendBufferChar[data, char];
};
IF activate THEN GOTO activateBuffer;
EXITS activateBuffer => {
data.ready.length ← 0;
data.ready ← RefText.Append[data.ready, data.buffer];
data.readyPos ← 0;
data.buffer.length ← 0;
data.echoAsterisks ← FALSE;
}
}
ENDLOOP;
};
EditedStreamEndOf:
PROC [self:
STREAM]
RETURNS [
BOOL] = {
data: EditedStreamData = NARROW[self.streamData];
RETURN[data.readyPos = data.ready.length AND self.backingStream.EndOf[]];
};
EditedStreamCharsAvail:
PROC [self:
STREAM, wait:
BOOL]
RETURNS [
INT] = {
data: EditedStreamData = NARROW[self.streamData];
IF data.readyPos < data.ready.length THEN RETURN [data.ready.length-data.readyPos];
RETURN[self.backingStream.CharsAvail[wait]];
};
EditedStreamBackup:
PROC [self:
STREAM, char:
CHAR] = {
looks wrong ... why can't you backup past ready chars?
data: EditedStreamData = NARROW[self.streamData];
IF data.readyPos = 0
OR data.ready[data.readyPos - 1] # char
THEN
IO.Error[$IllegalBackup, self];
data.readyPos ← data.readyPos - 1;
};
EditedStreamSetEcho:
PROC [self:
STREAM, echoTo:
STREAM] = {
data: EditedStreamData = NARROW[self.streamData];
data.echoStream ← echoTo;
};
EditedStreamGetEcho:
PROC [self:
STREAM]
RETURNS [
STREAM] = {
data: EditedStreamData = NARROW[self.streamData];
RETURN [data.echoStream];
};
EditedStreamReset:
PROC [self:
STREAM] = {
data: EditedStreamData = NARROW[self.streamData];
data.buffer.length ← 0;
data.ready.length ← 0;
data.readyPos ← 0;
self.backingStream.Reset[];
IF data.echoStream # NIL THEN data.echoStream.Reset[];
};
Default SetEcho implementation
SetEchoData: TYPE = REF SetEchoRecord;
SetEchoRecord: TYPE = RECORD [echoStream: STREAM, buffer: REF TEXT];
setEchoProcs: REF StreamProcs;
SetEcho:
PUBLIC
PROC [self:
STREAM, echoTo:
STREAM] = {
origSelf: STREAM ← self;
DO
proc: REF ANY ← InlineLookupProc[self, $SetEcho];
IF proc #
NIL
THEN {
(NARROW[proc, REF TypeOfSetEcho])^ [self, echoTo];
RETURN;
}
ELSE IF self.backingStream # NIL THEN self ← self.backingStream
ELSE EXIT;
ENDLOOP;
Default implementation: ambush the stream (it will be un-ambushed when self.SetEcho[NIL] is performed).
IF echoTo = NIL THEN RETURN;
IOUtils.AmbushStream[
self: origSelf,
streamProcs: setEchoProcs,
streamData: NEW[SetEchoRecord ← [echoStream: NIL, buffer: RefText.New[8]]]];
DefaultSetEchoSetEcho[origSelf, echoTo];
};
GetEcho:
PUBLIC
PROC [self:
STREAM]
RETURNS [oldEcho:
STREAM] = {
origSelf: STREAM ← self;
DO
proc: REF ANY ← InlineLookupProc[self, $GetEcho];
IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfGetEcho])^ [self] ]
ELSE IF self.backingStream # NIL THEN self ← self.backingStream
ELSE EXIT;
ENDLOOP;
RETURN [NIL];
};
DefaultSetEchoSetEcho:
PROC [self:
STREAM, echoTo:
STREAM] = {
data: SetEchoData = NARROW[self.streamData];
data.echoStream ← echoTo;
IF echoTo = NIL AND data.buffer.length = 0 THEN IOUtils.UnAmbushStream[self];
};
DefaultSetEchoGetEcho:
PROC [self:
STREAM]
RETURNS [oldEcho:
STREAM] = {
data: SetEchoData = NARROW[self.streamData];
RETURN[data.echoStream];
};
DefaultSetEchoBackup:
PROC [self:
STREAM, char:
CHAR] = {
To prevent backed-up chars from being echoed twice (see SetEchoGetChar below).
data: SetEchoData = NARROW[self.streamData];
data.buffer ← RefText.InlineAppendChar[data.buffer, char !
RuntimeError.BoundsFault => ERROR IO.Error[$BufferOverflow, self]];
};
DefaultSetEchoGetChar:
PROC [self:
STREAM]
RETURNS [char:
CHAR] = {
data: SetEchoData = NARROW[self.streamData];
IF data.buffer.length > 0
THEN {
data.buffer.length ← data.buffer.length - 1;
char ← data.buffer[data.buffer.length];
RETURN[char];
};
char ← self.backingStream.GetChar[];
IF data.echoStream # NIL THEN data.echoStream.PutChar[char];
};
DefaultSetEchoGetBlock:
PROC [self:
STREAM, block:
REF
TEXT, startIndex:
NAT, count:
NAT]
RETURNS [nBytesRead: NAT] = {
data: SetEchoData = NARROW[self.streamData];
nBytesRead ← 0;
WHILE data.buffer.length > 0
DO
IF count = 0 OR startIndex >= block.maxLength THEN RETURN [nBytesRead];
data.buffer.length ← data.buffer.length - 1;
block[startIndex] ← data.buffer[data.buffer.length];
startIndex ← startIndex + 1;
count ← count - 1;
nBytesRead ← nBytesRead + 1;
ENDLOOP;
nBytesRead ← nBytesRead + self.backingStream.GetBlock[block, startIndex, count];
IF data.echoStream # NIL THEN data.echoStream.PutBlock[block, startIndex, block.length-startIndex];
RETURN [nBytesRead];
};
DefaultSetEchoUnsafeGetBlock:
UNSAFE
PROC [self:
STREAM, block:
IO.UnsafeBlock]
RETURNS [nBytesRead: INT] = UNCHECKED {
data: SetEchoData = NARROW[self.streamData];
nBytesRead ← 0;
IF block.startIndex < 0 OR block.count < 0 THEN ERROR RuntimeError.BoundsFault;
WHILE data.buffer.length > 0
DO
IF block.count = 0 THEN RETURN [nBytesRead];
data.buffer.length ← data.buffer.length - 1;
block.base^[block.startIndex] ← data.buffer[data.buffer.length];
block.startIndex ← block.startIndex + 1;
block.count ← block.count - 1;
nBytesRead ← nBytesRead + 1;
ENDLOOP;
block.count ← self.backingStream.UnsafeGetBlock[block];
IF data.echoStream # NIL THEN data.echoStream.UnsafePutBlock[block];
RETURN [nBytesRead + block.count];
};
DefaultSetEchoEndOf:
PROC [self:
STREAM]
RETURNS [
BOOL] = {
data: SetEchoData = NARROW[self.streamData];
RETURN[data.buffer.length = 0 AND self.backingStream.EndOf[]];
};
DefaultSetEchoCharsAvail:
PROC [self:
STREAM, wait:
BOOL]
RETURNS [
INT] = {
data: SetEchoData = NARROW[self.streamData];
IF data.buffer.length > 0 THEN RETURN [data.buffer.length];
RETURN[self.backingStream.CharsAvail[wait]];
};
DefaultSetEchoReset:
PROC [self:
STREAM] = {
data: SetEchoData = NARROW[self.streamData];
data.buffer.length ← 0;
self.backingStream.Reset[];
};
Module Initialization
EditedStreamProcs
← AddStreamProcs[to: IO.CreateStreamProcs[
variety: $input, class: $Edited,
getChar: EditedStreamGetChar,
endOf: EditedStreamEndOf,
charsAvail: EditedStreamCharsAvail,
backup: EditedStreamBackup,
reset: EditedStreamReset],
setEcho: EditedStreamSetEcho,
getEcho: EditedStreamGetEcho];
IOUtils.StoreProc[EditedStreamProcs,
$GetDeliverWhen, NEW[TypeOfGetDeliverWhen ← EditedStreamGetDeliverWhen]];
IOUtils.StoreProc[EditedStreamProcs,
$SetDeliverWhen, NEW[TypeOfSetDeliverWhen ← EditedStreamSetDeliverWhen]];
IOUtils.StoreProc[EditedStreamProcs,
$AppendBufferChars, NEW[TypeOfAppendBufferChars ← EditedStreamAppendBufferChars]];
IOUtils.StoreProc[EditedStreamProcs,
$UnAppendBufferChars, NEW[TypeOfUnAppendBufferChars ← EditedStreamUnAppendBufferChars]];
IOUtils.StoreProc[EditedStreamProcs,
$SetMode, NEW[TypeOfSetMode ← EditedStreamSetMode]];
setEchoProcs
← AddStreamProcs[to:
IO.CreateStreamProcs[
variety: $inputOutput, class: $SetEcho,
getChar: DefaultSetEchoGetChar,
getBlock: DefaultSetEchoGetBlock,
unsafeGetBlock: DefaultSetEchoUnsafeGetBlock,
endOf: DefaultSetEchoEndOf,
charsAvail: DefaultSetEchoCharsAvail,
backup: DefaultSetEchoBackup,
reset: DefaultSetEchoReset],
setEcho: DefaultSetEchoSetEcho,
getEcho: DefaultSetEchoGetEcho];
END.