"

 COPYRIGHT (c) 1994 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' }"

Stream subclass:#PeekableStream

	instanceVariableNames:''

	classVariableNames:'ErrorDuringFileInSignal CurrentFileInDirectoryQuerySignal'

	poolDictionaries:''

	category:'Streams'

!

!PeekableStream class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1994 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

"

    abstract superclass for all Stream which support read-ahead

    (i.e. peeking) of one element.

    Concrete subclasses must implement a peek method.

    [author:]

        Claus Gittinger

"

! !

!PeekableStream class methodsFor:'initialization'!

initialize

    "setup the signal used to handle errors during fileIn"

    ErrorDuringFileInSignal isNil ifTrue:[

        ErrorDuringFileInSignal := Error newSignalMayProceed:true.

        ErrorDuringFileInSignal nameClass:self message:#errorDuringFileInSignal.

        ErrorDuringFileInSignal notifierString:'error during fileIn'.

        CurrentFileInDirectoryQuerySignal := QuerySignal new.

        CurrentFileInDirectoryQuerySignal nameClass:self message:#currentFileInDirectoryQuerySignal.

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

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

    ]

    "

     self initialize

    "

! !

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

! !

!PeekableStream class methodsFor:'queries'!

currentFileInDirectory

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

    ^ CurrentFileInDirectoryQuerySignal query

! !

!PeekableStream methodsFor:'chunk input/output'!

nextChunk

    "return the next chunk, i.e. all characters up to the next

     exclamation mark. Within the chunk, exclamation marks have to be doubled,

     they are undoubled here.

     Except for primitive code, in which doubling is not needed (allowed).

     This exception was added to make it easier to edit primitive code with 

     external editors. However, this means, that other Smalltalks cannot always 

     read chunks containing primitive code 

     - but that doesnt really matter, since C-primitives are an ST/X feature anyway."

    |theString sep newString done thisChar nextChar inPrimitive

     index    "{ Class:SmallInteger }"

     currSize "{ Class:SmallInteger }" |

    sep := 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.

"/            thisChar == Character return ifTrue:[

"/                self peekOrNil == Character lf ifTrue:[

"/                    thisChar := Character lf.

"/                    self next.

"/                ]

"/            ].

            theString at:index put:thisChar.

            thisChar := self next.

        ]

    ].

    (index == 0) ifTrue:[^ ''].

    ^ theString copyTo:index

! !

!PeekableStream 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'

          image:(WarningBox iconBitmap)

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

     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.

    packageQuerySignal := Class packageQuerySignal.

    nameSpaceQuerySignal := Class nameSpaceQuerySignal.

    usedNameSpaceQuerySignal := Class usedNameSpaceQuerySignal.

        pkg := someone packageToInstall.

        askSomeoneForPackage := true.

    ].

    ].

    ].

        defaultApplication := defaultApplicationQuerySignal query.

    ].

    confirmationQuerySignal := Metaclass confirmationQuerySignal.

    passedSignals := IdentitySet 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 := ex signal.

        ].

        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:[

            askSomeoneForPackage ifTrue:[

                ex proceedWith:someone packageToInstall

            ] ifFalse:[

                ex proceedWith:pkg

            ]

        ].

        sig == usedNameSpaceQuerySignal ifTrue:[

        ].

        sig == nameSpaceQuerySignal ifTrue:[

        ].

        sig == confirmationQuerySignal ifTrue:[

        ].

        sig == Stream endOfStreamSignal ifTrue:[

            ex reject

        ].

            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:[

            canContinueForAll := true.

        ] ifFalse:[

            (sig == Class classRedefinitionSignal) ifTrue:[

                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

            sender := ex suspendedContext sender.

            self notify:msg.

            ex return

        ].

        sig == HaltInterrupt ifTrue:[

            sender := ex suspendedContext.

        ].

        "/ 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'

                          image:(WarningBox iconBitmap)

"/ cg: now always keep the old packageID

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

"/                          values:#(#abort #skip #debug #keep #keepAll #continue #continueForAll)

                          buttonLabels:#('Cancel' 'Skip' 'Debug' 'Continue' 'Continue All')

                          values:#(#abort #skip #debug #keep #keepAll)

                          default:#keep

                          onCancel:#abort.

        ] ifFalse:[

            action := self askForDebug:msg withCRs canContinueForAll:canContinueForAll.

        ].

        action == #continueForAll ifTrue:[

            dontAskSignals isNil ifTrue:[

                dontAskSignals := IdentityDictionary new.

            ].

            dontAskSignals at:sig put:#continue.

            action := proceedValue := #continue.

        ] ifFalse:[

            action == #keepForAll ifTrue:[

                dontAskSignals isNil ifTrue:[

                    dontAskSignals := IdentityDictionary new.

                ].

                dontAskSignals at:sig put:#keep.

                action := #continue.

                proceedValue := #keep.

            ] ifFalse:[

                action == #keep ifTrue:[

                    action := #continue.

                    proceedValue := #keep.

                ].

            ].

        ].

        action == #continue ifTrue:[

            ex proceedWith:proceedValue

        ].

        action == #abort ifTrue:[

            ex return

        ].

        action == #cancelAll ifTrue:[

            ex return

        ].

        action == #skip ifTrue:[

            ex proceedWith:nil

        ].

        action == #debug ifTrue:[

            Debugger enter:ex suspendedContext 

                     withMessage:ex description 

                     mayProceed:true.

            ex proceedWith:proceedValue

        ].

        "/ (ex signal) enterDebuggerWith:ex message:what.

        ex reject

    ] do:[

        [self atEnd] whileFalse:[

            lastValue := self fileInNextChunkNotifying:someone passChunk:passChunk

        ]

    ].

    ^ lastValue

    "Modified: / 10.9.1999 / 16:54:01 / stefan"

    "Modified: / 16.11.2001 / 16:21:28 / cg"

!

fileIn

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

     return the value of the last chunk."

    |notifiedLoader|

    SourceFileLoader notNil ifTrue:[

        notifiedLoader := SourceFileLoader on:self.