"

 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 writeLimit'

	classVariableNames:'ErrorDuringFileInSignal 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.

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

	ChunkSeparator := $!!

    ]

! !

!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:'constants'!

chunkSeparator

    "return the chunk-separation character"

    ^ ChunkSeparator

! !

!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; 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'!

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

    sep := ChunkSeparator.

    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 

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

    sep := ChunkSeparator.

    stopChars := '{}' copyWith:sep.

    inPrimitive := false.

    index := 1.

    endIndex := aString size.

    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

	]

    ].

    "Modified: 9.12.1995 / 15:56:47 / cg"

!

nextPutChunkSeparator

    "append a chunk separator character"

    self nextPut: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"

    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

    ].

    ^ OptionBox 

          request:message 

          label:'Error in fileIn'

          form:(WarningBox iconBitmap)

          buttonLabels:#('cancel' 'debug' 'continue')

          values:#(#abort #debug #continue)

          default:#continue.

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

    ^ self fileInNotifying:(SourceFileLoader on:self) passChunk:true

!

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.

    "

    |aString sawExcla rslt done|

    self skipSeparators.

    self atEnd ifFalse:[

	sawExcla := self peekFor:ChunkSeparator.

	aString := self nextChunk.

	aString size ~~ 0 ifTrue:[

	    passChunk ifTrue:[

		someone source:aString

	    ].

	    sawExcla ifFalse:[

		rslt := Compiler evaluate:aString notifying:someone.

	    ] ifTrue:[

		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 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) or:[aString isEmpty].

		    ]

		] ifFalse:[

		    rslt := rslt fileInFrom:self notifying:someone  passChunk:passChunk

		]

	    ]

	]

    ].

    ^ rslt

    "Modified: 18.5.1996 / 15:44:21 / cg"

!

fileInNotifying:someone passChunk:passChunk

    "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 queries pkg spc spaces|

    queries := SignalSet with:(Class packageQuerySignal)

                         with:(Class nameSpaceQuerySignal)

                         with:(Class usedNameSpaceQuerySignal).

    queries handle:[:ex |

        ex signal == Class packageQuerySignal ifTrue:[

            pkg isNil ifTrue:[

                (someone respondsTo:#packageToInstall) ifFalse:[

                    pkg := Class packageQuerySignal raise.

                ] ifTrue:[

                    pkg := someone packageToInstall

                ].

            ].

            ex proceedWith:pkg

        ].

        ex signal == Class nameSpaceQuerySignal ifTrue:[

            spc isNil ifTrue:[

                (someone respondsTo:#currentNameSpace) ifFalse:[

                    spc := Class nameSpaceQuerySignal raise.

                ] ifTrue:[

                    spc := someone currentNameSpace

                ].

            ].

            ex proceedWith:spc

        ].

        ex signal == Class usedNameSpaceQuerySignal ifTrue:[

            spaces isNil ifTrue:[

                (someone respondsTo:#usedNameSpaces) ifFalse:[

                    spaces := Class usedNameSpaceQuerySignal raise.

                ] ifTrue:[

                    spaces := someone usedNameSpaces

                ].

            ].

            ex proceedWith:spaces

        ].

    ] do:[

        "

         catch any errors during fileIn 

         - offer debug/abort/continue choice

        "

        ErrorSignal handle:[:ex |

            |action what sender msg param oldPackage newPackage|

            "/ for your convenience ...

            ex signal == Class methodRedefinitionSignal ifTrue:[

                param := ex parameter. "/ an association: oldMethod -> newMethod

                oldPackage := param key package.

                newPackage := param value package.

                msg := 'trying to overwrite method:\\    %1\\in package ''' 

                       , oldPackage , ''' with method from package ''' , newPackage , ''''

            ] 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

            ].

            "otherwise ask what should be done now and either

             continue or abort the fileIn"

            action := self askForDebug:(msg bindWith:what) withCRs.

            action == #continue ifTrue:[

                ex proceed

            ].

            action == #abort ifTrue:[

                ex return

            ].