[View]  [Edit]  [Lock]  [References]  [Attachments]  [History]  [Home]  [Changes]  [Search]  [Help] 

VSE Stream


VSE Stream hierarchy (Stream, ReadStream, WriteStream, ReadWriteStream) has a S8 counterpart in Stream and StringStream.


Important

Class Methods
on:VSES8
    In S8 string is read-only (see String issues for more detailed info) so any operation on WriteStream (or ReadWriteStream) string based is treated as a special case of Stream called StringStream (see Streams issues for more detailed info). In order to compatibilize it is posible to add the following code:
Stream
   subclass: #WriteStream
   instanceVariableNames: ''
   classVariableNames: ''
   poolDictionaries:' CharacterConstants '
   category: #Kernel-VSECompat !

Stream
   subclass: #ReadStream
   instanceVariableNames: ''
   category: #Kernel-VSECompat !

WriteStream
   subclass: #ReadWriteStream
   instanceVariableNames: ''
   category: #Kernel-VSECompat !

! Collection methodsFor: #converting-VSECompat !
stream
	" Return the receiver from escape codes. "

	^Stream on: self! !

! String methodsFor: #converting-VSECompat !
stream
	" Return the receiver from escape codes. "

	^StringStream on: self! !

! WriteStream class methodsFor: #instantiation-VSECompat !
on: aCollection
	" Return an instance of the receiver. "

	^aCollection stream! !

! ReadStream class methodsFor: #instantiation-VSECompat !
on: aCollection
	" Return an instance of the receiver. "

	^aCollection stream! !

    COMMENTS: In VSE collection parameter is restricted to IndexedCollection. In S8 could be any Collection subclass. Also note CharacterConstants pool dictionary is used in WriteStream and must be defined previously

Instance Methods
atEndVSES8Compatible

closeVSES8Compatible

collectionVSES8Compatible

contentsVSES8Compatible

copyForm:to:VSE
    RECOMMENDATION: In order to campatibilize it is possible to add #copyForm:to: method on S8 side as follows:
! Stream methodsFor: #copying-VSECompat !
copyFrom: firstIndex to: lastIndex
   "Answer the subcollection of the collection over
   which the receiver is streaming, from firstIndex
   to lastIndex."
   ^self collection copyFrom: firstIndex to: lastIndex! !


WriteStream>>crVSE
    RECOMMENDATION: In order to campatibilize it is possible to add #cr method on S8 side as follows:
! WriteStream class methodsFor: #printing-VSECompat !
cr
   "Write the line terminating character (carriage-line-feed)
   to the receiver stream."
   self nextPut: Cr;
        nextPut: Lf! !

do:VSES8Compatible

indexOf:VSE (1)
    RECOMMENDATION: In order to campatibilize it is possible to add #indexOf: method on S8 side as follows:
! Stream methodsFor:#accessing-VSECompat !
indexOf: aCollection
   "Answer the position of the first occurrence
   of aCollection in the receiver.  If no such element
   is found, answer zero."
   | savePos index2 limit2 |
   limit2 := aCollection size.
   [self atEnd]
       whileFalse: [
           (self next) = (aCollection at: 1)
               ifTrue: [
                   savePos := self position.
                   index2 := 2.
                   [(index2 <= limit2
                       and: [self atEnd not])
                       and: [ (self next) =
                           ( aCollection at: index2 ) ] ]
                       whileTrue: [index2 := index2 + 1].
                   index2 > limit2
                       ifTrue: [^savePos]
                       ifFalse: [self position: savePos]]].
   ^0! !

isEmptyVSES8Compatible

isStreamVSE
    RECOMMENDATION: In order to campatibilize it is possible to add #isStream method on S8 side as follows:
! Stream methodsFor: #testing-VSECompat !
isStream
   "Answer true if receiver is a kind of Stream."
   ^true! !

! Object methodsFor: #testing-VSECompat !
isStream
   "Answer true if receiver is a kind of Stream."
   ^false! !

lineDelimiterVSE
    RECOMMENDATION: In order to campatibilize it is possible to add #lineDelimiter method on S8 side as follows:
! Stream methodsFor: #accesing-VSECompat !
lineDelimiter
   "Answer the default line delimiter, carriage-return."
   ^Cr! !

next:VSES8Compatible
    COMMENTS: In VSE raise an error if the next N items required by parameter is beyond of receiver end. In S8 if receiver reach the end, the returned collection has less elements.

nextChunkVSES8Compatible

nextChunkPut:VSES8Compatible

nextLineVSES8Compatible

nextWordVSE
    RECOMMENDATION: In order to campatibilize it is possible to add #nextWord method on S8 side as follows:
! Stream methodsFor: #reading-VSECompat !
nextWord
	"Answer a String containing the next word in the
    receiver stream.  A word starts with a letter,
    followed by a sequence of letters and digits."
    | first aChar |
    [self atEnd ifTrue: [^nil].
    self next isAlphaNumeric]
        whileFalse: [].  "skip separators"
    first := self position.
    [self atEnd
        ifTrue: [^self copyFrom: first to: self position].
     (aChar := self next) isAlphaNumeric]
        whileTrue: [].
    self position: self position - 1.
    ^self copyFrom: first to: self position! !


peekVSES8Compatible

peekFor:VSES8Compatible

positionVSES8Compatible

position:VSES8Compatible

resetVSES8Compatible

setToEndVSES8Compatible

sizeVSES8Compatible

skip:VSES8Compatible

skipTo:VSES8Compatible

upTo:VSES8Compatible


Secondary

Class Methods
crStringVSE

Instance Methods
asStreamVSE
backupOver:VSE
countBlanksVSE
lineDelimiter:VSE
next:put:VSE
nextIntegerVSE
nextMatchFor:VSE
nextPieceVSE
reverseContentsVSE
show:VSE



Private

asByteFileStreamCopy, fileIn, readLimit, setCollection:


TODO: (1) Revision