"

 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.

"

"{ Package: 'stx:libbasic' }"

PeekableStream subclass:#PositionableStream

	instanceVariableNames:'collection position readLimit writeLimit'

	classVariableNames:'ZeroPosition InvalidPositionErrorSignal ErrorDuringFileInSignal

		CurrentFileInDirectoryQuerySignal ChunkSeparator'

	poolDictionaries:''

	category:'Streams'

!

!PositionableStream 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

"

    Instances of PositionableStream allow positioning the read pointer.

    The PositionableStream class also adds methods for source-chunk reading

    and writing, and for filing-in/out of source code.

    This is an abstract class.

    Compatibility Notice:

       For historical reasons, ST/X starts with a 1-position (i.e. as in collections),

       while ST-80 uses 0-based postions for streams and 1-based positions for collections.

    THIS CERTAINLY IS BAD.

    To allow for portable code, this method can be asked to return the initial position.

    (for code, which ought to execute under other systems, use:

       posZero := (PositionableStream class respondsTo:#zeroPosition) 

		       ifTrue:[PositionableStream zeroPosition]

		       ifFalse:[0] 

    Please use this query for ST/X programs - we will eventually switch to a 0-based

    indexing scheme, and your programs should be prepared for that.

    [author:]

	Claus Gittinger

"

! !

!PositionableStream class methodsFor:'initialization'!

initialize

    "setup the signal used to handle errors during fileIn"

    ZeroPosition := 0.        "/ changed with stx rel5.1

    ErrorDuringFileInSignal isNil ifTrue:[

        ErrorDuringFileInSignal := Error newSignalMayProceed:true.

        ErrorDuringFileInSignal nameClass:self message:#errorDuringFileInSignal.

        ErrorDuringFileInSignal notifierString:'error during fileIn'.

        InvalidPositionErrorSignal := PositionOutOfBoundsError.

        InvalidPositionErrorSignal notifierString:'position out of bounds: '.

        CurrentFileInDirectoryQuerySignal := QuerySignal new.

        CurrentFileInDirectoryQuerySignal nameClass:self message:#currentFileInDirectoryQuerySignal.

        CurrentFileInDirectoryQuerySignal notifierString:'query for current directory when filing in'.

        CurrentFileInDirectoryQuerySignal handlerBlock:[:ex | ex proceedWith:Filename currentDirectory].

    ]

! !

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

    ^ (self basicNew) on:aCollection from:first to:last

!

with:aCollection

    "return a new PositionableStream streaming on aCollection,

     the stream is positioned to the end of the collection."

    ^ (self basicNew) with:aCollection

! !

!PositionableStream class methodsFor:'Signal constants'!

currentFileInDirectoryQuerySignal

    "return the querySignal, which can be used to ask for the current directory

     during a fileIn (that is the directory where the filed-in file resides),

     and in a fileBrowsers doIt.

     Using this, allows for the loaded code or doIts to ask for the fileBrowsers

     current directory, by asking this querySignal (which is nice sometimes)."

    ^ CurrentFileInDirectoryQuerySignal

!

invalidPositionErrorSignal

    "return the signal raised if positioning is attempted to an

     invalid position (i.e. before the begin of the stream or after

     the end)"

    ^ PositionOutOfBoundsError

! !

!PositionableStream class methodsFor:'constants'!

zeroPosition

    "return the number, which marks the initial position.

     Compatibility Notice:

	For historical reasons, ST/X starts with a 1-position (i.e. as in collections),

	while ST-80 uses 0-based postions for streams and 1-based positions for collections.

     THIS CERTAINLY IS BAD.

     To allow for portable code, this method can be asked to return the initial position.

     (for code, which ought to execute under other systems, use:

	posZero := (PositionableStream class respondsTo:#zeroPosition) 

			ifTrue:[PositionableStream zeroPosition]

			ifFalse:[0] 

     Be prepared for this to be changed to return 0 as other ST's do.

	"

    ^ ZeroPosition

! !

!PositionableStream class methodsFor:'queries'!

currentFileInDirectory

    "during a fileIn (if a script), the script can ask for the current directory"

    ^ CurrentFileInDirectoryQuerySignal query

! !

!PositionableStream methodsFor:'Compatibility-Dolphin'!

endChunk

    self nextPutChunkSeparator

! !

!PositionableStream methodsFor:'accessing'!

collection

    ^ collection

!

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

!

peekForAll:aCollection

    "return true and advance if the next elements are the same

     as aCollection. 

     otherwise stay and let the position unchanged"

    |oldPos|

    oldPos := self position.

    (self next:(aCollection size)) = aCollection ifTrue:[

	^ true

    ].

    self position:oldPos.

    ^ false

    "Created: 1.3.1997 / 15:11:25 / cg"

!

readLimit

    "return the read-limit; thats the position at which EOF is returned"

    ^ readLimit

    "Created: / 30.10.1998 / 16:47:04 / cg"

!

readLimit:aNumber

    "set the read-limit; thats the position at which EOF is returned"

    readLimit := aNumber

!

writeLimit:aNumber

    "set the writeLimit; thats the position after which writing is prohibited"

    writeLimit := aNumber

! !

!PositionableStream methodsFor:'fileIn'!

askForDebug:message

    "launch a box asking if a debugger is wanted - used when an error

     occurs while filing in"

    ^ self askForDebug:message canContinueForAll:false

!

askForDebug:message canContinueForAll:canContinueForAll

    "launch a box asking if a debugger is wanted - used when an error

     occurs while filing in"

    |labels values|

    Smalltalk isInitialized ifFalse:[

        'PositionableStream [warning]: fileIn error during startup: ' errorPrint. message errorPrintCR.

        ^ #debug

    ].

    "/

    "/ are we in the startup sequence of an image restart ?

    "/

    Processor activeProcessIsSystemProcess ifTrue:[

        'PositionableStream [warning]: fileIn error during startup: ' errorPrint. message errorPrintCR.

        ^ #continue

    ].

    canContinueForAll ifTrue:[

          labels := #('Cancel' 'Skip' 'Debug' 'Dont ask again' 'Continue').

          values := #(#abort   #skip  #debug  #continueForAll #continue).

    ] ifFalse:[

          labels := #('Cancel' 'Skip' 'Debug' 'Continue').

          values := #(#abort  #skip   #debug #continue).

    ].

    AbortAllSignal isHandled ifTrue:[

      labels := #('Cancel All') , labels.

      values := #(#cancelAll) , values.

    ].

    ^ OptionBox 

          request:message 

          label:'Error in fileIn'

          buttonLabels:labels

          values:values

          default:#continue

          onCancel:#abort.

    "Modified: 10.1.1997 / 18:00:56 / cg"

!

basicFileInNotifying:someone passChunk:passChunk

    "central method to file in from the receiver, i.e. read chunks and evaluate them -

     return the value of the last chunk.

     Someone (which is usually some codeView) is notified of errors."

    |lastValue pkg spc spaces

     packageQuerySignal nameSpaceQuerySignal usedNameSpaceQuerySignal

     changeDefaultApplicationNotificationSignal

     defaultApplicationQuerySignal defaultApplication

     confirmationQuerySignal handledSignals passedSignals

     dontAskSignals askSomeoneForPackage redef outerContext|

    self skipSeparators.

    lastValue := self peek.

    lastValue == $< ifTrue:[

        "/ assume, its an xml file

        ^ self fileInXMLNotifying:someone passChunk:passChunk.

    ].

    lastValue == $# ifTrue:[

        "assume unix interpreter name:

         '#!!stx -e' or something like this"

        self nextPeek == $!! ifTrue:[

            "skip the unix command line"

            self nextLine

        ] ifFalse:[

             self error:'Invalid chunk start'

        ]

    ].

    Smalltalk::Compiler isNil ifTrue:[

        self isFileStream ifTrue:[

            Transcript show:('[' , self pathName , '] ').

        ].

        Transcript showCR:'cannot fileIn (no compiler).'.

        ^ nil.

    ].

    "/ support for V'Age applications

    defaultApplicationQuerySignal := Class defaultApplicationQuerySignal.

    changeDefaultApplicationNotificationSignal := Class changeDefaultApplicationNotificationSignal.

    "/ support for ST/X's namespaces & packages

    packageQuerySignal := Class packageQuerySignal.

    nameSpaceQuerySignal := Class nameSpaceQuerySignal.

    usedNameSpaceQuerySignal := Class usedNameSpaceQuerySignal.

    (someone respondsTo:#packageToInstall) ifFalse:[

        pkg := packageQuerySignal query.

        askSomeoneForPackage := false.

    ] ifTrue:[

        pkg := someone packageToInstall.

        askSomeoneForPackage := true.

    ].

    (someone respondsTo:#currentNameSpace) ifFalse:[

        spc := nameSpaceQuerySignal query.

    ] ifTrue:[

        spc := someone currentNameSpace

    ].

    (someone respondsTo:#usedNameSpaces) ifFalse:[

        spaces := usedNameSpaceQuerySignal query.

    ] ifTrue:[

        spaces := someone usedNameSpaces

    ].

    (someone respondsTo:#defaultApplication) ifFalse:[

        defaultApplication := defaultApplicationQuerySignal query.

    ] ifTrue:[

        defaultApplication := someone defaultApplication

    ].

    confirmationQuerySignal := Metaclass confirmationQuerySignal.

    passedSignals := IdentitySet new.

    handledSignals := SignalSet new.

    handledSignals add:changeDefaultApplicationNotificationSignal.

    passedSignals add:changeDefaultApplicationNotificationSignal.

    handledSignals add:defaultApplicationQuerySignal.

    passedSignals add:defaultApplicationQuerySignal.

    handledSignals add:packageQuerySignal.

    handledSignals add:usedNameSpaceQuerySignal.

    handledSignals add:nameSpaceQuerySignal.

    handledSignals add:Error.

    passedSignals add:Error.

    handledSignals add:(Class methodRedefinitionSignal).

    passedSignals add:(Class methodRedefinitionSignal).

    handledSignals add:(Class classRedefinitionSignal).

    passedSignals add:(Class classRedefinitionSignal).

    handledSignals add:confirmationQuerySignal.

    passedSignals add:confirmationQuerySignal.

    outerContext := thisContext.

    handledSignals handle:[:ex |

        |sig action what sender msg param oldPackage newPackage proceedValue

         canContinueForAll|

        sig := ex signal.

"/sig == packageQuerySignal ifTrue:[

"/self halt.

"/].

        (passedSignals includes:sig) ifTrue:[

            (sig isHandledIn:outerContext) ifTrue:[

                ex reject

            ]

        ].

        sig == changeDefaultApplicationNotificationSignal ifTrue:[

            "/ invoked via #becomeDefault to set the defaultApp and the package.

            "/ (only when filing in V'Age code)

            defaultApplication := ex parameter.

            pkg := defaultApplication name asSymbol.

            ex proceedWith:nil

        ].

        sig == defaultApplicationQuerySignal ifTrue:[

            "/ query for the application to add classes & methods into

            "/ (only when filing in V'Age code)

            ex proceedWith:defaultApplication

        ].

        sig == packageQuerySignal ifTrue:[

            "/ query for the package to use for classes & methods

            askSomeoneForPackage ifTrue:[

                ex proceedWith:someone packageToInstall

            ] ifFalse:[

                ex proceedWith:pkg

            ]

        ].

        sig == usedNameSpaceQuerySignal ifTrue:[

            "/ query for the namespaces searched when encountering globals

            ex proceedWith:spaces

        ].

        sig == nameSpaceQuerySignal ifTrue:[

            "/ query for the namespace to install new classes in

            ex proceedWith:spc

        ].

        sig == confirmationQuerySignal ifTrue:[

            ex proceedWith:false "/ no dialogs popping up

        ].

        sig == Stream endOfStreamSignal ifTrue:[

            ex reject

        ].

        sig == Signal noHandlerSignal ifTrue:[

            ex parameter rejected ifTrue:[

                ex reject

            ].

        ].

        (dontAskSignals notNil and:[dontAskSignals includesKey:sig]) ifTrue:[

            ex proceedWith:(dontAskSignals at:sig)

        ].

        canContinueForAll := false.

        redef := false.

        "/ for your convenience ...

        (sig == Class methodRedefinitionSignal) ifTrue:[

            param := ex parameter. "/ an association: oldMethod -> newMethod

            oldPackage := param key package.

            newPackage := param value package.

            msg := 'trying to overwrite method:\\    ' , param key whoString , '\\in package ''' 

                   , oldPackage , ''' with method from package ''' , newPackage , ''''.

            canContinueForAll := true.

        ] ifFalse:[

            (sig == Class classRedefinitionSignal) ifTrue:[

                param := ex parameter. "/ an association: oldClass -> newClass

                oldPackage := param key package.

                newPackage := param value package.

                msg := 'trying to redefine class: ' , param key name allBold , '\\in package ''' 

                       , oldPackage , ''' with new definition from package ''' , newPackage , ''''.

                canContinueForAll := true.

                redef := true.

            ] ifFalse:[

                msg := 'error in fileIn: %1'

            ]

        ].

        what := ex description.

        what isNil ifTrue:[

            what := ex signal notifierString.

        ].

        msg := msg bindWith:what.

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

        "/ just abort the fileIn with a notification

        Display isNil ifTrue:[

            sender := ex suspendedContext sender.

            msg := msg , ('\\in ' , sender receiver class name , '>>>' , sender selector) withCRs.

            self notify:msg.

            ex return

        ].

        sig == HaltInterrupt ifTrue:[

            sender := ex suspendedContext.

            msg := msg , ('\\in ' , sender receiver class name , '>>>' , sender selector) withCRs

        ].

        "/ otherwise ask what should be done now and either

        "/ continue or abort the fileIn

        redef ifTrue:[

            action := OptionBox 

                          request:(msg withCRs) 

                          label:'Class redefinition in fileIn'

"/ cg: now always keep the old packageID

"/                          buttonLabels:#('cancel' 'skip' 'debug' 'keep' 'keep all' 'continue' 'continue all')