"
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"
ErrorDuringFileInSignal isNil ifTrue:[
ErrorDuringFileInSignal := ErrorSignal newSignalMayProceed:true.
ErrorDuringFileInSignal nameClass:self message:#errorDuringFileInSignal.
ErrorDuringFileInSignal notifierString:'error during fileIn'.
"/ InvalidPositionErrorSignal := PositionErrorSignal newSignalMayProceed:true.
"/ InvalidPositionErrorSignal nameClass:self message:#invalidPositionErrorSignal.
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].
ZeroPosition := 1.
]
! !
!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)"
^ InvalidPositionErrorSignal
! !
!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 methodsFor:'Compatibility - Dolphin'!
endChunk
self nextPutChunkSeparator
! !
!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
!
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:'chunk input/output'!
nextChunkPut:aString
"put aString as a chunk onto the receiver;
double all exclamation marks except within primitives and append a
single delimiting exclamation mark at the end.
This modification of the chunk format (not doubling exclas in primitive code)
was done to have primitive code more readable and easier be edited in the fileBrowser
or other editors.
Its no incompatibility, since inline primitives are an ST/X special
and code containing ST/X primitives cannot be loaded into other smalltalks anyway."
self nextPutAllAsChunk:aString.
self nextPut:(self class chunkSeparator)
"Modified: 9.12.1995 / 15:56:54 / cg"
!
nextPutAllAsChunk:aString
"put aString as a chunk onto the receiver;
double all exclamation marks except within primitives.
This modification of the chunk format (not doubling exclas in primitive code)
was done to have primitive code more readable and easier be edited in the fileBrowser
or other editors.
Its no incompatibility, since inline primitives are an ST/X special
and code containing ST/X primitives cannot be loaded into other smalltalks anyway."
|sep stopChars inPrimitive character
index "{ Class:SmallInteger }"
endIndex "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
next "{ Class:SmallInteger }"|
endIndex := aString size.
endIndex == 0 ifTrue:[^ self].
sep := self class chunkSeparator.
stopChars := '{}' copyWith:sep.
inPrimitive := false.
index := 1.
stop := endIndex + 1.
[index <= endIndex] whileTrue:[
"
find position of next interesting character;
output stuff up to that one in one piece
"
next := aString indexOfAny:stopChars startingAt:index ifAbsent:stop.
((index == 1) and:[next == stop]) ifTrue:[
self nextPutAll:aString
] ifFalse:[
self nextPutAll:aString startingAt:index to:(next - 1)
].
index := next.
(index <= endIndex) ifTrue:[
character := aString at:index.
(character == ${ ) ifTrue:[
"/ starts a primitive
((index > 1) and:[(aString at:index-1) == $%]) ifTrue:[
inPrimitive := true
]
] ifFalse:[
"/ ends a primitive
(character == $} ) ifTrue:[
((index > 1) and:[(aString at:index-1) == $%]) ifTrue:[
inPrimitive := false
]
] ifFalse:[
"/
"/ exclas have to be doubled - except if within a primitive
"/
inPrimitive ifFalse:[
(character == sep) ifTrue:[
self nextPut:sep
]
]
]
].
self nextPut:character.
index := index + 1.
].
].
(aString endsWith:Character cr) ifFalse:[
self cr.
].
"Modified: / 21.4.1998 / 17:22:47 / cg"
"/ foo
!
nextPutChunkSeparator
"append a chunk separator character"
self nextPut:(self class chunkSeparator)
"Created: 13.9.1995 / 17:39:26 / claus"
! !
!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).
].
^ OptionBox
request:message
label:'Error in fileIn'
form:(WarningBox iconBitmap)
buttonLabels:labels
values:values
default:#continue
onCancel:#abort.
"Modified: 10.1.1997 / 18:00:56 / cg"
!
fileIn
"file in from the receiver, i.e. read chunks and evaluate them -
return the value of the last chunk."
|oldPath val|
self isFileStream ifFalse:[
^ self fileInNotifying:(SourceFileLoader on:self) passChunk:true.
].
[ |thisDirectory|
oldPath := Smalltalk systemPath.
thisDirectory := self pathName asFilename directory.
Smalltalk systemPath:(oldPath copy addFirst:thisDirectory pathName; yourself).
CurrentFileInDirectoryQuerySignal answer:thisDirectory do:[
val := self fileInNotifying:(SourceFileLoader on:self) passChunk:true.
]
] ensure:[
Smalltalk systemPath:oldPath.
].
^ val
"Modified: / 16.10.1999 / 12:25:27 / cg"
!
fileInBinary
"file in from the receiver, i.e. read binary stored classes and/or objects.
Return the last object."
|bos obj|
bos := BinaryObjectStorage onOld:self.
Class nameSpaceQuerySignal
answer:Smalltalk
do:[
[self atEnd] whileFalse:[
obj := bos next.
]
].
bos close.
^ obj
"Created: / 13.11.2001 / 10:12:30 / cg"
"Modified: / 13.11.2001 / 10:14:04 / cg"
!
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
!
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.
"
|aString sawExcla rslt done|
self skipSeparators.
self atEnd ifFalse:[
sawExcla := self peekFor:(self class chunkSeparator).
aString := self nextChunk.
"/
"/ handle empty chunks;
"/ this allows for Squeak code to be filedIn
"/
[aString size == 0
and:[self atEnd not]] whileTrue:[
aString := self nextChunk.
].
aString size ~~ 0 ifTrue:[
passChunk ifTrue:[
someone source:aString
].
sawExcla ifFalse:[
rslt := Smalltalk::Compiler evaluate:aString notifying:someone.
] ifTrue:[
Smalltalk::Compiler emptySourceNotificationSignal handle:[:ex |
^ nil
] do:[
rslt := Smalltalk::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 ifTrue:[
"
however, if that was nil (i.e. some error), we skip chunks
up to the next empty chunk.
"
Transcript showCR:'skipping chunks ...'.
done := false.
[done] whileFalse:[
aString := self nextChunk.
done := (aString size == 0).
]
] ifFalse:[
rslt := rslt
fileInFrom:self
notifying:someone
passChunk:passChunk
single:false
silent:beSilent
]
]
]
].
^ rslt
"Modified: 14.10.1997 / 17:10:35 / cg"
!
fileInNotifying: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'
]
].
"/ 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:(Object errorSignal).
passedSignals add:(Object errorSignal).
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 errorString.
what isNil ifTrue:[
what := ex signal notifierString.
].
"/ handle the case where no GUI has been built in,
"/ just abort the fileIn with a notification
Display isNil ifTrue:[
sender := ex suspendedContext sender.
self notify:(what ,
' in ' , sender receiver class name ,
'>>>' , sender selector).
ex return
].
msg := msg bindWith:what.
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'
form:(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:#continue
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 ? #continue)
].
action == #abort ifTrue:[
AbortSignal raise.
ex return
].
action == #skip ifTrue:[
ex proceedWith:nil
].
action == #debug ifTrue:[
Debugger enter:ex suspendedContext
withMessage:ex errorString
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"
!
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.
! !
!PositionableStream methodsFor:'positioning'!
backStep
"move backward read position by one"
self position:(self position - 1)
!
position
"return the read position"
^ position
!
position:index
"set the read (or write) position"
"/ FIX: allow positioning right after last element of stream
"/ ((index > readLimit) or:[index < 0]) ifTrue: [^ self positionError].
((index > (readLimit+1)) or:[index < ZeroPosition]) ifTrue: [^ self positionError:index].
position := index
"
|s|
s := '1234567890' readStream.
s next:5.
s position:1.
s next:7.
"
"
|s|
s := '' writeStream.
s nextPutAll:'1234567890'.
s position:5.
s nextPutAll:'abcdefg'.
s contents
"
"
|s|
s := '' writeStream.
s nextPutAll:'1234567890'.
s position:0.
s nextPutAll:'abcdefg'.
s contents
"
!
reset
"set the read position to the beginning of the collection"
self resetPosition
"
|s|
s := 'hello world' readStream.
Transcript showCR:(s next:5).
s reset.
Transcript showCR:(s next:10).
"
!
resetPosition
"set the read position to the beginning of the collection"
position := self class zeroPosition
"
|s|
s := 'hello world' readStream.
Transcript showCR:(s next:5).
s reset.
Transcript showCR:(s next:10).
"
!
setToEnd
"set the read position to the end of the collection"
position := readLimit
!
skip:numberToSkip
"skip the next numberToSkip elements"
numberToSkip ~~ 0 ifTrue:[
self position:(self position + numberToSkip)
]
!
skipThroughAll:aCollection
"skip for and through the sequence given by the argument, aCollection;
return nil if not found, self otherwise.
On a successful match, the next read will return elements after aCollection;
if no match was found, the receiver will be positioned at the end.
This is redefined here, to make use of positioning."
|buffer l first idx|
l := aCollection size.
first := aCollection at:1.
[self atEnd] whileFalse:[
buffer := self nextAvailable:l.
buffer = aCollection ifTrue:[
^ self
].
idx := buffer indexOf:first startingAt:2.
idx == 0 ifFalse:[
self position:(self position - l + idx - 1)
]
].
^ nil
"
|s|
s := ReadStream on:'12345678901234567890'.
s skipThroughAll:'901'.
s upToEnd
"
"
|s|
s := ReadStream on:'12345678901234567890'.
s skipThroughAll:'1234'.
s upToEnd
"
"
|s|
s := ReadStream on:'12345678901234567890'.
s skipThroughAll:'999'.
s atEnd
"
"Created: 26.6.1996 / 09:35:35 / cg"
"Modified: 11.1.1997 / 19:16:38 / cg"
!
skipToAll:aCollection
"skip for the sequence given by the argument, aCollection;
return nil if not found, self otherwise.
On a successful match, the next read will return elements of aCollection."
|oldPos buffer l first idx|
oldPos := self position.
l := aCollection size.
first := aCollection at:1.
[self atEnd] whileFalse:[
buffer := self next:l.
buffer = aCollection ifTrue:[
self position:(self position - l).
^ self
].
idx := buffer indexOf:first startingAt:2.
idx == 0 ifFalse:[
self position:(self position - l + idx - 1)
]
].
self position:oldPos.
^ nil
"
|s|
s := ReadStream on:'12345678901234567890'.
s skipToAll:'901'.
s upToEnd
"
"Modified: 26.6.1996 / 09:28:27 / cg"
"Created: 26.6.1996 / 09:35:06 / cg"
! !
!PositionableStream methodsFor:'private'!
contentsSpecies
"return a class of which instances will be returned, when
parts of the collection are asked for.
(see upTo-kind of methods in subclasses)"
^ collection species
!
on:aCollection
"setup for streaming on aCollection"
collection := aCollection.
readLimit := aCollection size.
position := "0" 1
!
on:aCollection from:first to:last
"setup for streaming on aCollection from first to last"
collection := aCollection.
position := first.
readLimit := last
!
positionError
"{ Pragma: +optSpace }"
"report an error when positioning past the end
or before the beginning."
^ InvalidPositionErrorSignal raiseRequestWith:nil
"Modified: / 26.7.1999 / 10:59:13 / stefan"
!
positionError:badPostition
"{ Pragma: +optSpace }"
"report an error when positioning past the end
or before the beginning."
^ InvalidPositionErrorSignal raiseRequestWith:badPostition
!
with:aCollection
"setup for streaming to the end of aCollection"
collection := aCollection.
readLimit := aCollection size + 1.
self setToEnd
! !
!PositionableStream methodsFor:'queries'!
isPositionable
"return true, if the stream supports positioning (this one is)"
^ true
! !
!PositionableStream methodsFor:'reading'!
upToAll:aCollection
"read until a subcollection consisisting of the elements in aCollection
is encountered.
Return everything read excluding the elements in aCollection.
The position is left before the collection; i.e. the next
read operations will return those elements.
If no such subcollection is encountered, all elements up to the end
are read and returned.
See also #throughAll: which also reads up to some objects
but positions behind it and DOES include it in the returned
collection.
See also #upToAllExcluding:, which returns the same, but leaves the
read pointer after the matched subcollection.
Note: this behavior is inconsistent with the other upTo.. methods,
which position after the found item. We implement the method
this way for the sake of ST80-compatibility."
|answerStream element last rslt|
last := aCollection last.
answerStream := WriteStream on:(self contentsSpecies new).
[self atEnd] whileFalse:[
element := self next.
answerStream nextPut:element.
element == last ifTrue:[
((rslt := answerStream contents) endsWith:aCollection) ifTrue:[
self position:(self position - aCollection size).
^ rslt copyWithoutLast:aCollection size
]
].
].
^ answerStream contents
"
|s|
s := ReadStream on:'hello world'.
Transcript show:'<'; show:(s upToAll:'wo'); showCR:'>'.
Transcript showCR:s atEnd.
Transcript show:'<'; show:(s upToEnd); showCR:'>'.
"
"
|s|
s := ReadStream on:'hello world'.
Transcript show:'<'; show:(s upToAll:'xx'); showCR:'>'.
Transcript showCR:s atEnd.
Transcript show:'<'; show:(s upToEnd); showCR:'>'.
"
"Modified: / 12.1.1998 / 22:06:42 / cg"
"Created: / 12.1.1998 / 22:07:01 / cg"
! !
!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 class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/PositionableStream.st,v 1.111 2002-05-08 14:30:05 stefan Exp $'
! !
PositionableStream initialize!