"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

PeekableStream subclass:#PositionableStream

	instanceVariableNames:'collection position readLimit writeLimit'

	classVariableNames:'ZeroPosition InvalidPositionErrorSignal ErrorDuringFileInSignal

		CurrentFileInDirectoryQuerySignal ChunkSeparator'

	poolDictionaries:''

	category:'Streams'

!

!PositionableStream class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Instances of PositionableStream allow positioning the read pointer.

    The PositionableStream class also adds methods for source-chunk reading

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

    This is an abstract class.

    Compatibility Notice:

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

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

    THIS CERTAINLY IS BAD.

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

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

       posZero := (PositionableStream class respondsTo:#zeroPosition) 

		       ifTrue:[PositionableStream zeroPosition]

		       ifFalse:[0] 

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

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

    [author:]

	Claus Gittinger

"

! !

!PositionableStream class methodsFor:'initialization'!

initialize

    "setup the signal used to handle errors during fileIn"

    ZeroPosition := 1.

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

    ]

! !

!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 class methodsFor:'queries'!

currentFileInDirectory

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

    ^ CurrentFileInDirectoryQuerySignal query

! !

!PositionableStream methodsFor:'Compatibility - Dolphin'!

endChunk

    self nextPutChunkSeparator

! !

!PositionableStream methodsFor:'accessing'!

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

    ].

    AbortAllSignal isHandled ifTrue:[

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

      values := #(#cancelAll) , values.

    ].

    ^ 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 notifiedLoader|

    SourceFileLoader notNil ifTrue:[

	notifiedLoader := SourceFileLoader on:self.

    ].

    self isFileStream ifFalse:[

	^ self fileInNotifying:notifiedLoader 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:notifiedLoader 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 notNil ifTrue:[someone source:aString]

	    ].

	    sawExcla ifFalse:[

		rslt := Smalltalk::Compiler evaluate:aString notifying:someone.