diff -r aa2498ef6470 -r a27a279701f8 PositionableStream.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/PositionableStream.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
+! !