PeekableStream.st
author Claus Gittinger <cg@exept.de>
Tue, 09 Jul 2019 20:55:17 +0200
changeset 24417 03b083548da2
parent 23063 5a1e00943c56
child 24596 2ef21466b617
permissions -rw-r--r--
#REFACTORING by exept class: Smalltalk class changed: #recursiveInstallAutoloadedClassesFrom:rememberIn:maxLevels:noAutoload:packageTop:showSplashInLevels: Transcript showCR:(... bindWith:...) -> Transcript showCR:... with:...

"{ 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:'ErrorDuringFileInSignal CurrentFileInDirectoryQuerySignal
		CurrentSourceContainerQuery'
	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 on:(String 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"
!

fileInBinary
    "file in 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"
! !

!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.
    [nextOne notNil and:[nextOne isSeparator]] whileTrue:[
        self next.
        nextOne := self peekOrNil
    ].
    ^ nextOne

    "
     |s|

     s := ReadStream on:'one      two\three' withCRs.
     s skipSeparators.
     Transcript showCR:(s nextWord).
     s skipSeparators.
     Transcript showCR:(s nextWord).
     s skipSeparators.
     Transcript showCR:(s next displayString).
    "
!

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


    outerContext := thisContext.

    handledSignals handle:[:ex |
        |sig|

        sig := ex creator.
        ((passedSignals includes:sig) and:[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:[
            "answer the package to use for classes & methods"
            askSomeoneForPackage ifTrue:[
                ex proceedWith:someone packageToInstall
            ] ifFalse:[
                ex proceedWith:pkg
            ]
        ].
        sig == usedNameSpaceQuerySignal ifTrue:[
            "answer the nameSpaces to be searched when encountering globals"
            ex proceedWith:usedNameSpaces
        ].
        sig == nameSpaceQuerySignal ifTrue:[
            "answer the nameSpace to install new classes in"
            ex proceedWith:nameSpace
        ].
        sig == confirmationQuerySignal ifTrue:[
            "don't pop up dialogs"
            ex proceedWith:false
        ].
        sig == askForVariableTypeOfUndeclaredQuery ifTrue:[
           "no autodefined variables or so"
            ex proceedWith:nil.
        ].
    ] do:[
        [self atEnd] whileFalse:[
            lastValue := self fileInNextChunkNotifying:someone passChunk:passChunk silent:nil.
        ]
    ].
    ^ lastValue

    "Modified: / 16-11-2001 / 16:21:28 / cg"
    "Modified: / 25-03-2013 / 22:57:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-02-2017 / 15:20:02 / stefan"
!

fileInNextChunkNotifying:someone
    "read next chunk, evaluate it and return the result;
     someone (which is usually some codeView) is notified of errors.
     Filein is done as follows:
        read a chunk
        if it started with an excla, evaluate it, and let the resulting object
        fileIn more chunks.
        This is a nice trick, since the methodsFor: expression evaluates to
        a ClassCategoryReader which reads and compiles chunks for its class.
        However, other than methodsFor expressions are possible - you can
        (in theory) create readers for any syntax.
    "

    ^ self fileInNextChunkNotifying:someone passChunk:false silent:nil.

    "Modified: / 16-02-2017 / 15:17:22 / stefan"
!

fileInNextChunkNotifying:someone passChunk:passChunk
    "read next chunk, evaluate it and return the result;
     someone (which is usually some codeView) is notified of errors.
     Filein is done as follows:
	read a chunk
	if it started with an excla, evaluate it, and let the resulting object
	fileIn more chunks.
	This is a nice trick, since the methodsFor: expression evaluates to
	a ClassCategoryReader which reads and compiles chunks for its class.
	However, other than methodsFor expressions are possible - you can
	(in theory) create readers for any syntax.
    "

    ^ self fileInNextChunkNotifying:someone passChunk:passChunk silent:nil
!

fileInNextChunkNotifying:someone passChunk:passChunk silent:beSilent
    "read next chunk, evaluate it and return the result;
     someone (which is usually some codeView) is notified of errors.
     Filein is done as follows:
        read a chunk
        if it started with an excla, evaluate it, and let the resulting object
        fileIn more chunks.
        This is a nice trick, since the methodsFor: expression evaluates to
        a ClassCategoryReader which reads and compiles chunks for its class.
        However, other than methodsFor expressions are possible - you can
        (in theory) create readers for any syntax.
     The beSilent argument controls output to the transcript, if it's true or
     false. If it's nil, output is controlled by the Smalltalk>>silenLoading setting."

    |aString sawExcla rslt compiler lastClass|

    self skipSeparators.
    self atEnd ifTrue:[
        ^ nil.
    ].

    sawExcla := self peekFor:(self class chunkSeparator).
    aString := self nextChunk.
    "/
    "/ handle empty chunks;
    "/ this allows for Squeak code to be filedIn
    "/
    [aString isEmpty and:[self atEnd not]] whileTrue:[
        aString := self nextChunk.
    ].
    aString isEmpty ifTrue:[
        ^ nil.
    ].

    (passChunk and:[someone notNil]) ifTrue:[
        someone source:aString.
    ].
    someone perform:#reader: with:(SourceFileLoader::SourceFileReader new) ifNotUnderstood:[].
    compiler := (Smalltalk at:#Compiler) new.
    compiler allowUndeclaredVariables:false.

    sawExcla ifFalse:[
        "/ class definition chunks, etc., which are simply evaluated
        rslt := compiler evaluate:aString receiver:someone notifying:someone compile:false.
        rslt isBehavior ifTrue:[ 
            lastClass := rslt 
        ] ifFalse:[
            lastClass := nil 
        ].
    ] ifTrue:[
        "/ methodsFor chunks, etc., which generate a reader
        compiler class emptySourceNotificationSignal handle:[:ex |
            ^ nil
        ] do:[
            rslt := compiler 
                        evaluate:aString 
                        notifying:someone 
                        compile:false.
        ].

        "
         usually, the above chunk consists of some methodsFor:-expression
         in this case, the returned value is a ClassCategoryReader,
         which is used to load & compile the methods ...
        "
        (rslt isNil or:[rslt == #Error]) ifTrue:[
            "
             however, if that was nil (i.e. some error), we skip chunks
             up to the next empty chunk.
            "
            Transcript showCR:'skipping chunks ...'.
            [
                aString := self nextChunk.
            ] doWhile:[aString notEmpty].
        ] ifFalse:[
            Class packageQuerySignal handle:[:ex |
                lastClass notNil ifTrue:[
                    ex proceedWith:lastClass package
                ] ifFalse:[
                    ex reject
                ].    
            ] do:[    
                rslt := rslt 
                        fileInFrom:self 
                        notifying:someone 
                        passChunk:passChunk
                        single:false
                        silent:beSilent
            ].            
        ]
    ].
    ^ rslt

    "Modified: / 05-02-2011 / 10:06:57 / cg"
    "Modified: / 24-04-2018 / 22:46:36 / stefan"
!

fileInNotifying:notifiedLoader 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."

    ^ self basicFileInNotifying:notifiedLoader passChunk:passChunk.
!

fileInNotifying:notifiedLoader passChunk:passChunk inDirectory:aDirectory
    "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.
     Add aDirectory to the search path for classes, while performing the fileIn."

    |oldPath thisDirectory thisDirectoryPathName|

    thisDirectory := aDirectory asFilename.
    thisDirectoryPathName := thisDirectory pathName.
    oldPath := Smalltalk systemPath.

    ^ [
        Smalltalk systemPath:(oldPath copyWithFirst:thisDirectoryPathName).
        self class currentFileInDirectoryQuerySignal answer:thisDirectory do:[
            self class currentSourceContainerQuery answer:self do:[
                self basicFileInNotifying:notifiedLoader passChunk:passChunk.
            ].
        ]
    ] ensure:[
        "take care, someone could have changed SystemPath during fileIn!!"
        (Smalltalk systemPath copyFrom:2) = oldPath ifTrue:[
            Smalltalk systemPath:oldPath.
        ] ifFalse:[
            (oldPath includes:thisDirectoryPathName) ifFalse:[
                Smalltalk systemPath remove:thisDirectoryPathName ifAbsent:[].
                Smalltalk flushPathCaches.
            ].
        ].
    ].

    "Modified: / 23-10-2006 / 16:35:10 / cg"
    "Modified: / 16-02-2017 / 14:51:48 / stefan"
!

fileInXMLNotifying:someone passChunk:passChunk
    "filein an XML source file (format as in campSmalltalk DTD)"

    | builder parser|

    (XML isNil or:[XML::SourceNodeBuilder isNil or:[XML::XMLParser isNil]]) ifTrue:[
	Smalltalk loadPackage:'stx:goodies/xml/vw'.
	(XML isNil or:[XML::SourceNodeBuilder isNil or:[XML::XMLParser isNil]]) ifTrue:[
	    self error:'Could not load XML package(s) from ''stx:goodies/xml/vw'''.
	]
    ].

    builder := XML::SourceNodeBuilder new.
    parser := XML::XMLParser on:self.
    parser builder:builder.
    parser validate:false.
    parser scanDocument.
    "/ self halt.
! !

!PeekableStream methodsFor:'reading'!

nextPeek
    "advance to next element and return the peeked element"

    self next.
    ^ self peek
!

nextPeekOrNil
    "advance to next element and return the peeked element"

    self nextOrNil.
    ^ self peekOrNil
!

nextUpTo:anObject
    "read a collection of all objects up-to anObject and return these
     elements, but excluding anObject. 
     The next read operation will return anObject.
     If anObject is not encountered, all elements up to the end are read
     and returned, and the stream is positioned at the end.
     Compare this with #upTo: which positions behind anObject"

    |answerStream|

    answerStream := self contentsSpecies writeStream.
    [self atEnd or:[anObject = self peek]] whileFalse:[
        answerStream nextPut:self next.
    ].
    ^ answerStream contents

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     Transcript showCR:(s nextUpTo:4).  
     Transcript showCR:s next

     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     Transcript showCR:(s upTo:4).  
     Transcript showCR:s next

     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     Transcript showCR:(s nextUpTo:9).  
     Transcript showCR:s next

     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     Transcript showCR:(s upTo:9).  
     Transcript showCR:s next
    "

    "Created: / 24-01-1997 / 14:08:35 / cg"
    "Modified: / 10-01-2018 / 18:29:47 / stefan"
!

peek 
    "return the next element of the stream without advancing (i.e.
     the following send of next will return this element again.)
     - we do not know here how to do it, it must be redefined in subclass"

    ^ self subclassResponsibility
!

peekFor:anObject 
    "if the next-to-be-read object is equal to the argument, anObject, read it
     and return true. Otherwise, leave the receiver unaffected and return false."

    self peek = anObject ifTrue:[
        self nextOrNil.
        ^ true
    ].
    ^ false

    "
      #() readStream peekFor:nil
      #() readStream signalAtEnd:true; peekFor:nil
      #(nil) readStream peekFor:nil
      'abc' readStream next; peekFor:$b.
      'abc' readStream next; peekFor:$c.
    "
!

peekOrNil
    "like #peek, this returns the next readAhead element, if available.
     However, unlike #peek, this does not raise an atEnd-query signal - even
     if handled. Instead, nil is returned immediately."

    self atEnd ifTrue:[^ nil].
    ^ self peek

    "Created: / 5.3.1998 / 02:56:49 / cg"
    "Modified: / 5.3.1998 / 13:45:07 / cg"
!

skipUntil:aBlock
    "skip all elements for which aBlock returns false.
     Return true if more elements can be read, false if eof has been reached."

    [self atEnd] whileFalse:[
        (aBlock value: self peek) ifTrue:[^ true].
        self next
    ].
    ^ false

    "
     #(1 2 3 4 5 6 7 8 9 10) readStream
        skipUntil:[:el | el >= 5];
        next
    "
!

skipWhile:aBlock
    "skip all elements for which aBlock returns true. Return true if more elements can be read,
     false if eof has been reached."

    [self atEnd] whileFalse:[
	(aBlock value: self peek) ifFalse:[^ true].
	self next
    ].
    ^ false

    "
     #(1 2 3 4 5 6 7 8 9 10) readStream
	skipWhile:[:el | el <= 5];
	next
    "

    "Created: / 23-09-2011 / 13:32:40 / cg"
!

throughAnyForWhich:checkBlock
    "read & return a collection of all objects up-to and including 
     the elements for which checkBlock returns true.
     (i.e. read until checkBlock returns false on an element)
     If no such element is encountered, all elements up to the end are read
     and returned."

    |answerStream|

    answerStream := self contentsSpecies writeStream.
    [self atEnd or:[(checkBlock value:self peek) not]] whileFalse:[
        answerStream nextPut:self next.
    ].
    ^ answerStream contents

    "
     |s|
     s := ReadStream on:#(1 2 3 4 5 6 7 8).
     Transcript showCR:(s throughAnyForWhich:[:e| e <= 4]).  
     Transcript showCR:s next

     |s|
     s := ReadStream on:'hello world, this is some text'.
     Transcript showCR:(s throughAnyForWhich:[:ch | ch isSeparator not]).  
     Transcript showCR:(s throughAnyForWhich:[:ch | ch isSeparator not]).  
     Transcript showCR:s upToEnd.
    "

    "Modified: / 11-01-1998 / 15:28:04 / cg"
    "Modified: / 10-01-2018 / 18:29:51 / stefan"
    "Modified (comment): / 10-01-2018 / 23:18:08 / stefan"
!

upToAny:aCollectionOfObjects
    "read a collection of all objects up to an element that is contained in
     aCollectionOfObjects and return these elements, but excluding the matching one.
     The next read operation will return the element AFTER anObject.
     If no such element is encountered, all elements up to the end are read
     and returned.
     Compare this with #throughAll: which also reads up to some object
     and also positions behind it, but DOES include it in the returned
     value."

    |result|

    result := self upToBeforeAny:aCollectionOfObjects.
    self atEnd ifFalse:[
        self next.
    ].
    ^ result

    "
     |s|
     s := ReadStream on:'hello world'.
     Transcript showCR:(s upToAny:(Array with:Character space)).
     Transcript showCR:(s upToEnd)

     'Makefile' asFilename readStream upToAny:($A to:$Z)
    "

    "Created: / 30.8.1997 / 03:02:05 / cg"
    "Modified: / 11.1.1998 / 15:19:18 / cg"
!

upToBeforeAny:aCollectionOfObjects
    "read a collection of all objects up to an element that is contained in
     aCollectionOfObjects and return these elements, but excluding the matching one.
     The next read operation will return the matching element.
     If no such element is encountered, all elements up to the end are read
     and returned.
     This returns the exact same as upToAny: would, but leaves the stream's position so that
     the next read returns the matching delimiter instead of skipping it.
     Caveat: this is the one which should have been called upTo: in the first place;
     however, it seems now too late for a change."

    |answerStream|

    answerStream := self contentsSpecies writeStream.
    [self atEnd or:[aCollectionOfObjects includes:self peek]] whileFalse:[
        answerStream nextPut:self next.
    ].
    ^ answerStream contents

    "
     |s|
     s := ReadStream on:'hello world'.
     Transcript showCR:(s upToBeforeAny:(Array with:Character space)).
     Transcript showCR:(s upToEnd)

     'Make.proto' asFilename readStream upToBeforeAny:($A to:$Z)
    "

    "Created: / 30-08-1997 / 03:02:05 / cg"
    "Modified: / 11-01-1998 / 15:19:18 / cg"
    "Modified: / 10-01-2018 / 18:29:57 / stefan"
!

upToElementForWhich:aBlock
    "read elements until aBlock returns true for an element.
     Return the collected elements excluding that element.
     Leave the stream positioned for the next read to return that element.
     If no element matches, all elements up to the end are returned"

    |answerStream|

    answerStream := self contentsSpecies writeStream.
    [self atEnd or:[aBlock value:self peek]] whileFalse:[
        answerStream nextPut:self next.
    ].
    ^ answerStream contents

    "
     #(1 2 3 4 5 6 7 8 9 10) readStream
        upToElementForWhich:[:el | el > 5]
    "

    "Modified: / 10-01-2018 / 18:30:03 / stefan"
!

upToMatching:aBlock
    "Return the next elements up to but not including the next element
     for which aBlock returns true.
     The next read will return that matching element.
     If none matches, the remaining elements up to the end are returned."

    ^ self upToElementForWhich:aBlock

    "
     'hello world' readStream upToMatching:[:c | c isSeparator].
    "
    "
     'helloworld' readStream upToMatching:[:c | c isSeparator].
    "
    "
     |s|

     s := 'hello world' readStream.
     s upToMatching:[:c | c isSeparator].
     s upToEnd
    "

    "Modified: / 26-02-1997 / 12:20:57 / cg"
    "Modified (comment): / 10-01-2018 / 23:20:32 / stefan"
!

upToSeparator
    "Return the next elements up to but not including the next separator.
     The next read will return the separator.
     If no separator is encountered, the contents up to the end is returned.
     The elements are supposed to understand #isSeparator
     (i.e. the receiver is supposed to be a character-stream)."

    ^ self upToElementForWhich:[:ch | ch isSeparator]

    "
     'hello world' readStream upToSeparator
     'helloworld' readStream upToSeparator
     'helloworld' readStream upToSeparator
     '' readStream upToSeparator

     |s|
     s := 'hello world' readStream.
     s upToSeparator.
     s upToEnd
    "

    "Modified: 4.1.1997 / 23:38:05 / cg"
! !

!PeekableStream methodsFor:'reading-numbers'!

nextDecimalInteger
    "read the next integer in radix 10.
     Does NOT skip initial whitespace.
     The streams elements should be characters.

     Be careful - this method returns 0 if not positioned on a digit initially
     or if the end of the stream is encountered."

    |nextOne value|

    nextOne := self peekOrNil.
    value := 0.
    [nextOne notNil and:[nextOne isDigitRadix:10]] whileTrue:[
        value := (value * 10) + nextOne digitValue.
        self next.
        nextOne := self peekOrNil
    ].
    ^ value

    "
     |s|

     s := '1234 5678' readStream.
     s nextDecimalInteger.
    "

    "
     |s|

     s := '1234 5678' readStream.
     s nextDecimalInteger.
     s skipSpaces.
     s nextDecimalInteger.
    "

    "Modified (comment): / 17-05-2017 / 15:13:04 / mawalch"
! !

!PeekableStream methodsFor:'reading-strings'!

nextAlphaNumericWord
    "read the next word (i.e. up to non letter-or-digit).
     Return a string containing those characters.
     Any leading non-alphaNumeric chars are skipped.

     National letters or digits in unicode are not treated as letters."

    |s c|

    "first: skip white space and other garbage, leave first character in c"
    [
        c := self nextOrNil.
        c isNil ifTrue:[
            "end of stream"
            ^ nil.
        ].
        c isLetterOrDigit
    ] whileFalse.

    "second: get the alphanumeric word"
    s := self contentsSpecies writeStream:100.
    [
        s nextPut:c.
        c := self peekOrNil.
        (c notNil and:[c isLetterOrDigit]) ifTrue:[
            self next.
            true.
        ] ifFalse:[
            false.
        ]
    ] whileTrue.

    ^ s contents.

    "Use UnicodeString in the examples, to avoid the optimization in ReadStream for Strings"

    "
     |s|

     s := 'hello world 1234 foo1 foo2' asUnicodeString readStream.
     [s atEnd] whileFalse:[
        Transcript showCR:(s nextAlphaNumericWord).
     ].
    "

    "
     |s|

     s := 'hello +++ #world привiт ###123###abc### 1234 foo1 foo2++++' asUnicodeString readStream.
     [s atEnd] whileFalse:[
        Transcript showCR:(s nextAlphaNumericWord).
     ].
    "

    "Modified: / 15-05-1996 / 17:51:42 / cg"
    "Modified: / 10-01-2018 / 18:34:42 / stefan"
!

nextDelimited:terminator
    "return the contents of the receiver, up to the next terminator element. 
     Doubled terminators indicate an embedded terminator element.  
     For example: 'this '' was a quote'. 
     Start positioned before the initial terminator."

    | out element |

    self atEnd ifTrue: [^ ''].
    self peek = terminator ifTrue: [self next].       "absorb initial terminator"
    out := self contentsSpecies writeStream.
    [(element := self nextOrNil) isNil and:[self atEnd]] whileFalse:[
        element = terminator ifTrue: [
            self peek ~= terminator ifTrue: [
                ^ out contents  "terminator is not doubled; we're done!!"
            ].
            self next.  "skip doubled terminator"
        ].
        out nextPut:element.
    ].
    ^ out contents

    "
     ('*foo bar baz* more foo' readStream nextDelimited:$*) 
     ('*foo bar **baz***' readStream nextDelimited:$*)   
    "

    "Modified: / 10-01-2018 / 18:29:42 / stefan"
!

nextMatching:matchBlock1 thenMatching:matchBlock2
    "read the next word. The first character must match matchBlock1,
     remaining characters must match matchBlock2.
     Return a string containing those characters.
     Useful to read identifiers, where the first char is from a different
     set than the remaining (letter vs. letterOrDigit)"

    |s c|

    self atEnd ifTrue:[^ nil].
    (matchBlock1 value:self peek) ifFalse:[^ nil].

    s := self next asString.

    [self atEnd not
     and:[matchBlock2 value:(c := self peek)]] whileTrue:[ 
        s := s copyWith:c. 
        self next 
    ].

    s size == 0 ifTrue:[^ nil].
    ^ s.

    "
     |s|

     s := 'hello_world_1234 foo1 foo2' readStream.
     s nextMatching:[:c | c isLetter] 
       thenMatching:[:c | c isLetterOrDigit or:[c == $_]].
    "
!

nextSymbol
    "read the next selector-symbol (i.e. up to non letter-or-digit).
     Return a string containing those characters.
     Any leading non-alphaNumeric chars are skipped."

    |symbol c symbolStream|

    [self atEnd
     or:[(c := self peek) isLetterOrDigit]] whileFalse:[
        self next 
    ].

    self atEnd ifTrue:[^ nil].

    symbolStream := '' writeStream.

    [self atEnd not
     and:[(c := self peek) isLetterOrDigit or:[c == $:]]] whileTrue:[
        symbolStream nextPut:c.
        self next 
    ].

    symbol := symbolStream contents.
    symbol size == 0 ifTrue:[^ nil].
    ^ symbol.

    "
     |s|

     s := 'hello: world 1234 foo1 foo2:' readStream.
     [s atEnd] whileFalse:[
        Transcript showCR:(s nextSymbol).
     ].
    "

    "
     |s|

     s := 'hello +++ #world ###123###abc### 1234 foo1 foo2' readStream.
     [s atEnd] whileFalse:[
        Transcript showCR:(s nextAlphaNumericWord).
     ].
    "

    "Modified: 15.5.1996 / 17:51:42 / cg"
! !

!PeekableStream class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !


PeekableStream initialize!