<> DIRECTORY Atom USING [PropList, GetPropFromList, PutPropOnList], IO USING [DeliverWhenProc, GetChar, PutChar, EndOf, CharsAvail, Flush, Close, GetIndex, SetIndex, UnsafeGetBlock, UnsafePutBlock, SetEcho, Reset, SignalCode, ErrorCode, ROPE, STREAM, StreamProcs, STREAMRecord, StreamProperty, StreamPropertyRecord, UnsafeBlock, CR, NUL], IOExtras USING [], List USING [DotCons, Nconc1], Process USING [Pause, MsecToTicks], SafeStorage USING [NewZone] ; IOImpl: CEDAR PROGRAM IMPORTS IO, SafeStorage, Atom, List, Process EXPORTS IO, IOExtras SHARES IO = BEGIN OPEN IO; Zone: PUBLIC ZONE _ SafeStorage.NewZone[]; <> Signal: PUBLIC SIGNAL [ec: SignalCode, stream: STREAM] = CODE; Error: PUBLIC ERROR [ec: ErrorCode, stream: STREAM] = CODE; UserAborted: PUBLIC ERROR [abortee: REF ANY _ NIL, msg: ROPE _ NIL] = CODE; EndOfStream: PUBLIC ERROR [stream: STREAM] = CODE; <> CreateProcsStream: PUBLIC PROCEDURE[streamProcs: REF StreamProcs, streamData: REF ANY, backingStream: STREAM _ NIL] RETURNS[handle: STREAM] = { RETURN[Zone.NEW[STREAMRecord _ [streamProcs: streamProcs, streamData: streamData, backingStream: backingStream] ]]; }; -- of CreateStreamFromProcs AmbushProcsStream: PUBLIC PROCEDURE[self: STREAM, streamProcs: REF StreamProcs, streamData: REF ANY, reusing: STREAM _ NIL] = { IF reusing = NIL OR reusing = self -- to prevent circularities due to bugs -- THEN reusing _ Zone.NEW[STREAMRecord _ [streamProcs: NIL, streamData: NIL]]; reusing^ _ self^; self^ _ [streamProcs: streamProcs, streamData: streamData, propList: reusing.propList, backingStream: reusing]; }; -- of AmbushProcsStream UnAmbushProcsStream: PUBLIC PROCEDURE[self: STREAM] = { propList: Atom.PropList = self.propList; IF self.backingStream = NIL THEN RETURN; self^ _ self.backingStream^; self.propList _ propList; -- if any new properties added on while stream ambushed, they should be retained. }; -- of UnAmbushProcsStream CreateRefStreamProcs: PUBLIC PROC[ getChar: PROC[self: STREAM] RETURNS[CHARACTER] _ NIL, endOf: PROC[self: STREAM] RETURNS[BOOLEAN] _ NIL, charsAvail: PROC[self: STREAM] RETURNS[BOOLEAN] _ NIL, getBlock: PROC[self: STREAM, block: REF TEXT, startIndex: NAT, stopIndexPlusOne: NAT] RETURNS[nBytesRead: NAT] _ NIL, unsafeGetBlock: UNSAFE PROC[self: STREAM, block: UnsafeBlock] RETURNS[nBytesRead: INT] _ NIL, putChar: PROC[self: STREAM, char: CHARACTER] _ NIL, putBlock: PROC[self: STREAM, block: REF READONLY TEXT, startIndex: NAT, stopIndexPlusOne: NAT] _ NIL, unsafePutBlock: PROC[self: STREAM, block: UnsafeBlock] _ NIL, flush: PROC[self: STREAM] _ NIL, reset: PROC[self: STREAM] _ NIL, close: PROC[self: STREAM, abort: BOOLEAN _ FALSE] _ NIL, getIndex: PROC[self: STREAM] RETURNS [INT] _ NIL, setIndex: PROC[self: STREAM, index: INT] _ NIL, getLength: PROC[self: STREAM] RETURNS [length: INT] _ NIL, setLength: PROC[self: STREAM, length: INT] _ NIL, backup: PROC[self: STREAM, char: CHARACTER] _ NIL, userAbort: PROC[self: STREAM] RETURNS[abort: BOOLEAN] _ NIL, setUserAbort: PROC[self: STREAM] _ NIL, resetUserAbort: PROC[self: STREAM] _ NIL, setEcho: PROC[self: STREAM, echoTo: STREAM] RETURNS [oldEcho: STREAM] _ NIL, eraseChar: PROC[self: STREAM, char: CHARACTER] _ NIL, currentPosition: PROC[self: STREAM] RETURNS[position: INT] _ NIL, name: ROPE _ NIL ] RETURNS [REF StreamProcs] = { AddProc: SAFE PROC [operation, via: PROC ANY RETURNS ANY, procRef: REF ANY, key: ATOM] = { streamProcs.otherStreamProcs _ Zone.CONS[Zone.NEW[StreamPropertyRecord _ [operation: operation, via: via, proc: procRef, key: key]], streamProcs.otherStreamProcs] }; streamProcs: REF StreamProcs _ Zone.NEW[StreamProcs _ [ getChar: IF getChar = NIL THEN DefaultGetChar ELSE getChar, endOf: IF endOf = NIL THEN DefaultEndOf ELSE endOf, charsAvail: IF charsAvail = NIL THEN DefaultCharsAvail ELSE charsAvail, getBlock: IF getBlock = NIL THEN DefaultGetBlock ELSE getBlock, unsafeGetBlock: IF unsafeGetBlock = NIL THEN DefaultUnsafeGetBlock ELSE unsafeGetBlock, putChar: IF putChar = NIL THEN DefaultPutChar ELSE putChar, putBlock: IF putBlock = NIL THEN DefaultPutBlock ELSE putBlock, unsafePutBlock: IF unsafePutBlock = NIL THEN DefaultUnsafePutBlock ELSE unsafePutBlock, flush: IF flush = NIL THEN DefaultFlush ELSE flush, reset: IF reset = NIL THEN DefaultReset ELSE reset, close: IF close = NIL THEN DefaultClose ELSE close, getIndex: IF getIndex = NIL THEN DefaultGetIndex ELSE getIndex, setIndex: IF setIndex = NIL THEN DefaultSetIndex ELSE setIndex, name: IF name = NIL THEN "Anonymous" ELSE name ]] ; IF getLength # NIL THEN AddProc[operation: GetLength, via: getLength, procRef: Zone.NEW[TypeOfGetLength _ getLength], key: $GetLength]; IF setLength # NIL THEN AddProc[operation: SetLength, via: setLength, procRef: Zone.NEW[TypeOfSetLength _ setLength], key: $SetLength]; IF backup # NIL THEN AddProc[operation: Backup, via: backup, procRef: Zone.NEW[TypeOfBackup _ backup], key: $Backup]; IF userAbort # NIL THEN AddProc[operation: UserAbort, via: userAbort, procRef: Zone.NEW[TypeOfUserAbort _ userAbort], key: $UserAbort]; IF setUserAbort # NIL THEN AddProc[operation: SetUserAbort, via: setUserAbort, procRef: Zone.NEW[TypeOfSetUserAbort _ setUserAbort], key: $SetUserAbort]; IF resetUserAbort # NIL THEN AddProc[operation: ResetUserAbort, via: resetUserAbort, procRef: Zone.NEW[TypeOfResetUserAbort _ resetUserAbort], key: $ResetUserAbort]; IF setEcho # NIL THEN AddProc[operation: SetEcho, via: setEcho, procRef: Zone.NEW[TypeOfSetEcho _ setEcho], key: $SetEcho]; IF eraseChar # NIL THEN AddProc[operation: EraseChar, via: eraseChar, procRef: Zone.NEW[TypeOfEraseChar _ eraseChar], key: $EraseChar]; IF currentPosition # NIL THEN AddProc[operation: CurrentPosition, via: currentPosition, procRef: Zone.NEW[TypeOfCurrentPosition _ currentPosition], key: $CurrentPosition]; RETURN[streamProcs]; }; -- of CreateRefStreamProcs TypeOfBackup, TypeOfEraseChar: TYPE = PROC[self: STREAM, char: CHARACTER]; TypeOfSetEcho: TYPE = PROCEDURE[self: STREAM, echoTo: STREAM] RETURNS[oldEcho: STREAM]; TypeOfGetLength: TYPE = PROC[self: STREAM] RETURNS[length: INT]; TypeOfSetLength: TYPE = PROC[self: STREAM, length: INT]; TypeOfCurrentPosition: TYPE = PROC [self: STREAM] RETURNS[position: INT]; TypeOfUserAbort: TYPE = PROC [self: STREAM] RETURNS[abort: BOOL]; TypeOfSetUserAbort, TypeOfResetUserAbort, TypeOfWaitUntilCharsAvail: TYPE = PROC[self: STREAM]; TypeOfChangeDeliverWhen: TYPE = PROC [self: STREAM, proc: DeliverWhenProc] RETURNS[oldProc: DeliverWhenProc]; TypeOfGetBufferContents: TYPE = PROC [self: STREAM] RETURNS[buffer: ROPE]; <> DefaultGetChar: PROC [self: STREAM] RETURNS[CHARACTER] = { IF self.backingStream # NIL THEN RETURN[GetChar[self.backingStream]] ELSE ERROR Error[NotImplementedForThisStream, self]; }; DefaultPutChar: PROC[self: STREAM, char: CHARACTER] = { IF self.backingStream # NIL THEN PutChar[self.backingStream, char] ELSE SIGNAL Signal[NotImplementedForThisStream, self]; }; DefaultEndOf: PROC [self: STREAM] RETURNS[BOOLEAN] = { IF self.backingStream # NIL THEN RETURN[EndOf[self.backingStream]] ELSE ERROR Error[NotImplementedForThisStream, self]; }; DefaultCharsAvail: PROC [self: STREAM] RETURNS[BOOLEAN] = { IF self.streamProcs.endOf # DefaultEndOf THEN RETURN[~self.streamProcs.endOf[self]] ELSE IF self.backingStream # NIL THEN RETURN[CharsAvail[self.backingStream]] ELSE ERROR Error[NotImplementedForThisStream, self]; }; DefaultReset: PROC[self: STREAM] = { IF self.backingStream # NIL THEN Reset[self.backingStream]; }; DefaultClose: PROC [self: STREAM, abort: BOOLEAN _ FALSE] = { IF abort THEN Reset[self] ELSE Flush[self]; IF self.backingStream # NIL THEN Close[self.backingStream, abort]; }; DefaultFlush: PROC[self: STREAM] = { IF self.backingStream # NIL THEN Flush[self.backingStream]; }; DefaultGetIndex: PROC[self: STREAM] RETURNS [index: INT] = { IF self.backingStream # NIL THEN RETURN[GetIndex[self.backingStream]] ELSE ERROR Error[NotImplementedForThisStream, self]; }; DefaultSetIndex: PROC[self: STREAM, index: INT] = { IF self.backingStream # NIL THEN SetIndex[self.backingStream, index] ELSE SIGNAL Signal[NotImplementedForThisStream, self]; }; DefaultGetBlock: PROC[self: STREAM, block: REF TEXT, startIndex: NAT, stopIndexPlusOne: NAT] RETURNS[nBytesRead: NAT] = { <> <> end: NAT _ MIN[block.maxLength, stopIndexPlusOne]; FOR i: NAT IN [startIndex..end) DO IF EndOf[self] THEN RETURN[i - startIndex]; block[i] _ GetChar[self]; ENDLOOP; RETURN[end - startIndex]; <<};>> }; DefaultPutBlock: PROC[self: STREAM, block: REF READONLY TEXT, startIndex: NAT, stopIndexPlusOne: NAT] = { <> <> IF block # NIL THEN { end: NAT _ MIN[block.length, stopIndexPlusOne]; FOR i: NAT IN [startIndex..end) DO PutChar[self, block[i]]; ENDLOOP; }; }; DefaultUnsafeGetBlock: UNSAFE PROC[self: STREAM, block: UnsafeBlock] RETURNS[nBytesRead: INT] = UNCHECKED { IF self.backingStream # NIL THEN RETURN[UnsafeGetBlock[self.backingStream, block]] ELSE ERROR Error[NotImplementedForThisStream, self]; }; DefaultUnsafePutBlock: PROC[self: STREAM, block: UnsafeBlock] = { IF self.backingStream # NIL THEN UnsafePutBlock[self.backingStream, block] ELSE Signal[NotImplementedForThisStream, self]; }; <> <> LookupProc: PUBLIC PROC [self: STREAM, operation: PROC ANY RETURNS ANY] RETURNS[proc: REF ANY] = { RETURN[InlineLookupProc[self, operation]]; }; InlineLookupProc: PROC [self: STREAM, operation: PROC ANY RETURNS ANY] RETURNS[proc: REF ANY] = INLINE {FOR l: LIST OF StreamProperty _ self.streamProcs.otherStreamProcs, l.rest UNTIL l = NIL DO IF l.first.operation = operation THEN RETURN[l.first.proc]; ENDLOOP; }; <<>> <> UncheckedImplements: PUBLIC PROC [self: STREAM _ NIL, operation, via: PROC ANY RETURNS ANY, data: REF ANY _ NIL, procRef: REF ANY, key: ATOM] = { streamProcs: REF StreamProcs _ self.streamProcs; FOR l: LIST OF StreamProperty _ streamProcs.otherStreamProcs, l.rest UNTIL l = NIL DO IF l.first.operation = operation AND l.first.via = via THEN {key _ l.first.key; EXIT}; REPEAT FINISHED => -- not there {streamProcs.otherStreamProcs _ Zone.CONS[Zone.NEW[StreamPropertyRecord _ [operation: operation, via: via, proc: procRef, key: key]], streamProcs.otherStreamProcs] }; ENDLOOP; }; -- of UncheckedImplements <> LookupData: PUBLIC PROC [self: STREAM, key: ATOM] RETURNS [REF ANY _ NIL] = { RETURN[Atom.GetPropFromList[self.propList, key]]; }; StoreData: PUBLIC PROC [self: STREAM, key: ATOM, data: REF ANY] = {self.propList _ Atom.PutPropOnList[self.propList, key, data]}; AddData: PUBLIC PROC [self: STREAM, key: ATOM, data: REF ANY] = { self.propList _ CONS[List.DotCons[key, data], self.propList]; }; RemoveData: PUBLIC PROC [self: STREAM, key: ATOM] = { propList: Atom.PropList _ self.propList; IF propList = NIL THEN RETURN ELSE IF propList.first.key = key THEN self.propList _ self.propList.rest ELSE FOR l: Atom.PropList _ propList, l.rest UNTIL l.rest = NIL DO IF l.rest.first.key = key THEN {l.rest _ l.rest.rest; EXIT}; ENDLOOP; }; <> <> GetLength: PUBLIC PROC[self: STREAM] RETURNS [length: INT] = { DO proc: REF ANY _ InlineLookupProc[self, GetLength]; IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfGetLength])^ [self] ] ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE ERROR Error[NotImplementedForThisStream, self]; ENDLOOP; }; -- of GetLength SetLength: PUBLIC PROC[self: STREAM, length: INT] = { DO proc: REF ANY _ InlineLookupProc[self, SetLength]; IF proc # NIL THEN {(NARROW[proc, REF TypeOfSetLength ])^ [self, length]; RETURN} ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE SIGNAL Signal[NotImplementedForThisStream, self]; ENDLOOP; }; -- of SetLength UserAbort: PUBLIC PROC[self: STREAM] RETURNS [abort: BOOL] = { DO proc: REF ANY _ InlineLookupProc[self, UserAbort]; IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfUserAbort])^ [self] ] ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE RETURN[FALSE]; ENDLOOP; }; -- of UserAbort SetUserAbort: PUBLIC PROC[self: STREAM] = { DO proc: REF ANY _ InlineLookupProc[self, SetUserAbort]; IF proc # NIL THEN {(NARROW[proc, REF TypeOfSetUserAbort])^ [self]; RETURN} ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE SIGNAL Signal[NotImplementedForThisStream, self]; ENDLOOP; }; -- of SetUserAbort ResetUserAbort: PUBLIC PROC[self: STREAM] = { DO proc: REF ANY _ InlineLookupProc[self, ResetUserAbort]; IF proc # NIL THEN {(NARROW[proc, REF TypeOfResetUserAbort])^ [self] ; RETURN} ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE RETURN; ENDLOOP; }; -- of ResetUserAbort Backup: PUBLIC PROC [self: STREAM, char: CHARACTER] = { origSelf: STREAM _ self; DO proc: REF ANY _ InlineLookupProc[self, Backup]; IF proc # NIL THEN {(NARROW[proc, REF TypeOfBackup ])^ [self, char]; RETURN} <> ELSE EXIT; ENDLOOP; UncheckedImplements[self: origSelf, operation: Backup, via: XBackup, procRef: Zone.NEW[TypeOfBackup _ XBackup], key: $Backup]; <> XBackup[origSelf, char]; -- will add data field. Reason can't be taken care of in call to UncheckedImplements is that UncheckedImplements only called once for the stream class, because subsequently, XPutBAck will be found in the otherStreamProcs slot. However, the data has to be added for each stream instance. }; -- of Backup BackupData: TYPE = REF BackupRecord; BackupRecord: TYPE = RECORD[reuse: STREAM _ NIL, char: CHARACTER]; backupProcs: REF StreamProcs _ CreateRefStreamProcs[ getChar: BackupGetChar, getBlock: BackupGetBlock, endOf: BackupEndOf, charsAvail: BackupCharsAvail, reset: BackupReset, <> backup: AlreadyBackedUp, name: "Backed Up" ]; AlreadyBackedUp: PROC [self: STREAM, char: CHARACTER] = { ERROR Error[IllegalBackup, self]; }; -- of AlreadyBackedUp XBackup: PROC [self: STREAM, char: CHARACTER] = { data: BackupData _ NARROW[LookupData[self, $Backup]]; IF self.streamProcs = backupProcs THEN ERROR Error[IllegalBackup, self]; IF data = NIL THEN -- first time for this particular stream. {data _ Zone.NEW[BackupRecord _ [reuse: CreateProcsStream[NIL, NIL], char: char]]; StoreData[self: self, key: $Backup, data: data]} ELSE IF data.reuse = self THEN ERROR Error[IllegalBackup, self] -- can occur if user explicitly tries to do a backup on the backingstream ELSE data.char _ char; -- data is in the streamData slot when stream is backed up. during the period when this stream is not in a backed up state, data remains on property list so it does not have to be reallocated for each putback. AmbushProcsStream[self: self, streamProcs: backupProcs, streamData: data, reusing: data.reuse]; }; -- of XBackup BackupGetChar: PROCEDURE [self: STREAM] RETURNS [char: CHARACTER] = { data: BackupData _ NARROW[self.streamData]; char _ data.char; IF self.streamProcs = backupProcs THEN UnAmbushProcsStream[self] ELSE ERROR; -- SHOULDNT HAPPEN. }; -- of BackupGetChar BackupGetBlock: PROC[self: STREAM, block: REF TEXT, startIndex: NAT, stopIndexPlusOne: NAT] RETURNS[nBytesRead: NAT] = { data: BackupData _ NARROW[self.streamData]; end: NAT _ MIN[stopIndexPlusOne, block.maxLength]; block[startIndex] _ data.char; IF self.streamProcs = backupProcs THEN UnAmbushProcsStream[self] ELSE ERROR; -- SHOULDNT HAPPEN FOR i: NAT IN [startIndex+1..stopIndexPlusOne) DO IF self.EndOf[] THEN RETURN[i - startIndex]; block[i] _ self.GetChar[]; ENDLOOP; RETURN[stopIndexPlusOne - startIndex]; }; -- of BackupGetBlock BackupEndOf: PROCEDURE[self: STREAM] RETURNS [BOOLEAN] = { RETURN[FALSE]; }; -- of BackupEndOf BackupCharsAvail: PROCEDURE[self: STREAM] RETURNS [BOOLEAN] = { RETURN[TRUE]; }; -- of BackupCharsAvail BackupReset: PROCEDURE[self: STREAM] = { UnAmbushProcsStream[self]; }; -- of BackupReset AppendStreams: PUBLIC PROC [in: STREAM, from: STREAM, appendToSource: BOOLEAN _ TRUE] = { origSelf: STREAM _ in; IF from = NIL OR NOT from.CharsAvail[] THEN RETURN; DO proc: REF ANY; IF appendToSource AND in.backingStream # NIL THEN {in _ origSelf _ in.backingStream; LOOP}; proc _ InlineLookupProc[in, AppendStreams]; IF proc # NIL THEN {(NARROW[proc, REF PROC[in: STREAM, from: STREAM, appendToSource: BOOLEAN _ TRUE] ])^ [in, from]; RETURN} ELSE IF in.backingStream # NIL THEN in _ in.backingStream ELSE EXIT; ENDLOOP; UncheckedImplements[self: origSelf, operation: AppendStreams, via: XAppendStreams, procRef: Zone.NEW[PROC[in: STREAM, from: STREAM, appendToSource: BOOLEAN _ TRUE] _ XAppendStreams], key: $AppendStreams]; <> <> XAppendStreams[in, from, FALSE]; -- will add data field, ambush procs. Reason can't be taken care of in call to UncheckedImplements is that UncheckedImplements only called once for the stream class, and the data has to be added for each stream instance. i.e. the procedure XAppendStreams will stay around, and this code will not be executed again. }; -- of AppendStreams AppendStreamsData: TYPE = REF AppendStreamsRecord; AppendStreamsRecord: TYPE = RECORD[reuse: STREAM _ NIL, from: LIST OF STREAM]; appendStreamsProcs: REF StreamProcs _ CreateRefStreamProcs[ getChar: AppendStreamsGetChar, getBlock: AppendStreamsGetBlock, endOf: AppendStreamsEndOf, charsAvail: AppendStreamsCharsAvail, reset: AppendStreamsReset <> ]; XAppendStreams: PROC [in: STREAM, from: STREAM, appendToSource: BOOLEAN _ TRUE] = TRUSTED -- LOOPHOLE, polymorphism -- { data: AppendStreamsData _ NARROW[LookupData[in, $AppendStreams]]; <> IF data = NIL THEN -- first time for this particular stream. {data _ Zone.NEW[AppendStreamsRecord _ [reuse: CreateProcsStream[NIL, NIL], from: LIST[from]]]; StoreData[self: in, key: $AppendStreams, data: data]; } ELSE IF data.from = NIL THEN data.from _ LIST[from] -- stream no longer in append mode. ELSE {data.from _ LOOPHOLE[List.Nconc1[LOOPHOLE[data.from, LIST OF REF ANY], from], LIST OF STREAM]; RETURN; -- data points to a stream higher up on food chain which already has procs set up. }; IF in.streamProcs = appendStreamsProcs THEN ERROR; AmbushProcsStream[self: in, streamProcs: appendStreamsProcs, streamData: data, reusing: data.reuse]; }; -- of XAppendStreams AppendStreamsGetChar: PROCEDURE [self: STREAM] RETURNS [char: CHARACTER] = { data: AppendStreamsData _ NARROW[self.streamData]; FOR lst: LIST OF STREAM _ data.from, lst.rest UNTIL lst = NIL DO data.from _ lst; IF lst.first.CharsAvail[] THEN RETURN[lst.first.GetChar[]]; ENDLOOP; data.from _ NIL; IF self.streamProcs = appendStreamsProcs THEN UnAmbushProcsStream[self] ELSE ERROR; -- SHOULDNT HAPPEN RETURN[self.GetChar[]]; }; -- of AppendStreamsGetChar AppendStreamsGetBlock: PROC[self: STREAM, block: REF TEXT, startIndex: NAT, stopIndexPlusOne: NAT] RETURNS[nBytesRead: NAT] = { data: AppendStreamsData _ NARROW[self.streamData]; end: NAT _ MIN[stopIndexPlusOne, block.maxLength]; IF self.streamProcs = appendStreamsProcs THEN UnAmbushProcsStream[self] ELSE ERROR; -- SHOULDNT HAPPEN FOR i: NAT IN [startIndex..stopIndexPlusOne) DO IF self.EndOf[] THEN RETURN[i - startIndex]; block[i] _ self.GetChar[]; ENDLOOP; RETURN[stopIndexPlusOne - startIndex]; }; -- of AppendStreamsGetBlock AppendStreamsEndOf: PROCEDURE[self: STREAM] RETURNS [BOOLEAN] = { data: AppendStreamsData _ NARROW[self.streamData]; FOR lst: LIST OF STREAM _ data.from, lst.rest UNTIL lst = NIL DO data.from _ lst; IF lst.first.CharsAvail[] THEN RETURN[FALSE]; ENDLOOP; <> data.from _ NIL; IF self.streamProcs = appendStreamsProcs THEN UnAmbushProcsStream[self] ELSE ERROR; -- SHOULDNT HAPPEN RETURN[self.EndOf[]]; }; -- of AppendStreamsEndOf AppendStreamsCharsAvail: PROCEDURE[self: STREAM] RETURNS [BOOLEAN] = { data: AppendStreamsData _ NARROW[self.streamData]; FOR lst: LIST OF STREAM _ data.from, lst.rest UNTIL lst = NIL DO data.from _ lst; IF lst.first.CharsAvail[] THEN RETURN[TRUE]; ENDLOOP; <> data.from _ NIL; IF self.streamProcs = appendStreamsProcs THEN UnAmbushProcsStream[self] ELSE ERROR; -- SHOULDNT HAPPEN RETURN[self.CharsAvail[]]; }; -- of AppendStreamsCharsAvail AppendStreamsReset: PROCEDURE[self: STREAM] = { data: AppendStreamsData _ NARROW[self.streamData]; data.from _ NIL; UnAmbushProcsStream[self]; }; -- of AppendStreamsReset SetEcho: PUBLIC PROC [self: STREAM, echoTo: STREAM] RETURNS [oldEcho: STREAM] = { origSelf: STREAM _ self; DO proc: REF ANY _ InlineLookupProc[self, SetEcho]; IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfSetEcho])^ [self, echoTo] ] ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE EXIT; ENDLOOP; <> AmbushProcsStream[self: origSelf, streamProcs: setEchoProcs, streamData: NEW[SetEchoRecord _ [echoTo: NIL]]]; -- set echo never restores the procs, so the setEchoProcs will always be in line somewhere, if not in the streamprocs themselves, then nested. RETURN[origSelf.SetEcho[echoTo]]; }; -- of SetEcho SetEchoData: TYPE = REF SetEchoRecord; SetEchoRecord: TYPE = RECORD[echoTo: STREAM, singleFlg: BOOLEAN _ FALSE, char: CHARACTER _ NUL]; setEchoProcs: REF StreamProcs _ CreateRefStreamProcs[ getChar: SetEchoGetChar, getBlock: SetEchoGetBlock, endOf: SetEchoEndOf, charsAvail: SetEchoCharsAvail, reset: SetEchoReset, setEcho: XSetEcho, backup: SetEchoBackup -- if dont handle backup explicitly, the character putback would be echoed twice. <> ]; XSetEcho: PROC [self: STREAM, echoTo: STREAM] RETURNS [oldEcho: STREAM] = { data: SetEchoData _ NARROW[self.streamData]; oldEcho _ data.echoTo; data.echoTo _ echoTo; }; -- of XSetEcho SetEchoBackup: PROC [self: STREAM, char: CHARACTER] = { data: SetEchoData _ NARROW[self.streamData]; data.singleFlg _ TRUE; data.char _ char; }; -- of SetEchoBackup SetEchoGetChar: PROCEDURE [self: STREAM] RETURNS [char: CHARACTER] = { data: SetEchoData _ NARROW[self.streamData]; IF data.singleFlg THEN {data.singleFlg _ FALSE; RETURN[data.char]}; char _ self.backingStream.GetChar[]; IF data.echoTo # NIL THEN data.echoTo.PutChar[char]; }; -- of SetEchoGetChar SetEchoGetBlock: PROC[self: STREAM, block: REF TEXT, startIndex: NAT, stopIndexPlusOne: NAT] RETURNS[nBytesRead: NAT] = { data: SetEchoData _ NARROW[self.streamData]; end: NAT _ MIN[stopIndexPlusOne, block.maxLength]; FOR i: NAT IN [startIndex..stopIndexPlusOne) DO IF self.EndOf[] THEN RETURN[i - startIndex]; block[i] _ self.GetChar[]; -- getChar will do the echoing. ENDLOOP; RETURN[stopIndexPlusOne - startIndex]; }; -- of SetEchoGetBlock SetEchoEndOf: PROCEDURE[self: STREAM] RETURNS [BOOLEAN] = { data: SetEchoData _ NARROW[self.streamData]; RETURN[~data.singleFlg AND self.backingStream.EndOf[]]; }; -- of SetEchoEndOf SetEchoCharsAvail: PROCEDURE[self: STREAM] RETURNS [BOOLEAN] = { RETURN[~self.EndOf[]]; }; -- of SetEchoCharsAvail SetEchoReset: PROCEDURE[self: STREAM] = { data: SetEchoData _ NARROW[self.streamData]; data.singleFlg _ FALSE; self.backingStream.Reset[]; }; -- of SetEchoReset EraseChar: PUBLIC PROC [self: STREAM, char: CHARACTER] = { DO proc: REF ANY _ InlineLookupProc[self, EraseChar]; IF proc # NIL THEN {(NARROW[proc, REF TypeOfEraseChar])^ [self, char]; RETURN} ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE {self.PutChar['\\]; self.PutChar[char]; RETURN}; ENDLOOP; }; -- of EraseChar ChangeDeliverWhen: PUBLIC PROC [self: STREAM, proc: DeliverWhenProc] RETURNS [oldProc: DeliverWhenProc] = { DO ref: REF ANY _ InlineLookupProc[self, ChangeDeliverWhen]; IF ref # NIL THEN RETURN[(NARROW[ref, REF TypeOfChangeDeliverWhen])^ [self, proc] ] ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE SIGNAL Signal[NotImplementedForThisStream, self]; ENDLOOP; }; -- of ChangeDeliverWhen GetBufferContents: PUBLIC PROC [self: STREAM] RETURNS[buffer: ROPE] = { DO proc: REF ANY _ InlineLookupProc[self, GetBufferContents]; IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfGetBufferContents])^ [self] ] ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE SIGNAL Signal[NotImplementedForThisStream, self]; ENDLOOP; }; -- of GetBufferContents WaitUntilCharsAvail: PUBLIC PROC [self: STREAM] = { DO proc: REF ANY _ InlineLookupProc[self, WaitUntilCharsAvail]; IF self.CharsAvail[] THEN RETURN ELSE IF proc # NIL THEN {(NARROW[proc, REF TypeOfWaitUntilCharsAvail])^ [self] ; RETURN} ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE TRUSTED { UNTIL self.CharsAvail[] DO Process.Pause[Process.MsecToTicks[100]]; ENDLOOP; EXIT; }; ENDLOOP; }; -- of WaitUntilCharsAvail CurrentPosition: PUBLIC PROC [self: STREAM] RETURNS[position: INT] = { origSelf: STREAM _ self; DO proc: REF ANY _ InlineLookupProc[self, CurrentPosition]; IF proc # NIL THEN RETURN[(NARROW[proc, REF TypeOfCurrentPosition])^ [self] ] ELSE IF self.backingStream # NIL THEN self _ self.backingStream ELSE EXIT; ENDLOOP; <> UncheckedImplements[self: origSelf, operation: CurrentPosition, via: XPosition, procRef: Zone.NEW[TypeOfCurrentPosition _ XPosition], key: $CurrentPosition]; RETURN[XPosition[self]]; -- will add data field. Reason can't be taken care of in call to UncheckedImplements is that UncheckedImplements only called once for the stream class, and the data has to be added for each stream instance. i.e. the procedure XPosition will stay around, and this code will not be executed again. }; -- of CurrentPosition PositionData: TYPE = REF PositionRecord; PositionRecord: TYPE = RECORD[ putChar: PROCEDURE [self: STREAM, char: CHARACTER], putBlock: PROC[self: STREAM, block: REF READONLY TEXT, startIndex: NAT, stopIndexPlusOne: NAT], count: INT _ 0 ]; XPosition: PROC [self: STREAM] RETURNS[position: INT] = { data: PositionData _ NARROW[LookupData[self, $CurrentPosition]]; IF data = NIL THEN {StoreData[self: self, key: $CurrentPosition, data: Zone.NEW[PositionRecord _ [putChar: self.streamProcs.putChar, putBlock: self.streamProcs.putBlock]]]; -- first time for this particular stream. self.streamProcs _ Zone.NEW[StreamProcs _ self.streamProcs^]; self.streamProcs.putChar _ PositionPutChar; self.streamProcs.putBlock _ PositionPutBlock; RETURN[0]}; RETURN[data.count]; }; -- of XPosition PositionPutChar: PROC [self: STREAM, char: CHARACTER] = { data: PositionData _ NARROW[LookupData[self, $CurrentPosition]]; IF char = CR THEN data.count _ 0 ELSE data.count _ data.count + 1; data.putChar[self, char]; }; -- of PositionPutChar PositionPutBlock: PROC [self: STREAM, block: REF READONLY TEXT, startIndex: NAT, stopIndexPlusOne: NAT] = { data: PositionData _ NARROW[LookupData[self, $CurrentPosition]]; end: NAT; count: INT _ data.count; IF block = NIL THEN RETURN; end _ MIN[stopIndexPlusOne, block.length]; FOR i: NAT IN [startIndex..end) DO IF block[i] = CR THEN count _ 0 ELSE count _ count + 1; ENDLOOP; data.putBlock[self, block, startIndex, stopIndexPlusOne]; data.count _ count; -- data.putBlock might be the default putblock which calls putChar which would count all of the characters twice. }; -- of PositionPutBlock SpaceTo: PUBLIC PROCEDURE [self: STREAM, n: INT, nextLine: BOOLEAN _ TRUE] = { current: INT _ CurrentPosition[self]; IF current > n THEN {IF NOT nextLine THEN RETURN; self.PutChar['\n]; current _ 0 }; WHILE current < n DO self.PutChar[' ]; current _ current + 1; ENDLOOP; }; -- of SpaceTo END. 12-Mar-82 13:39:42 fixed bug in PositionPutBlock which caused characters to be counted twice. 8-Apr-82 16:11:31 deimplemented default confirm that was using cursor and userinput. Now gives error if no confirm implemented. 26-Apr-82 14:41:13 fixed appendstreams CharsAvail and Endof to check and see if last character had been read and if so, to deambush and go to backingstream, rather than the way it used to work, which was not to deambush until next getchar. September 1, 1982 10:20 pm changed CreateRefStreamProcs to take setUserAbort and resetUserAbort as arguments. Defined SetUserAbort and ResetUserAbort October 1, 1982 1:09 pm changed default of close to call flush or reset before nop. <<>> <> <> <> <> <> <> <> <<>> <<>> <> <> <<>>