--- a/PeekableStream.st Thu Feb 16 20:36:05 2017 +0100
+++ b/PeekableStream.st Thu Feb 16 20:38:45 2017 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
@@ -224,39 +226,39 @@
"file in from the receiver, i.e. read chunks and evaluate them -
return the value of the last chunk."
- |notifiedLoader lastValue|
+ |notifiedLoader|
SourceFileLoader notNil ifTrue:[
notifiedLoader := SourceFileLoader on:self.
].
- Class nameSpaceQuerySignal handle:[:ex |
- ex proceedWith:Smalltalk
- ] do:[
- lastValue := self fileInNotifying:notifiedLoader passChunk:true.
+ ^ Class nameSpaceQuerySignal answer:Smalltalk do:[
+ self fileInNotifying:notifiedLoader passChunk:true.
].
- ^ lastValue.
+
+ "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 obj|
+
+ |bos|
bos := BinaryObjectStorage onOld:self.
- Class nameSpaceQuerySignal
- answer:Smalltalk
- do:[
- [self atEnd] whileFalse:[
- obj := bos next.
- ]
- ].
- bos close.
- ^ obj
+ ^ [
+ |obj|
- "Created: / 13.11.2001 / 10:12:30 / cg"
- "Modified: / 13.11.2001 / 10:14:04 / cg"
+ [ 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'!
@@ -368,27 +370,176 @@
return the value of the last chunk.
Someone (which is usually some codeView) is notified of errors."
- ^(EncodedStream decodedStreamFor:self) basicFileInNotifying:someone passChunk:passChunk
+ |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.
- "Modified: / 10-09-1999 / 16:54:01 / stefan"
+ 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.
+ 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
+ ^ self fileInNextChunkNotifying:someone passChunk:false silent:nil.
+
+ "Modified: / 16-02-2017 / 15:17:22 / stefan"
!
fileInNextChunkNotifying:someone passChunk:passChunk
@@ -418,86 +569,90 @@
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 done compiler lastClass|
+ |aString sawExcla rslt compiler lastClass|
self skipSeparators.
- self atEnd ifFalse:[
- sawExcla := self peekFor:(self class chunkSeparator).
+ 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.
- "/
- "/ handle empty chunks;
- "/ this allows for Squeak code to be filedIn
- "/
- [aString size == 0 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
].
- aString size ~~ 0 ifTrue:[
- passChunk ifTrue:[
- someone notNil ifTrue:[someone source:aString]
- ].
- someone perform:#reader: with:(SourceFileLoader::SourceFileReader new) ifNotUnderstood:[].
- compiler := (Smalltalk at:#Compiler) new.
- compiler allowUndeclaredVariables:false.
+ ] ifTrue:[
+ "/ methodsFor chunks, etc., which generate a reader
+ (Smalltalk at:#Compiler) emptySourceNotificationSignal handle:[:ex |
+ ^ nil
+ ] do:[
+ rslt := compiler
+ evaluate:aString
+ notifying:someone
+ compile: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
+ "
+ 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:[
- lastClass := nil
- ].
- ] ifTrue:[
- "/ methodsFor chunks, etc., which generate a reader
- (Smalltalk at:#Compiler) 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 ...'.
- done := false.
- [done] whileFalse:[
- aString := self nextChunk.
- done := (aString size == 0).
- ]
- ] 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
- ].
- ]
- ]
+ 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 (comment): / 16-02-2017 / 15:16:55 / stefan"
!
fileInNotifying:notifiedLoader passChunk:passChunk
@@ -508,6 +663,41 @@
^ 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)"