"{ Encoding: utf8 }"

"

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

"{ NameSpace: Smalltalk }"

Stream subclass:#PeekableStream

	instanceVariableNames:''

	classVariableNames:'CurrentFileInDirectoryQuerySignal CurrentSourceContainerQuery

		ErrorDuringFileInSignal'

	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.

    [caveat:]

        Basing capabilities like readability/writability/positionability/peekability on inheritance makes

        the class hierarchy ugly and leads to strange and hard to teach redefinitions (aka. NonPositionableStream

        below PositionableStream or ExternalReadStream under WriteStream)

    [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'.

    ]

    "

     self initialize

    "

    "Modified: / 23-10-2006 / 16:34:41 / cg"

! !

!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 isNil ifTrue:[

        CurrentFileInDirectoryQuerySignal := QuerySignal new.

        CurrentFileInDirectoryQuerySignal nameClass:self message:#currentFileInDirectoryQuerySignal.

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

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

    ].

    ^ CurrentFileInDirectoryQuerySignal

    "Modified: / 23-10-2006 / 16:34:37 / cg"

!

currentSourceContainerQuery

    "return the querySignal, which can be used to ask for the current source container filename

     during a fileIn 

     Using this, allows for the loaded code to remember the classes file name."

    CurrentSourceContainerQuery isNil ifTrue:[

        CurrentSourceContainerQuery := QuerySignal new.

        CurrentSourceContainerQuery nameClass:self message:#currentClassFilenameQuery.

        CurrentSourceContainerQuery notifierString:'query for current sorce container name when filing in'.

        CurrentSourceContainerQuery handlerBlock:[:ex | ex proceedWith:nil].

    ].

    ^ CurrentSourceContainerQuery

    "Modified: / 23-10-2006 / 16:32:49 / cg"

! !

!PeekableStream class methodsFor:'queries'!

currentFileInDirectory

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

    ^ self currentFileInDirectoryQuerySignal query

    "Modified: / 23-10-2006 / 16:34:47 / cg"

!

currentSourceContainer

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

    ^ self currentSourceContainerQuery query

    "Modified: / 23-10-2006 / 16:33:40 / cg"

! !

!PeekableStream class methodsFor:'testing'!

isAbstract

    ^ self == PeekableStream

! !

!PeekableStream methodsFor:'accessing'!

contents

    ^ self upToEnd.

    "Created: / 11-06-2018 / 13:47:53 / Stefan Vogel"

! !

!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 doesn't really matter, since C-primitives are an ST/X feature anyway."

    |buffer theString chunkSeparator newString done thisChar nextChar 

     atBeginOfLine inPrimitive  hasCR hasLF

     index    "{ Class:SmallInteger }"

     currSize "{ Class:SmallInteger }" |

    chunkSeparator := ChunkSeparator.

    buffer := CharacterWriteStream new:100.

    self skipSeparators.

    thisChar := self nextOrNil.

    done := false.

    atBeginOfLine := true.

    inPrimitive := false.

    hasCR := hasLF := false.

    [done not and:[thisChar notNil]] whileTrue:[

        "match primitive only at beginning of line 

         (ExternalStream>>#nextChunk did this, although stc allows primitive to start anywhere)"

        (atBeginOfLine and:[thisChar == $%]) ifTrue:[

            nextChar := self peekOrNil.

            (nextChar == ${ ) ifTrue:[

                inPrimitive := true.

                buffer nextPut:thisChar.

                thisChar := self next

            ] ifFalse:[

                (nextChar == $} ) ifTrue:[

                    inPrimitive := false.

                    buffer nextPut:thisChar.

                    thisChar := self next

                ]

            ]

        ] ifFalse:[

            "chunk can not end in primitive code"

            (inPrimitive not and:[thisChar == chunkSeparator]) ifTrue:[

                (self peekOrNil == chunkSeparator) ifTrue:[

                    "double chunkSeparator, make single"

                    self next.

                ] ifFalse:[

                    "single chunkSeparator: end of chunk"

                    done := true.

                ].

            ].

        ].

        done ifFalse:[

            "now map CR LF to LF (ExternalStream>>#nextChunk did this)"

            atBeginOfLine := false.

            thisChar == Character return ifTrue:[

                self peekOrNil == Character lf ifTrue:[

                    self next.

                    thisChar := Character lf.

                    hasLF := true.

                ] ifFalse:[

                    "CR without LF"

                    hasCR := true.

                ].

                atBeginOfLine := true.

            ] ifFalse:[thisChar == Character lf ifTrue:[

                hasLF := true.

                atBeginOfLine := true.

            ]].

            buffer nextPut:thisChar.

            thisChar := self nextOrNil.

        ].

    ].

    theString := buffer contents.

    (hasCR and:[hasLF not]) ifTrue:[

        "map all CR in a CR only file to NL (ExternalStream>>#nextChunk did this)"

        theString replaceAll:Character return with:Character nl.

    ].

    ^ theString

! !

!PeekableStream methodsFor:'fileIn'!

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.

    ].

    ^ Class nameSpaceQuerySignal answer:Smalltalk do:[

        self fileInNotifying:notifiedLoader passChunk:true.

    ].

    "Modified: / 16-02-2017 / 10:01:43 / stefan"

    "Modified (comment): / 01-06-2020 / 11:43:37 / cg"

!

fileInBinary

    "file in BOSSed cod from the receiver, 

     i.e. read binary stored classes and/or objects.

     Return the last object."

    |bos|

    bos := BinaryObjectStorage onOld:self.

    ^ [

        |obj|

        [ self atEnd ] whileFalse:[

            obj := bos next.

        ].

        obj.

    ] on:Class nameSpaceQuerySignal do:[:ex | ex proceedWith:Smalltalk]

      ensure:[ bos close ].

    "Created: / 13-11-2001 / 10:12:30 / cg"

    "Modified (format): / 16-02-2017 / 14:30:27 / stefan"

    "Modified (comment): / 01-06-2020 / 11:43:10 / cg"

!

fileInToPackage:package

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

     Return the value of the last chunk.

     Code will be installed into the given package."

    ^ Class packageQuerySignal answer:package do:[

        self fileIn.

    ].

    "Created: / 01-06-2020 / 11:41:33 / cg"

! !

!PeekableStream methodsFor:'positioning'!

skipAny:skipCollection

    "skip all characters included in the argument-set.

     returns the next peeked element or nil, if the end-of-stream was reached."

    |nextOne|

    nextOne := self peekOrNil.

    [nextOne notNil and:[skipCollection includes:nextOne]] whileTrue:[

        self next.

        nextOne := self peekOrNil

    ].

    ^ nextOne

    "

     |s skipChars|

     s := ReadStream on:'some numbers1234with\in other99 stuff' withCRs.

     skipChars := 'abcdefghijklmnopqrstuvwxyz\ ' withCRs.

     s skipAny:skipChars.

     Transcript showCR:(Integer readFrom:s).

     s skipAny:skipChars.

     Transcript showCR:(Integer readFrom:s).

    "

!

skipSeparators

    "skip all whitespace; 

     return the next peeked element or nil, if the end-of-stream was reached.

     The stream's elements should be characters.

     Notice: compare this method to skipSpaces"

    |nextOne|

    [(nextOne := self peekOrNil) notNil and:[nextOne isSeparator]] whileTrue:[

        self next.

    ].

    ^ nextOne

    "

     |s|

     s := ReadStream on:'one      two\three' withCRs.

     s skipSeparators.

     Transcript showCR:(s nextAlphaNumericWord).

     s skipSeparators.

     Transcript showCR:(s nextAlphaNumericWord).

     s skipSeparators.

     Transcript showCR:(s next displayString).

    "

    "Modified (comment): / 28-09-2019 / 15:01:04 / Stefan Vogel"

!

skipSeparatorsExceptCR

    "skip all whitespace except carriage return; returns the 

     next peeked element or nil, if the end-of-stream was reached.

     The streams elements should be characters.

     Notice: compare this method to skipSpaces and skipSeparators"

    |nextOne|

    nextOne := self peekOrNil.

    [nextOne notNil 

     and:[nextOne isSeparator

     and:[nextOne ~~ Character cr]]] whileTrue:[

        self next.

        nextOne := self peekOrNil

    ].

    ^ nextOne

!

skipSpaces

    "skip all spaces; returns the next peeked element or

     nil, if the end-of-stream was reached.

     The streams elements should be characters.

     Notice: this one skips only spaces (i.e. no cr, tabs etc)

             usually, skipSeparators is what you want."

    |nextOne|

    nextOne := self peekOrNil.

    [nextOne notNil and:[nextOne == Character space]] whileTrue:[

        self next.

        nextOne := self peekOrNil

    ].

    ^ nextOne

    "

     |s|

     s := ReadStream on:'one      two\three' withCRs.

     s skipSpaces.

     Transcript showCR:(s nextWord).

     s skipSpaces.

     Transcript showCR:(s nextWord).

     s skipSpaces.

     Transcript showCR:(s next displayString).

    "

! !

!PeekableStream methodsFor:'private fileIn'!

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 nameSpace usedNameSpaces

     packageQuerySignal nameSpaceQuerySignal usedNameSpaceQuerySignal

     changeDefaultApplicationNotificationSignal

     defaultApplicationQuerySignal defaultApplication

     confirmationQuerySignal handledSignals passedSignals askSomeoneForPackage outerContext askForVariableTypeOfUndeclaredQuery|

    self isEncodedStream ifFalse:[

        "keep the fileIn stuff in this class and not in EncodedStream"

        ^ (EncodedStream decodedStreamFor:self) basicFileInNotifying:someone passChunk:passChunk.

    ].

    self skipSeparators.

    lastValue := self peek.

    lastValue == $< ifTrue:[

        "/ assume, it's 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 at:#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.

    askSomeoneForPackage := someone respondsTo:#packageToInstall.

    askSomeoneForPackage ifTrue:[

        pkg := someone packageToInstall.

    ] ifFalse:[

        pkg := packageQuerySignal query.

    ].

    (someone respondsTo:#currentNameSpace) ifTrue:[

        nameSpace := someone currentNameSpace

    ] ifFalse:[

        nameSpace := nameSpaceQuerySignal query.

    ].

    (someone respondsTo:#usedNameSpaces) ifTrue:[

        usedNameSpaces := someone usedNameSpaces

    ] ifFalse:[

        usedNameSpaces := usedNameSpaceQuerySignal query.

    ].

    (someone respondsTo:#defaultApplication) ifTrue:[

        defaultApplication := someone defaultApplication

    ] ifFalse:[

        defaultApplication := defaultApplicationQuerySignal query.

    ].

    confirmationQuerySignal := Metaclass confirmationQuerySignal.

    handledSignals := SignalSet new.

    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:confirmationQuerySignal.

    passedSignals add:confirmationQuerySignal.

    Parser notNil ifTrue:[

        "only if libcomp is present"

        "Also catch a 'Parser askForVariableTypeOfUndeclaredQuery' and proceed with nil. 

         Imagine somebody has autodefine workspace variables on and then 

         evaluate Smalltalk loadPackage:'xyz' that loads code from source (using file-in), 

         certainly we don't want to compile workspace variable access for every

         not-yet-loaded class in some namespace. 

         This is demonstrated by Regression::CompilerTests2>>test_01 

         and this change actually fixes this test."

        askForVariableTypeOfUndeclaredQuery := Parser askForVariableTypeOfUndeclaredQuery.

        handledSignals add:askForVariableTypeOfUndeclaredQuery.

    ].