"

 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.

"

PeekableStream subclass:#PositionableStream

       instanceVariableNames:'collection position readLimit'

       poolDictionaries:''

       category:'Streams'

!

PositionableStream comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

'!

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

"

!

version

"

"

!

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.

"

! !

!PositionableStream class methodsFor:'initialization'!

initialize

    "setup the signal used to handle errors during fileIn"

    ErrorDuringFileInSignal isNil ifTrue:[

	Object initialize.

	ErrorDuringFileInSignal := Object errorSignal newSignalMayProceed:true.

	ErrorDuringFileInSignal nameClass:self message:#errorDuringFileInSignal.

	ErrorDuringFileInSignal notifierString:'error during fileIn'.

    ]

! !

!PositionableStream class methodsFor:'constants'!

chunkSeparator

    "return the chunk-separation character"

! !

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

    |newStream|

    newStream := (self basicNew) on:aCollection.

    newStream position:first "-1".

    newStream readLimit:last.

    ^ newStream

!

with:aCollection

    "return a new PositionableStream streaming on aCollection,

     the stream is positioned to the end of the collection."

    ^ (self on:aCollection) setToEnd

! !

!PositionableStream methodsFor:'private'!

on:aCollection

    "setup for streaming on aCollection"

    collection := aCollection.

    readLimit := aCollection size.

    position := "0" 1

!

positionError

    "report an error when positioning past the end"

    ^ self error:'cannot position past end of collection'

! !

!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

! !

!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

!

peekFor:something

    "return true and move past if next == something; 

     otherwise stay and let position unchanged"

    self next == something ifTrue:[

	^ true

    ].

    self backStep.

    ^ false

!

readLimit:aNumber

    "set the read-limit"

    readLimit := aNumber

! !

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

position

    "return the read position"

    ^ position

!

position:index

    "set the read position"

    ((index > readLimit) or:[index < 0]) ifTrue: [^ self positionError].

    position := index

!

backStep

    "move backward read position by one"

    position <= 0 ifTrue: [^ self positionError].

    position := position - 1

!

reset

    "set the read position to the beginning of the collection"

    position := "0" 1

!

setToEnd

    "set the read position to the end of the collection"

    position := readLimit

!

skip:numberToSkip

    "skip the next numberToSkip elements"

    self position:(position + numberToSkip)

! !

!PositionableStream methodsFor:'chunk input/output'!

nextChunk

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

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

     they are undoubled here.

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

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

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

     read chunks containing primitive code 

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

    |theString sep newString done thisChar nextChar inPrimitive

     index    "{ Class:SmallInteger }"

     currSize "{ Class:SmallInteger }" |

    theString := String new:500.

    currSize := 500.

    thisChar := self skipSeparators.

    thisChar := self next.

    index := 0.

    done := false.

    inPrimitive := false.

    [done] whileFalse:[

	((index + 2) <= currSize) ifFalse:[

	    newString := String new:(currSize * 2).

	    newString replaceFrom:1 to:currSize with:theString.

	    currSize := currSize * 2.

	    theString := newString

	].

	thisChar isNil ifTrue:[

	    done := true

	] ifFalse:[

	    (thisChar == $% ) ifTrue:[

		nextChar := self peek.

		(nextChar == ${ ) ifTrue:[

		    inPrimitive := true.

		    index := index + 1.

		    theString at:index put:thisChar.

		    thisChar := self next

		] ifFalse:[

		    (nextChar == $} ) ifTrue:[

			inPrimitive := false.

			index := index + 1.

			theString at:index put:thisChar.

			thisChar := self next

		    ]

		]

	    ] ifFalse:[

		inPrimitive ifFalse:[

		    (thisChar == sep) ifTrue:[

			(self peek == sep) ifFalse:[

			    done := true

			] ifTrue:[

			    self next

			]

		    ]

		]

	    ]

	].

	done ifFalse:[

	    index := index + 1.

	    theString at:index put:thisChar.

	    thisChar := self next

	]

    ].

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

    ^ theString copyTo:index

!

nextChunkPut:aString

    "put aString as a chunk onto the receiver;

     double all exclamation marks except within primitives and append a 

    |sep gotPercent inPrimitive character

     index    "{ Class:SmallInteger }"

     endIndex "{ Class:SmallInteger }"

     stop     "{ Class:SmallInteger }"

     next     "{ Class:SmallInteger }"|

    inPrimitive := false.

    gotPercent := false.

    index := 1.

    endIndex := aString size.

    stop := endIndex + 1.

    [index <= endIndex] whileTrue:[

	"

	 find position of next interresting character; 

	 output stuff up to that one in one piece

	"

	next := aString indexOf:$% startingAt:index ifAbsent:stop.

	next := next min:

		(aString indexOf:${ startingAt:index ifAbsent:stop).

	next := next min:

		(aString indexOf:$} startingAt:index ifAbsent:stop).

	next := next min:

		(aString indexOf:sep 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:[

		gotPercent := true

	    ] ifFalse:[

		(character == ${ ) ifTrue:[

		    gotPercent ifTrue:[

			inPrimitive := true

		    ]

		] ifFalse:[

		    (character == $} ) ifTrue:[

			gotPercent ifTrue:[

			    inPrimitive := false

			]

		    ] ifFalse:[

			inPrimitive ifFalse:[

			    (character == sep) ifTrue:[

				self nextPut:sep

			    ]

			]

		    ]

		].

		gotPercent := false

	    ].

	    self nextPut:character.

	    index := index + 1

	]

    ].

    self nextPut:sep

! !

!PositionableStream methodsFor:'fileIn'!

fileIn

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

     return the value of the last chunk."

    ^ self fileInNotifying:self

!

fileInNextChunk

    "read next chunk, evaluate it and return the result"

    ^ self fileInNextChunkNotifying:nil

!

fileInNotifying:someone

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

    Object errorSignal handle:[:ex |

	|action what|

	"handle the case where no GUI has been built in,

	 just abort the fileIn with a notification"

	Display isNil ifTrue:[

	    self notify:(ex signal notifierString , 

			 ' in ' , ex suspendedContext sender receiver class name ,

			 '>>>' , ex suspendedContext sender selector).

	    ex return

	].

	"otherwise ask what should be done now and either

	 continue or abort the fileIn"

	what := ex errorString.

	what isNil ifTrue:[

	    what := ex signal notifierString.

	].

	action := self askForDebug:('error in fileIn: ' , what) withCRs.

	action == #continue ifTrue:[

	    ex proceed

	].

	action == #abort ifTrue:[

	    ex return

	].

"/        Debugger enter:ex suspendedContext

	(ex signal) enterDebuggerWith:ex message:(ex errorString).

	"ex reject"

    ] do:[

	[self atEnd] whileFalse:[

	    lastValue := self fileInNextChunkNotifying:someone

	]

    ].

    ^ lastValue

!

fileInNextChunkNotifying:someone

    "read next chunk, evaluate it and return the result;

    self skipSeparators.

    self atEnd ifFalse:[

	aString := self nextChunk.

	aString size ~~ 0 ifTrue:[

	    rslt := Compiler evaluate:aString notifying:someone.

	    sawExcla ifTrue:[

		"

		 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.

		    ]

		] ifFalse:[

		    rslt := rslt fileInFrom:self notifying:someone

		]

	    ]

	]

    ].

    ^ rslt

!

askForDebug:message

    "launch a box asking if a debugger is wanted - used when an error

     occurs while filing in"

    |box|

    Smalltalk isInitialized ifFalse:[

	'error during startup: ' errorPrint. message errorPrintNL.

	^ #debug

    ].

    box := OptionBox title:message numberOfOptions:3.

    box actions:(Array with:[^ #abort]

		       with:[^ #debug]

		       with:[^ #continue]).

    box buttonTitles:#('abort' 'debug' 'continue').

    box label:'fileIn Error'.

    box showAtPointer.

    ^ #abort

! !

!PositionableStream methodsFor:'fileIn error handling'!