--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PosStream.st Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,486 @@
+"
+ COPYRIGHT (c) 1989-93 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.
+"
+
+Stream subclass:#PositionableStream
+ instanceVariableNames:'collection position readLimit continueBlock abortBlock'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Streams'
+!
+
+PositionableStream comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+Instances of myself allow positioning the read pointer.
+I also add methods for source-chunk reading and writing
+and for filing-in/out of source code.
+
+%W% %E%
+
+TODO
+ change to use signals for error handling during fileIn
+ (get rid of continue/abort blocks)
+'!
+
+!PositionableStream class methodsFor:'constants'!
+
+chunkSeparator
+ "return the chunk-separation character"
+
+ ^ $!!
+! !
+
+!PositionableStream class methodsFor:'instance creation'!
+
+on:aCollection
+ "return a new PositionableStream streaming on aCollection"
+
+ ^ (self basicNew) on:aCollection
+!
+
+on:aCollection from:first to:last
+ "return a new PositionableStream streaming on aCollection
+ from first to last"
+
+ |newStream|
+
+ newStream := (self basicNew) on:aCollection.
+ newStream position:first.
+ newStream readLimit:last.
+ ^ newStream
+! !
+
+!PositionableStream methodsFor:'private'!
+
+on:aCollection
+ "setup for streaming on aCollection"
+
+ collection := aCollection.
+ readLimit := aCollection size.
+ position := 1
+!
+
+positionError
+ "report an error when positioning past the end"
+
+ ^ self error:'cannot position past end of collection'
+! !
+
+!PositionableStream methodsFor:'accessing'!
+
+contents
+ "return the entire contents of the stream"
+
+ ^ collection
+!
+
+peek
+ "look ahead for and return the next element"
+
+ |peekObject|
+
+ peekObject := self next.
+ self position:(self position - 1).
+ ^ peekObject
+!
+
+peekFor:something
+ "return true and move past if next == something"
+
+ self next == something ifTrue:[
+ ^ true
+ ].
+ self position:(self position - 1).
+ ^ false
+!
+
+readLimit:aNumber
+ "set the read-limit"
+
+ readLimit := aNumber
+!
+
+upTo:element
+ "return a collection of the elements up-to
+ (but excluding) the argument, element.
+ Return nil if the stream-end is reached before."
+
+ |newColl e|
+
+ newColl := collection species new.
+ e := self next.
+ [e = element] whileFalse:[
+ newColl := newColl copyWith:e.
+ e := self next.
+ self atEnd ifTrue:[^ nil]
+ ].
+ ^ newColl
+
+ "(ReadStream on:'1234567890') upTo:$5"
+ "(ReadStream on:'123456') upTo:$7"
+! !
+
+!PositionableStream methodsFor:'testing'!
+
+atEnd
+ "return true, if the read-position is at the end"
+
+ ^ position > readLimit
+!
+
+isEmpty
+ "return true, if the contents of the stream is empty"
+
+ ^ readLimit == 0
+! !
+
+!PositionableStream methodsFor:'positioning'!
+
+position
+ "return the read position"
+
+ ^ position
+!
+
+position:index
+ "set the read position"
+
+ (index > (readLimit + 1)) ifTrue: [^ self positionError].
+ position := index
+!
+
+reset
+ "set the read position to the beginning of the collection"
+
+ position := 1
+!
+
+setToEnd
+ "set the read position to the end of the collection"
+
+ position := readLimit
+!
+
+skip:numberToSkip
+ "skip the next numberToSkip elements"
+
+ self position:(position + numberToSkip)
+! !
+
+!PositionableStream methodsFor:'fileIn-Out'!
+
+skipSeparators
+ "skip all whitespace; so that next will return next non-white-space
+ element"
+
+ |nextOne|
+
+ nextOne := self peek.
+ [(nextOne notNil) and:[nextOne isSeparator]] whileTrue:[
+ self next.
+ nextOne := self peek
+ ].
+ ^ nextOne
+!
+
+skipSeparatorsExceptCR
+ "skip all whitespace except newlines;
+ next will return next non-white-space element"
+
+ |nextOne|
+
+ nextOne := self peek.
+ [(nextOne notNil) and:[nextOne isSeparator]] whileTrue:[
+ nextOne isEndOfLineCharacter ifTrue:[^ nextOne].
+ self next.
+ nextOne := self peek
+ ].
+ ^ nextOne
+!
+
+skipFor:anObject
+ "skip all objects up-to and including anObject; return the element
+ after"
+
+ |nextOne|
+
+ nextOne := self next.
+ [nextOne ~~ anObject] whileTrue:[
+ self atEnd ifTrue:[^ nil].
+ self next.
+ nextOne := self peek
+ ].
+ ^ self next
+!
+
+nextChunk
+ "return the next chunk, i.e. all characters up to the next
+ non-doubled exclamation mark; undouble doubled exclamation marks"
+
+ |theString sep newString done thisChar nextChar inPrimitive
+ index "{ Class:SmallInteger }"
+ currSize "{ Class:SmallInteger }" |
+
+ sep := self class chunkSeparator.
+ theString := String new:500.
+ currSize := 500.
+ thisChar := self skipSeparators.
+ thisChar := self next.
+ index := 0.
+ done := false.
+ inPrimitive := false.
+
+ [done] whileFalse:[
+ ((index + 2) <= currSize) ifFalse:[
+ newString := String new:(currSize * 2).
+ newString replaceFrom:1 to:currSize with:theString.
+ currSize := currSize * 2.
+ theString := newString
+ ].
+ thisChar isNil ifTrue:[
+ done := true
+ ] ifFalse:[
+ (thisChar == $% ) ifTrue:[
+ nextChar := self peek.
+ (nextChar == ${ ) ifTrue:[
+ inPrimitive := true.
+ index := index + 1.
+ theString at:index put:thisChar.
+ thisChar := self next
+ ] ifFalse:[
+ (nextChar == $} ) ifTrue:[
+ inPrimitive := false.
+ index := index + 1.
+ theString at:index put:thisChar.
+ thisChar := self next
+ ]
+ ]
+ ] ifFalse:[
+ inPrimitive ifFalse:[
+ (thisChar == sep) ifTrue:[
+ (self peek == sep) ifFalse:[
+ done := true
+ ] ifTrue:[
+ self next
+ ]
+ ]
+ ]
+ ]
+ ].
+ done ifFalse:[
+ index := index + 1.
+ theString at:index put:thisChar.
+ thisChar := self next
+ ]
+ ].
+ (index == 0) ifTrue:[^ ''].
+ ^ theString copyFrom:1 to:index
+!
+
+nextChunkPut:aString
+ "put aString as a chunk onto the receiver;
+ double all exclamation marks and append an exclamation mark"
+
+ |sep gotPercent inPrimitive character
+ index "{ Class:SmallInteger }"
+ endIndex "{ Class:SmallInteger }"
+ next "{ Class:SmallInteger }" |
+
+ sep := self class chunkSeparator.
+ inPrimitive := false.
+ gotPercent := false.
+ index := 1.
+ endIndex := aString size.
+
+ [index <= endIndex] whileTrue:[
+ next := aString indexOf:$% startingAt:index ifAbsent:[endIndex + 1].
+ next := next min:
+ (aString indexOf:${ startingAt:index ifAbsent:[endIndex + 1]).
+ next := next min:
+ (aString indexOf:$} startingAt:index ifAbsent:[endIndex + 1]).
+ next := next min:
+ (aString indexOf:sep startingAt:index ifAbsent:[endIndex + 1]).
+
+ ((index == 1) and:[next == (endIndex + 1)]) ifTrue:[
+ self nextPutAll:aString
+ ] ifFalse:[
+ self nextPutAll:(aString copyFrom:index to:(next - 1))
+ ].
+
+ index := next.
+ (index <= endIndex) ifTrue:[
+ character := aString at:index.
+ (character == $% ) ifTrue:[
+ gotPercent := true
+ ] ifFalse:[
+ (character == ${ ) ifTrue:[
+ gotPercent ifTrue:[
+ inPrimitive := true
+ ]
+ ] ifFalse:[
+ (character == $} ) ifTrue:[
+ gotPercent ifTrue:[
+ inPrimitive := false
+ ]
+ ] ifFalse:[
+ inPrimitive ifFalse:[
+ (character == sep) ifTrue:[
+ self nextPut:sep
+ ]
+ ]
+ ]
+ ].
+ gotPercent := false
+ ].
+ self nextPut:character.
+ index := index + 1
+ ]
+ ].
+ self nextPut:sep
+!
+
+fileInNextChunkNotifying:someone
+ "read next chunk, evaluate it and return the result;
+ someone is notified of errors"
+
+ |aString sawExcla sep|
+
+ sep := self class chunkSeparator.
+ self skipSeparators.
+ self atEnd ifFalse:[
+ sawExcla := self peekFor:sep.
+ aString := self nextChunk.
+ aString size ~~ 0 ifTrue:[
+ sawExcla ifFalse:[
+ ^ Compiler evaluate:aString notifying:someone
+ ].
+ ^ (Compiler evaluate:aString notifying:someone)
+ fileInFrom:self notifying:someone
+ ]
+ ].
+ ^ nil
+!
+
+fileInNextChunk
+ "read next chunk, evaluate it and return the result"
+
+ ^ self fileInNextChunkNotifying:nil
+!
+
+fileInNotifying:someone
+ "file in from the receiver, i.e. read chunks and evaluate them -
+ return the value of the last chunk; someone is notified of errors"
+
+ |lastValue|
+
+ self position:1.
+ abortBlock := [^ nil].
+ continueBlock := [].
+ Smalltalk at:#ErrorHandler put:self.
+ [self atEnd] whileFalse:[
+ lastValue := self fileInNextChunkNotifying:someone
+ ].
+ Smalltalk at:#ErrorHandler put:nil.
+ ^ lastValue
+!
+
+fileIn
+ "file in from the receiver, i.e. read chunks and evaluate them -
+ return the value of the last chunk"
+
+ ^ self fileInNotifying:self
+!
+
+askForDebug:message
+ |box|
+
+ box := OptionBox title:message numberOfOptions:3.
+ box actions:(Array with:[^ #abort]
+ with:[^ #debug]
+ with:[^ #continue]).
+ box buttonTitles:#('abort' 'debug' 'continue').
+ box showAtPointer.
+ ^ #abort
+!
+
+catch:aSymbol with:aMessage for:anObject
+ "this one is sent when an error occurs while filing in -
+ we dont want a debugger to come up but simply notify
+ the error (also on the Transcript so you have a trace of it)"
+
+ |message action|
+
+ Smalltalk at:#ErrorHandler put:nil.
+ (aSymbol == #doesNotUnderstand:) ifTrue:[
+ anObject isNil ifTrue:[
+ "try to give a bit more detail on what went wrong"
+ (Metaclass respondsTo:(aMessage selector)) ifTrue:[
+ ('subclass:*' match:(aMessage selector)) ifTrue:[
+ message := 'no superclass for ' , (aMessage arguments at:1)
+ ] ifFalse:[
+ message := 'definitions for nonexisting class'
+ ]
+ ] ifFalse:[
+ message := 'bad message: ' , aMessage selector, ' to UndefinedObject'
+ ]
+ ] ifFalse:[
+ message := 'bad message: ' , aMessage selector ,
+ ' to ' , anObject classNameWithArticle
+ ]
+ ] ifFalse:[
+ (aSymbol == #error:) ifTrue:[
+ message := aMessage
+ ] ifFalse:[
+ message := 'during fileIn'
+ ]
+ ].
+ message := 'Error: ' , message.
+ Transcript showCr:message.
+
+ YesNoBox notNil ifTrue:[
+ action := self askForDebug:message.
+ action == #debug ifTrue:[
+ Debugger enterWithMessage:message
+ ].
+ action == #continue ifTrue:[
+ continueBlock value
+ ].
+ ] ifFalse:[
+ self notify:message
+ ].
+
+ abortBlock value.
+ ^ nil
+!
+
+error:aMessage position:position to:endPos
+ "error notification during fileIn with no requestor"
+
+ position printOn:Transcript.
+ Transcript show:' '.
+ Transcript showCr:aMessage.
+ ^ false
+!
+
+correctableError:aMessage position:position to:endPos
+ "error notification during fileIn with no requestor"
+
+ ^ self error:aMessage position:position to:endPos
+!
+
+warning:aMessage position:position to:endPos
+ "warning notification during fileIn with no requestor - ignore it"
+
+ ^ self
+! !