"

 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.

"

Stream subclass:#PositionableStream

       instanceVariableNames:'collection position readLimit'

       classVariableNames:'ErrorDuringFileInSignal'

       poolDictionaries:''

       category:'Streams'

!

PositionableStream comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

              All Rights Reserved

Instances of PositionableStream allow positioning the read pointer.

PositionableStream also adds methods for source-chunk reading and writing

and for filing-in/out of source code.

This is an abstract class.

'!

!PositionableStream class methodsFor:'initialization'!

initialize

    ErrorDuringFileInSignal isNil ifTrue:[

        ErrorDuringFileInSignal := (Signal new) mayProceed:true.

        ErrorDuringFileInSignal notifierString:'error during fileIn'.

    ]

! !

!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 backStep.

    ^ peekObject

!

peekFor:something

    "return true and move past if next == something; 

     otherwise stay and let position unchanged"

    self next == something ifTrue:[

        ^ true

    ].

    self backStep.

    ^ 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"

!

upToEnd

    "return a collection of the elements up-to the end

     Return nil if the stream-end is reached before."

    |newColl|

    "this implementation has stupid (o-square) runtime behavior -

     should I add a query for resizability if collections and use

     add: instead ?"

    newColl := collection species new.

    [self atEnd] whileFalse:[

        newColl := newColl copyWith:(self next).

    ].

    ^ newColl

    "(ReadStream on:'1234567890') upToEnd"

    "((ReadStream on:'123456') next; next) upToEnd"

!

upToSeparator

    "Return the next elements up to but not including the next separator."

    |stream ch|

    stream := WriteStream on: (collection species new).

    [(ch := self peek) == nil] whileFalse:[

        ch isSeparator ifTrue: [

            ^ stream contents

        ] ifFalse: [

            self skip: 1.

            stream nextPut: ch

        ]

    ].

    ^ stream contents

! !

!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)) or:[index < 1]) ifTrue: [^ self positionError].

    position := index

!

backStep

    "move backward read position by one"

    position <= 1 ifTrue: [^ self positionError].

    position := position - 1

!

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.

"

    Smalltalk at:#ErrorHandler put:self.

"

    [

        "ErrorDuringFileInSignal" SignalSet anySignal handle:[:ex |

            |action|

            "handle the case where no GUI has been built in,

             just abort with a notification"

            Display isNil ifTrue:[

                self notify:(ex signal notifierString).

                ex return

            ].

            "otherwise ask what should be done now and either

             continue or abort the fileIn"

            action := self askForDebug:(ex signal notifierString).

            action == #continue ifTrue:[

                Smalltalk at:#ErrorHandler put:self.

                ex proceed

            ].

            action == #abort ifTrue:[

                ex return

            ].

            ex reject

        ] do:[

            [self atEnd] whileFalse:[

                lastValue := self fileInNextChunkNotifying:someone

            ].

        ].

    ^ 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|

    "switch back to regular error handling"

    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'

                ]