"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#Stream
	instanceVariableNames:''
	classVariableNames:'StreamErrorSignal PositionErrorSignal'
	poolDictionaries:''
	category:'Streams'
!

!Stream class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    An abstract class defining common behavior for all stream-like objects.
    See concrete subclasses for more detail.

    Subclasses should (at least) implement:
	#next           (if readable)
	#nextPut:       (if writable)
	#contents
	#atEnd
	#isReadable
	#isWritable

    Class variables:
	StreamErrorSignal       <Signal>        parent of all stream errors
	PositionErrorSignal     <Signal>        position attemted on a stream
						which does not support positioning
"
! !

!Stream class methodsFor:'initialization'!

initialize
    StreamErrorSignal isNil ifTrue:[
	StreamErrorSignal := ErrorSignal newSignalMayProceed:false.
	StreamErrorSignal nameClass:self message:#streamErrorSignal.
	StreamErrorSignal notifierString:'Stream error'.

	PositionErrorSignal := StreamErrorSignal newSignalMayProceed:true.
	PositionErrorSignal nameClass:self message:#positionErrorSignal.
	PositionErrorSignal notifierString:'stream as no concept of a position'.
    ]
! !

!Stream class methodsFor:'instance creation'!

new
    "report an error - Streams are created using on:-messages"

    ^ self error:'Streams cannot be created with new'
! !

!Stream class methodsFor:'Signal constants'!

positionErrorSignal
    "return the signal raised if positioning is requested for
     a stream which does not support that kind of operation"

    ^ PositionErrorSignal
!

streamErrorSignal
    "return the parent of all stream errors;
     handling this one also handles all other errors.
     Also, this one may be raised for errors not related to read/write
     operations, such as failed ioctls in externalStream etc."

    ^ StreamErrorSignal
! !

!Stream methodsFor:'accessing'!

contents
    "return the entire contents of the stream
     - we do not know here how to do it, it must be redefined in subclass"

    ^ self subclassResponsibility
! !

!Stream methodsFor:'closing'!

close
    "close the stream - nothing done here.
     Added for compatibility with external streams."

    ^ self
! !

!Stream methodsFor:'enumerating'!

do:aBlock
    "evaluate the argument, aBlock for all remaining elements,
     up to the end of the stream"

    [self atEnd] whileFalse:[
	aBlock value:(self next)
    ]

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8 9).
     s next.
     s next.
     s do:[:element | Transcript showCr:element]
    "
! !

!Stream methodsFor:'misc'!

binary
    "switch to binary mode. ignored here, but added to make
     internalStreams protocol compatible with externStreams."

! !

!Stream methodsFor:'non homogenous reading'!

nextLine
    "for compatibility with externalStreams"

    ^ self upTo:Character cr.
!

nextLongMSB:msbFlag
    "return a signed long (4 bytes) from the stream.
     The receiver must support reading of binary bytes."

    |high uval "{ Class: SmallInteger }"|

    msbFlag ifTrue:[
	"most significant first"
	high := self next.
	uval := self next bitShift:16.
	uval := uval bitOr:(self next bitShift:8).
	uval := uval bitOr:(self next).
	uval := uval bitOr:(high bitShift:24).
    ] ifFalse:[
	"least significant first"
	uval := self next.
	uval := uval bitOr:(self next bitShift:8).
	uval := uval bitOr:(self next bitShift:16).
	uval := uval bitOr:(self next bitShift:24).
    ].
    "change from unsigned 0..FFFFFFFF to signed -80000000..7FFFFFFF"

"sorry- for now, stc cannot compile LargeInteger constants 
    uval >= 16r80000000 ifTrue:[
	^ uval - 16r100000000 
    ].
the following kludges around this"
    (uval bitShift:-16) >= 16r8000 ifTrue:[
	^ uval - (16r10000000 bitShift:8)
    ].
    ^ uval
!

nextNumber:n 
    "Return the next n bytes as a positive Integer; bytes are taken msb-first."

    |s 
     val "{ Class: SmallInteger }"
     rep "{ Class: SmallInteger }"|

    "claus: this method is central in binaryStorage -
     therefore it has been tuned a bit (and needs even more tuning)"

    n == 1 ifTrue:[
	^ self next
    ].
    n == 2 ifTrue:[
	val := self next.
	val := (val bitShift:8) + self next.
	^ val
    ].
    n == 3 ifTrue:[
	val := self next.
	val := (val bitShift:8) + self next.
	val := (val bitShift:8) + self next.
	^ val
    ].
    n == 4 ifTrue:[
	val := self next.
	val <= 16r3F ifTrue:[
	    val := (val bitShift:8) + self next.
	    val := (val bitShift:8) + self next.
	    val := (val bitShift:8) + self next.
	    ^ val
	].
	"sorry, but need a largeInteger"
	s := (val bitShift:8) + self next.
	s := (s bitShift:8) + self next.
	"the multiplication below is a temporary workaround for the
	 inability of smallintegers to handle shifts out of the 32bit range ..."
	s := (s * 256) + self next.
	^ s
    ].

    "
     arbitrary long
    "
    s := 0.
    rep := n.
    rep timesRepeat:[ 
	s := s * 256 + self next
    ].
    ^ s truncated
!

nextShortMSB:msbFlag
    "return a signed short (2 bytes) from the stream.
     The receiver must support reading of binary bytes."

    |uval "{ Class: SmallInteger }"|

    msbFlag ifTrue:[
	"most significant first"
	uval := self next bitShift:8.
	uval := uval bitOr:(self next).
    ] ifFalse:[
	"least significant first"
	uval := self next.
	uval := uval bitOr:(self next bitShift:8).
    ].
    "change from unsigned 0..FFFF to signed -8000..7FFF"
    uval >= 16r8000 ifTrue:[
	^ uval - 16r10000 
    ].
    ^ uval
!

nextUnsignedLongMSB:msbFlag
    "return an unsigned long (4 bytes) from the stream.
     The receiver must support reading of binary bytes."

    |val|

    msbFlag ifTrue:[
	val := self next.
	val := (val bitShift:8) bitOr:(self next).
	val := (val bitShift:8) bitOr:(self next).
	val := (val * 256) + (self next).
	^ val
    ].
    val := self next.
    ^ (val bitShift:24)
      + (self next bitShift:16)
      + (self next bitShift:8)
      + self next
!

nextUnsignedShortMSB:msbFlag
    "return an unsigned short (2 bytes) from the stream.
     The receiver must support reading of binary bytes."

    msbFlag ifTrue:[
	^ (self next bitShift:8) bitOr:(self next)
    ].
    ^ (self next) bitOr:(self next bitShift:8)
!

nextWord
    ^ self nextAlphaNumericWord
! !

!Stream methodsFor:'non homogenous writing'!

nextLongPut:aNumber
    "for ST-80 compatibility"

    ^ self nextPutLong:aNumber MSB:true
!

nextNumber:n put:v 
    "Append to the receiver the argument, v, which is a positive Integer,
     as the next n bytes. Bytes are written msb first. 
     Possibly pad with leading zeros.
     The receiver must support writing of binary bytes."

    |vlen i|

    "claus: this method is central in binaryStorage -
     therefore it has been tuned a bit (and needs even more tuning)"

    v class == SmallInteger ifTrue:[  "- this is a hint to stc"
	n == 1 ifTrue:[
	    (v between:0 and:16rFF) ifTrue:[
		self nextPut:v.
		^ self
	    ].
	].
	n == 2 ifTrue:[
	    (v between:0 and:16rFFFF) ifTrue:[
		self nextPut:(v bitShift:-8).
		self nextPut:(v bitAnd:16rFF).
		^ self
	    ].
	].
	n == 3 ifTrue:[
	    (v between:0 and:16rFFFFFF) ifTrue:[
		self nextPut:((v bitShift:-16) bitAnd:16rFF).
		self nextPut:((v bitShift:-8) bitAnd:16rFF).
		self nextPut:(v bitAnd:16rFF).
		^ self
	    ].
	].
	n == 4 ifTrue:[
	    (v >= 0) ifTrue:[
		self nextPut:((v bitShift:-24) bitAnd:16rFF).
		self nextPut:((v bitShift:-16) bitAnd:16rFF).
		self nextPut:((v bitShift:-8) bitAnd:16rFF).
		self nextPut:(v bitAnd:16rFF).
		^ self
	    ].
	].
    ].

    "
     arbitrary long
    "
    n < (vlen := v digitLength) ifTrue: [
	"
	 the number is too big to be repesented in n bytes
	"
	self error: 'number too big'
    ].

    "pad with leading zeros"
    i := n.
    [i > vlen] whileTrue: [
	self nextPut: 0. 
	i := i - 1
    ].
    i = 1 ifTrue: [
	^ self nextPut: v
    ].
    [i > 0] whileTrue: [
	self nextPut: (v digitAt: i). 
	i := i - 1
    ]
!

nextPutLong:aNumber MSB:msbFlag
    "Write the argument, aNumber as a long (four bytes). If msbFlag is
     true, data is written most-significant byte first; otherwise least
     first. Returns the receiver on ok, nil on error.
     The receiver must support writing of binary bytes."

    msbFlag ifTrue:[
	"high word first"
	self nextShortPut:(aNumber // 16r10000) MSB:true.
	^ self nextShortPut:(aNumber \\ 16r10000) MSB:true
    ].
    "low word first"
    self nextShortPut:(aNumber \\ 16r10000) MSB:false.
    ^ self nextShortPut:(aNumber // 16r10000) MSB:false.
!

nextPutShort:aNumber MSB:msbFlag
    "Write the argument, aNumber as a short (two bytes). If msbFlag is
     true, data is written most-significant byte first; otherwise least
     first. Returns the receiver on ok, nil on error.
     The receiver must support writing of binary bytes."

    msbFlag ifTrue:[
	"most significant first"
	self nextPut:(aNumber bitShift:-8).
	^ self nextPut:(aNumber bitAnd:16rFF).
    ].
    "least significant first"
    self nextPut:(aNumber bitAnd:16rFF).
    self nextPut:(aNumber bitShift:-8).
!

nextPutWord:aNumber
    "write the argument, aNumber as a signed short (two bytes);
     write msb-first for compatibility with other smalltalks.
     The receiver must support writing of binary bytes.
     I dont know if it should be named nextPutWord: or nextWordPut:;
     one of them will vanish ..."

    ^ self nextPutShort:aNumber MSB:true
!

nextShortPut:aNumber MSB:msbFlag
    "for compatibility - this will vanish"

    ^ self nextPutShort:aNumber MSB:msbFlag
!

nextWordPut:aNumber
    "for ST-80 compatibility"

    ^ self nextPutShort:aNumber MSB:true
! !

!Stream methodsFor:'private'!

contentsSpecies
    "this should return the class of which an instance is
     returned by the #contents method. It is redefinable in subclasses"

    "return Array here - since the abstract Stream has no idea
     of the underlying collection class"

    ^ Array
! !

!Stream methodsFor:'queries'!

isBinary
    "return true, if in binary mode. Returns false here,
     to make internalStreams protocol compatible with externStreams."

    ^ false
!

isPositionable
    "return true, if the stream supports positioning (some do not)"

    ^ false
!

isReadable
    "return true, if reading is supported by the recevier.
     Assume yes here."

    ^ self subclassResponsibility
!

isStream
    "return true, if the receiver is some kind of Stream."

    ^ true
!

isWritable
    "return true, if writing is supported by the recevier.
     Assume yes here."

    ^ self subclassResponsibility
!

lineLength
    "this is just a layout hint for prettyprinting functions
     - for compatibility with TextCollectors"

    ^ 80
! !

!Stream methodsFor:'reading'!

next
    "return the next element of the stream
     - we do not know here how to do it, it must be redefined in subclass"

    ^ self subclassResponsibility
!

next:count
    "return the next count elements of the stream as a Collection."

    |answerStream 
     cnt  "{ Class: SmallInteger }" |

    answerStream := WriteStream on:(self contentsSpecies new).
    cnt := count.
    1 to:cnt do:[:index |
	answerStream nextPut:(self next)
    ].
    ^ answerStream contents

    "
     (ReadStream on:#(1 2 3 4 5)) next:3
     (ReadStream on:'hello') next:3
    "
!

nextAvailable:count
    "return the next count elements of the stream as a Collection.
     If the stream reaches the end before count elements have been read,
     return what is available. (i.e. a shorter collection)"

    |answerStream
     cnt  "{ Class: SmallInteger }"|

    answerStream := WriteStream on:(self contentsSpecies new).
    cnt := count.
    1 to:cnt do:[:index |
	self atEnd ifTrue:[
	    ^ answerStream contents
	].
	answerStream nextPut:(self next)
    ].
    ^ answerStream contents

    "
     (ReadStream on:#(1 2 3 4 5)) nextAvailable:3
     (ReadStream on:#(1 2 3 4 5)) nextAvailable:10 
     (ReadStream on:'hello') nextAvailable:3
     (ReadStream on:'hello') nextAvailable:10 
    "
!

nextMatchFor:anObject
    "read an element from the receiver, return true if it was equal to
     the argument, anObject"

    ^ (self next = anObject)

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     s nextMatchFor:2
    "
    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     s nextMatchFor:2.
     s nextMatchFor:2
    "
!

skip:count 
    "skip count objects, return the receiver"

    |n "{ Class: SmallInteger }"|

    n := count.

    "dont know how to unread ..."
    n < 0 ifTrue:[
	^ self error:'stream is not positionable'
    ].
    n timesRepeat:self next

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     s skip:4.
     s next
    "
!

skipFor:anObject
    "skip all objects up-to and including anObject; return the element after anObject."

    (self skipThrough:anObject) notNil ifTrue:[
	^ self next
    ].
    ^ nil

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     s skipFor:4.
    "
!

skipThrough:anObject
    "skip all objects up-to and including anObject. Return the receiver if
     skip was successful, otherwise (i.e. if not found) return nil.
     The next read operation will return the element after anObject."

    |nextElement|

    [self atEnd] whileFalse:[
	nextElement := self next.
	(nextElement = anObject) ifTrue: [ ^ self ]
    ].
    ^ nil

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     s skipThrough:4.
     s next
    "
!

through:anObject
    "read a collection of all objects up-to anObject and return these
     elements, including anObject. 
     The next read operation will return the element after anObject.
     Compare this with #upTo: which also reads up to some object
     and also positions behind it, but does not include it in the returned
     value."

    |answerStream element|

    answerStream := WriteStream on:(self contentsSpecies new).
    [self atEnd] whileFalse:[
	element := self next.
	answerStream nextPut:element.
	(element = anObject) ifTrue: [
	    ^ answerStream contents
	]
    ].
    ^ answerStream contents

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     Transcript showCr:(s through:4).  
     Transcript showCr:s next
    "
    "
     |s|
     s := ReadStream on:'hello world'.
     Transcript showCr:(s through:Character space).
     Transcript showCr:(s upToEnd)
    "
!

upTo:anObject
    "read a collection of all objects up-to anObject and return these
     elements, but excluding anObject. 
     The next read operation will return the element after anObject.
     Compare this with #through: which also reads up to some object
     and also positions behind it, but DOES include it in the returned
     value."

    |answerStream element|

    answerStream := WriteStream on:(self contentsSpecies new).
    [self atEnd] whileFalse:[
	element := self next.
	(element = anObject) ifTrue: [
	    ^ answerStream contents
	].
	answerStream nextPut: element.
    ].
    ^ answerStream contents

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     Transcript showCr:(s upTo:4).  
     Transcript showCr:s next

     |s|
     s := ReadStream on:'hello world'.
     Transcript showCr:(s upTo:Character space).
     Transcript showCr:(s upToEnd)

     (ReadStream on:'12345678905') upTo:$5; upTo:$5 

     (ReadStream on:'123456') upTo:$7     

     (ReadStream on:#(1 2 3 4 5 6)) upTo:4  

     (ReadStream on:'line 1
		     line 2') upTo:Character cr  

     'Makefile' asFilename readStream upTo:Character cr;upTo:Character cr  
    "
!

upToEnd
    "return a collection of the elements up-to the end.
     Return nil if the stream-end is reached before."

    |answerStream|

    answerStream := WriteStream on:(self contentsSpecies new).
    [self atEnd] whileFalse:[
	answerStream nextPut:(self next)
    ].
    ^ answerStream contents

    "
     (ReadStream on:'1234567890') upToEnd
     ('123456' readStream) next; next; upToEnd
     ('1 23456' readStream) upTo:Character space; upToEnd 
    "
! !

!Stream methodsFor:'testing'!

atEnd
    "return true if the end of the stream has been reached;
     - we do not know here how to do it, it must be redefined in subclass"

    ^ self subclassResponsibility
! !

!Stream methodsFor:'writing'!

commit
    "write out all unbuffered data - ignored here, but added
     to make internalStreams protocol compatible with externalStreams"

!

cr
    "append a carriage-return to the stream"

    self nextPut:(Character cr)
!

crTab
    "append a carriage-return followed by a tab to the stream.
     Same as crtab for ST/X backward compatibility"

    self obsoleteMethodWarning:'use crTab'.
    self crtab
!

crtab
    "append a carriage-return followed by a tab to the stream."

    self crtab:1
!

crtab:n
    "append a carriage-return followed by n tabs to the stream."

    self nextPut:(Character cr).
    self next:n put:(Character tab)
!

endEntry
    "ignored here - for compatibility with Transcript"

    ^ self
!

ff
    "append a form-feed (new-pagee) to the receiver-stream"

    self nextPut:(Character ff)
!

flush
    "write out all unbuffered data - for ST-80 compatibility"

    self commit

    "Created: 27.11.1995 / 12:00:35 / cg"
!

next:count put:anObject
    "put the argument, anObject count times onto the receiver"

    |n "{ Class: SmallInteger }"|

    n := count.
    n timesRepeat:[self nextPut:anObject].
    ^ anObject

    "
     |s|

     s := WriteStream on:#().
     s nextPut:1.
     s next:5 put:2.
     s nextPut:3.
     s contents
    "
!

nextPut:anObject
    "put the argument, anObject onto the receiver
     - we do not know here how to do it, it must be redefined in subclass"

    ^ self subclassResponsibility
!

nextPutAll:aCollection
    "put all elements of the argument, aCollection onto the receiver"

    aCollection do:[:element |
	self nextPut:element
    ].
    ^ aCollection

    "
     |s|

     s := WriteStream on:#().
     s nextPutAll:(1 to:5).
     s nextPutAll:#('one' 'two' 'three').
     s contents
    "
    "
     |s|

     s := WriteStream on:(String new).
     s nextPutAll:($a to:$f).
     s nextPutAll:'one '; 
       nextPutAll:'two ';
       nextPutAll:'three'.
     s contents
    "
!

nextPutAll:aCollection startingAt:first to:last
    "put the elements with index from first to last
     of the argument, aCollection onto the receiver"

    aCollection from:first to:last do:[:element |
	self nextPut:element
    ].
    ^ aCollection

    "
     |s|

     s := WriteStream on:#().
     s nextPutAll:#('one' 'two' 'three' 'four' 'five') startingAt:2 to:4.
     s contents
    "
!

nextPutLine:aCollection
    "put all elements of the argument, aCollection onto the receiver,
     and append a cr. This is only useful with character streams in textMode."

    self nextPutAll:aCollection.
    self cr.

    "Created: 13.12.1995 / 10:49:17 / cg"
!

print:anObject
    "append a printed representation of anObject to the receiver.
     Same as anObject printOn:self; For ST-80 compatibility."

    anObject printOn:self
!

show:aString
    "put all elements of the argument, aString onto the receiver;
     this makes streams somewhat compatible to TextCollectors and
     allows you to say: Smalltalk at:#Transcript put:Stdout"

    ^ self nextPutAll:aString printString
!

showCr:aString
    "put all elements of the argument, aString onto the receiver;
     and append a newline.
     For compatibility with TextCollectors"

    self show:aString.
    self cr
!

space
    "append a space character to the receiver-stream"

    self nextPut:(Character space)
!

spaces:count
    "append count space-characters to the receiver-stream"

    self next:count put:(Character space)
!

store:anObject
    "append a printed representation of anObject to the receiver,
     from which the receiver can be reconstructed.
     Same as anObject storeOn:self; For ST-80 compatibility."

    anObject storeOn:self
!

tab
    "append a tab-character to the stream"

    self nextPut:(Character tab)
! !

!Stream class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Stream.st,v 1.30 1995-12-13 10:27:04 cg Exp $'
! !
Stream initialize!