--- a/Smalltalk.st Fri Mar 22 12:10:00 2013 +0100
+++ b/Smalltalk.st Fri Mar 22 12:47:11 2013 +0100
@@ -383,9 +383,9 @@
ObjectMemory recursionInterruptHandler:self.
OperatingSystem isOSXlike ifTrue:[
- "/ OSX sends SIGABRT for NSExceptions
- OperatingSystem operatingSystemSignal:(OperatingSystem sigABRT) install:NSException.
- OperatingSystem enableAbortInterrupts.
+ "/ OSX sends SIGABRT for NSExceptions
+ OperatingSystem operatingSystemSignal:(OperatingSystem sigABRT) install:NSException.
+ OperatingSystem enableAbortInterrupts.
].
"
@@ -1368,24 +1368,24 @@
i2 := 1.
ns := self.
[i2 ~~ 0] whileTrue:[
- i2 := newName indexOfSubCollection:'::' startingAt:i1.
- i2 ~~ 0 ifTrue:[
- nm := newName copyFrom:i1 to:i2-1.
- ns isNameSpace ifTrue:[
- subns := ns at:nm asSymbol ifAbsent:nil.
- subns isNil ifTrue:[
- self error:'Nonexisting namespace: ',nm.
- ^ nil.
- ].
- ] ifFalse:[
- subns := ns privateClassesAt:nm asSymbol.
- subns isNil ifTrue:[
- self error:'Cannot create a namespace below a class'
- ]
- ].
- ns := subns.
- i1 := i2 + 2.
- ].
+ i2 := newName indexOfSubCollection:'::' startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ nm := newName copyFrom:i1 to:i2-1.
+ ns isNameSpace ifTrue:[
+ subns := ns at:nm asSymbol ifAbsent:nil.
+ subns isNil ifTrue:[
+ self error:'Nonexisting namespace: ',nm.
+ ^ nil.
+ ].
+ ] ifFalse:[
+ subns := ns privateClassesAt:nm asSymbol.
+ subns isNil ifTrue:[
+ self error:'Cannot create a namespace below a class'
+ ]
+ ].
+ ns := subns.
+ i1 := i2 + 2.
+ ].
].
oldName := aClass name.
@@ -1396,8 +1396,8 @@
privateClasses := aClass privateClassesSorted.
((self at:oldSym) ~~ aClass) ifTrue:[
- 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
- ^ self
+ 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
+ ^ self
].
"/ rename the class
@@ -1406,42 +1406,42 @@
"/ change the owning class
ns isNameSpace ifFalse:[
- aClass isPrivate ifTrue:[
- aClass class setOwningClass:ns.
- ] ifFalse:[
- "/ sigh - must make a PrivateMetaclass from Metaclass
- oldMetaclass := aClass class.
- newMetaclass := PrivateMetaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
- newMetaclass setOwningClass:ns.
-
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ aClass class setOwningClass:ns.
+ ] ifFalse:[
+ "/ sigh - must make a PrivateMetaclass from Metaclass
+ oldMetaclass := aClass class.
+ newMetaclass := PrivateMetaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+ newMetaclass setOwningClass:ns.
+
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
] ifTrue:[
- aClass isPrivate ifTrue:[
- newCategory := aClass topOwningClass category.
-
- "/ sigh - must make a Metaclass from PrivateMetaclass
- oldMetaclass := aClass class.
-
- newMetaclass := Metaclass new.
- newMetaclass flags:(oldMetaclass flags).
- newMetaclass setSuperclass:(oldMetaclass superclass).
- newMetaclass instSize:(oldMetaclass instSize).
- newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
- newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
- newMetaclass setSoleInstance:aClass.
-
- aClass category:newCategory.
- aClass changeClassTo:newMetaclass.
- ObjectMemory flushCaches.
- ]
+ aClass isPrivate ifTrue:[
+ newCategory := aClass topOwningClass category.
+
+ "/ sigh - must make a Metaclass from PrivateMetaclass
+ oldMetaclass := aClass class.
+
+ newMetaclass := Metaclass new.
+ newMetaclass flags:(oldMetaclass flags).
+ newMetaclass setSuperclass:(oldMetaclass superclass).
+ newMetaclass instSize:(oldMetaclass instSize).
+ newMetaclass setInstanceVariableString:(oldMetaclass instanceVariableString).
+ newMetaclass setMethodDictionary:(oldMetaclass methodDictionary).
+ newMetaclass setSoleInstance:aClass.
+
+ aClass category:newCategory.
+ aClass changeClassTo:newMetaclass.
+ ObjectMemory flushCaches.
+ ]
].
aClass setName:newSym.
@@ -1461,32 +1461,32 @@
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- oldCVSym := (oldSym , ':' , name) asSymbol.
- value := self at:oldCVSym.
- self at:oldCVSym put:nil.
-
- "/
- "/ see comment in #removeKey: on why we dont remove it it here
- "/
- "/ self removeKey:cSym.
-
- newCVSym := (newSym , ':' , name) asSymbol.
- self at:newCVSym put:value.
-
- oldNameToNewName at:oldCVSym put:newCVSym.
+ oldCVSym := (oldSym , ':' , name) asSymbol.
+ value := self at:oldCVSym.
+ self at:oldCVSym put:nil.
+
+ "/
+ "/ see comment in #removeKey: on why we dont remove it it here
+ "/
+ "/ self removeKey:cSym.
+
+ newCVSym := (newSym , ':' , name) asSymbol.
+ self at:newCVSym put:value.
+
+ oldNameToNewName at:oldCVSym put:newCVSym.
].
"/ patch methods literal arrays from oldCVname to newCVname
oldNameToNewName keysAndValuesDo:[:oldNameSym :newNameSym |
- aClass withAllSubclasses do:[:aSubClass |
- Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
- aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ].
- ].
-
- "/ and also in privateClasses ? ...
+ aClass withAllSubclasses do:[:aSubClass |
+ Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
+ aSubClass instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ].
+ ].
+
+ "/ and also in privateClasses ? ...
"/ privateClasses size > 0 ifTrue:[
"/ privateClasses do:[:aPrivateClass |
@@ -1509,85 +1509,85 @@
newNameSpace := aClass topNameSpace.
privateClasses size > 0 ifTrue:[
- "/ must rename privateClasses as well
- Class withoutUpdatingChangesDo:[
- privateClasses do:[:aPrivateClass |
- self renameClass:aPrivateClass
- to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
-
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
- aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ "/ must rename privateClasses as well
+ Class withoutUpdatingChangesDo:[
+ privateClasses do:[:aPrivateClass |
+ self renameClass:aPrivateClass
+ to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
+
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theNonMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
+ aClass theMetaclass recompileMethodsAccessingGlobal:(aPrivateClass nameWithoutPrefix) asSymbol.
"/ ClassBuilder
"/ recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
"/ in:newNameSpace
"/ except:nil.
- ]
- ]
+ ]
+ ]
].
oldNameSpace ~~ newNameSpace ifTrue:[
- "/ all those referencing the class from the old nameSpace
- "/ must be recompiled ...
- "/ (to now access the global from smalltalk)
-
- oldNameSpace ~~ Smalltalk ifTrue:[
- Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldName asSymbol
- in:oldNameSpace
- except:nil.
- ].
-
- "/ all referencing the class in the new namespace
- "/ as well; to now access the new class.
-
- (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
-
- ClassBuilder
- recompileGlobalAccessorsTo:oldBaseName asSymbol
- in:newNameSpace
- except:nil.
- ].
+ "/ all those referencing the class from the old nameSpace
+ "/ must be recompiled ...
+ "/ (to now access the global from smalltalk)
+
+ oldNameSpace ~~ Smalltalk ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldName asSymbol
+ in:oldNameSpace
+ except:nil.
+ ].
+
+ "/ all referencing the class in the new namespace
+ "/ as well; to now access the new class.
+
+ (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
+
+ ClassBuilder
+ recompileGlobalAccessorsTo:oldBaseName asSymbol
+ in:newNameSpace
+ except:nil.
+ ].
] ifFalse:[
- "/ all references to a global with my new name in my owning class
- "/ must now be redirected to myself.
-
- aClass isPrivate ifTrue:[
- newBaseName := aClass nameWithoutNameSpacePrefix.
- newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
-
- Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
- aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
- aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
- ]
+ "/ all references to a global with my new name in my owning class
+ "/ must now be redirected to myself.
+
+ aClass isPrivate ifTrue:[
+ newBaseName := aClass nameWithoutNameSpacePrefix.
+ newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
+ ]
].
aClass changed:#definition.
"/ because of the change of my superclasses name ...
aClass allSubclassesDo:[:subClass |
- subClass changed:#definition.
+ subClass changed:#definition.
].
"/ because of the change of my superclasses name ...
aClass subclassesDo:[:subClass |
- subClass addChangeRecordForClass:subClass.
+ subClass addChangeRecordForClass:subClass.
].
self changed:#definition.
self changed:#classRename with:(Array with:aClass with:oldName).
@@ -1980,6 +1980,22 @@
].
!
+allMethodsForWhich:aBlock
+ "return a collection of methods for which aBlock returns true"
+
+ |coll|
+
+ coll := OrderedCollection new.
+ Smalltalk allClassesDo:[:eachClass |
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ (aBlock value:mthd) ifTrue:[
+ coll add:mthd
+ ].
+ ]
+ ].
+ ^ coll
+!
+
allMethodsWithSelectorDo:aTwoArgBlock
"enumerate all methods in all classes and evaluate aBlock
with method and selector as arguments."
@@ -2261,28 +2277,28 @@
"/ if there is a projectDefinition, let it load itself...
def := packageId projectDefinitionClass.
(def notNil and:[def isLoaded]) ifTrue:[
- def loadAsAutoloaded:doLoadAsAutoloaded.
- ^ true.
+ def loadAsAutoloaded:doLoadAsAutoloaded.
+ ^ true.
].
packageDir := self packageDirectoryForPackageId:packageId.
packageDir isNil ifTrue:[
- (packageString includes:$:) ifFalse:[
- "/ assume stx
- packageDir := self packageDirectoryForPackageId:('stx:',packageString).
- ].
+ (packageString includes:$:) ifFalse:[
+ "/ assume stx
+ packageDir := self packageDirectoryForPackageId:('stx:',packageString).
+ ].
].
(self
- loadPackage:packageString
- fromDirectory:packageDir
- asAutoloaded:doLoadAsAutoloaded) ifTrue: [^ true].
+ loadPackage:packageString
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded) ifTrue: [^ true].
AbstractSourceCodeManager notNil ifTrue:[
- sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage: packageString.
- sourceCodeManager notNil ifTrue:[
- ^ sourceCodeManager loadPackageWithId: packageString fromRepositoryAsAutoloaded: doLoadAsAutoloaded
- ].
+ sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage: packageString.
+ sourceCodeManager notNil ifTrue:[
+ ^ sourceCodeManager loadPackageWithId: packageString fromRepositoryAsAutoloaded: doLoadAsAutoloaded
+ ].
].
^ false
@@ -2394,12 +2410,12 @@
loadOK loadErrorOccurred exePath|
packageDirOrStringOrNil notNil ifTrue:[
- packageDir := packageDirOrStringOrNil asFilename.
+ packageDir := packageDirOrStringOrNil asFilename.
].
VerboseLoading ifTrue:[
- silent := false
+ silent := false
] ifFalse:[
- silent := (SilentLoading or:[ StandAlone ]) or:[ InfoPrinting not ].
+ silent := (SilentLoading or:[ StandAlone ]) or:[ InfoPrinting not ].
].
"For now: have to read the project definition first!!
@@ -2413,31 +2429,31 @@
false ifTrue:[
"if not, file it in ..."
(projectDefinitionClass isNil and:[packageDir notNil]) ifTrue:[
- projectDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageString.
- "/ try to load the project definition class
- projectDefinitionFilename := (packageDir / projectDefinitionClassName) withSuffix:'st'.
- projectDefinitionFilename exists ifFalse:[
- projectDefinitionFilename := (packageDir / 'source' / projectDefinitionClassName) withSuffix:'st'.
- ].
- projectDefinitionFilename exists ifTrue:[
- Class withoutUpdatingChangesDo:[
- Smalltalk silentlyLoadingDo:[
- projectDefinitionFilename fileIn.
- ].
- ].
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass loadDirectory:(projectDefinitionFilename asFilename directory)
- ]
- ].
+ projectDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageString.
+ "/ try to load the project definition class
+ projectDefinitionFilename := (packageDir / projectDefinitionClassName) withSuffix:'st'.
+ projectDefinitionFilename exists ifFalse:[
+ projectDefinitionFilename := (packageDir / 'source' / projectDefinitionClassName) withSuffix:'st'.
+ ].
+ projectDefinitionFilename exists ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ Smalltalk silentlyLoadingDo:[
+ projectDefinitionFilename fileIn.
+ ].
+ ].
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ projectDefinitionClass notNil ifTrue:[
+ projectDefinitionClass loadDirectory:(projectDefinitionFilename asFilename directory)
+ ]
+ ].
].
projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass autoload.
- somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
- (silent not and:[somethingHasBeenLoaded]) ifTrue:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
- ].
- ^ true.
+ projectDefinitionClass autoload.
+ somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
+ (silent not and:[somethingHasBeenLoaded]) ifTrue:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
+ ].
+ ^ true.
].
].
@@ -2445,7 +2461,7 @@
"Is there a shared library (.dll or .so) ?"
shLibName := aPackageString asPackageId libraryName asFilename
- withSuffix:ObjectFileLoader sharedLibrarySuffix.
+ withSuffix:ObjectFileLoader sharedLibrarySuffix.
"/ silent ifFalse:[
"/ Transcript showCR:('looking for binary classLib file: ' , shLibName pathName).
@@ -2453,117 +2469,117 @@
exePath := OperatingSystem pathOfSTXExecutable asFilename directory.
binaryClassLibraryFilename := exePath / shLibName.
binaryClassLibraryFilename exists ifFalse:[
- exePath baseName = 'bin' ifTrue:[
- binaryClassLibraryFilename := exePath directory / 'lib' / shLibName.
- ].
- binaryClassLibraryFilename exists ifFalse:[
- binaryClassLibraryFilename := exePath directory / 'plugin' / shLibName.
- binaryClassLibraryFilename exists ifFalse:[
+ exePath baseName = 'bin' ifTrue:[
+ binaryClassLibraryFilename := exePath directory / 'lib' / shLibName.
+ ].
+ binaryClassLibraryFilename exists ifFalse:[
+ binaryClassLibraryFilename := exePath directory / 'plugin' / shLibName.
+ binaryClassLibraryFilename exists ifFalse:[
"/ binaryClassLibraryFilename := Filename currentDirectory / shLibName.
"/ binaryClassLibraryFilename exists ifFalse:[
- packageDir notNil ifTrue:[
- binaryClassLibraryFilename := packageDir / shLibName.
- binaryClassLibraryFilename exists ifFalse:[
- "/ mhmh - is this a good idea ? (temporary kludge)
- ExternalAddress pointerSize == 4 ifTrue:[
- binaryClassLibraryFilename := packageDir / 'objbc' / shLibName.
- binaryClassLibraryFilename exists ifFalse:[
- binaryClassLibraryFilename := packageDir / 'objvc' / shLibName.
- ]
- ] ifFalse:[
- binaryClassLibraryFilename := packageDir / 'objmingw' / shLibName.
- ].
- ]
- ]
+ packageDir notNil ifTrue:[
+ binaryClassLibraryFilename := packageDir / shLibName.
+ binaryClassLibraryFilename exists ifFalse:[
+ "/ mhmh - is this a good idea ? (temporary kludge)
+ ExternalAddress pointerSize == 4 ifTrue:[
+ binaryClassLibraryFilename := packageDir / 'objbc' / shLibName.
+ binaryClassLibraryFilename exists ifFalse:[
+ binaryClassLibraryFilename := packageDir / 'objvc' / shLibName.
+ ]
+ ] ifFalse:[
+ binaryClassLibraryFilename := packageDir / 'objmingw' / shLibName.
+ ].
+ ]
+ ]
"/ ].
- ].
- ].
- packageDir notNil ifTrue:[
- binaryClassLibraryFilename exists ifFalse:[
- "/ look in package directory
- binaryClassLibraryFilename := packageDir / shLibName.
- binaryClassLibraryFilename exists ifFalse:[
- ExternalAddress pointerSize == 4 ifTrue:[
- binaryClassLibraryFilename := packageDir / 'objbc' / shLibName.
- binaryClassLibraryFilename exists ifFalse:[
- binaryClassLibraryFilename := packageDir / 'objvc' / shLibName.
- ]
- ] ifFalse:[
- binaryClassLibraryFilename := packageDir / 'objmingw' / shLibName.
- ].
- ].
- ].
- ].
+ ].
+ ].
+ packageDir notNil ifTrue:[
+ binaryClassLibraryFilename exists ifFalse:[
+ "/ look in package directory
+ binaryClassLibraryFilename := packageDir / shLibName.
+ binaryClassLibraryFilename exists ifFalse:[
+ ExternalAddress pointerSize == 4 ifTrue:[
+ binaryClassLibraryFilename := packageDir / 'objbc' / shLibName.
+ binaryClassLibraryFilename exists ifFalse:[
+ binaryClassLibraryFilename := packageDir / 'objvc' / shLibName.
+ ]
+ ] ifFalse:[
+ binaryClassLibraryFilename := packageDir / 'objmingw' / shLibName.
+ ].
+ ].
+ ].
+ ].
].
binaryClassLibraryFilename exists ifTrue:[
- ObjectFileLoader::ObjectFileLoadErrorNotification handle:[:ex |
- loadErrorOccurred := true.
- ex proceedWith:true.
- ] do:[
- loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
- "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
- ].
- loadOK ifTrue:[
- silent ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageString , ' from binary classLib file: ' , binaryClassLibraryFilename pathName).
- ].
- "now, all compiled classes have been loaded.
- keep classes in the package which are autoloaded as autoloaded.
- (so the code below is disabled)"
+ ObjectFileLoader::ObjectFileLoadErrorNotification handle:[:ex |
+ loadErrorOccurred := true.
+ ex proceedWith:true.
+ ] do:[
+ loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
+ "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
+ ].
+ loadOK ifTrue:[
+ silent ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageString , ' from binary classLib file: ' , binaryClassLibraryFilename pathName).
+ ].
+ "now, all compiled classes have been loaded.
+ keep classes in the package which are autoloaded as autoloaded.
+ (so the code below is disabled)"
"/ doLoadAsAutoloaded ifFalse:[
"/ "/ force autoloading...
"/ Smalltalk allClassesDo:[:eachClass |
"/ eachClass package == aPackageString ifTrue:[eachClass autoload].
"/ ].
"/ ].
- ^ true
- ].
- loadErrorOccurred ifTrue:[
- self breakPoint:#cg.
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- projectDefinitionClass notNil ifTrue:[
- "/ load prerequisites...
- projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
- self breakPoint:#cg.
- ].
- ].
+ ^ true
+ ].
+ loadErrorOccurred ifTrue:[
+ self breakPoint:#cg.
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ projectDefinitionClass notNil ifTrue:[
+ "/ load prerequisites...
+ projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+ self breakPoint:#cg.
+ ].
+ ].
].
packageDir isNil ifTrue:[
- ^ false.
+ ^ false.
].
"fallback - go through the project definition"
projectDefinitionClass isNil ifTrue:[
- projectDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageString.
- "/ try to load the project definition class
- projectDefinitionFilename := (packageDir / projectDefinitionClassName) withSuffix:'st'.
- projectDefinitionFilename exists ifFalse:[
- projectDefinitionFilename := (packageDir / 'source' / projectDefinitionClassName) withSuffix:'st'.
- ].
- projectDefinitionFilename exists ifTrue:[
- Class withoutUpdatingChangesDo:[
- Smalltalk silentlyLoadingDo:[
- projectDefinitionFilename fileIn.
- ].
- ].
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ projectDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageString.
+ "/ try to load the project definition class
+ projectDefinitionFilename := (packageDir / projectDefinitionClassName) withSuffix:'st'.
+ projectDefinitionFilename exists ifFalse:[
+ projectDefinitionFilename := (packageDir / 'source' / projectDefinitionClassName) withSuffix:'st'.
+ ].
+ projectDefinitionFilename exists ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ Smalltalk silentlyLoadingDo:[
+ projectDefinitionFilename fileIn.
+ ].
+ ].
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
"/ done below
"/ projectDefinitionClass notNil ifTrue:[
"/ projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
"/ projectDefinitionClass loadDirectory:(projectDefinitionFilename asFilename directory)
"/ ]
- ].
+ ].
].
projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass autoload.
- projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
- somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
- (silent not and:[somethingHasBeenLoaded]) ifTrue:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
- ].
- ^ true.
+ projectDefinitionClass autoload.
+ projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+ somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
+ (silent not and:[somethingHasBeenLoaded]) ifTrue:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
+ ].
+ ^ true.
].
"/ loadAll no longer supported
@@ -2622,14 +2638,14 @@
"/ source files-file loading no longer supported
"/ however, allow for autoload-stub loaded
doLoadAsAutoloaded ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:packageDir
- rememberIn:(Set new)
- maxLevels:2
- noAutoload:false
- packageTop:packageDir
- showSplashInLevels:0.
- ^ true
+ self
+ recursiveInstallAutoloadedClassesFrom:packageDir
+ rememberIn:(Set new)
+ maxLevels:2
+ noAutoload:false
+ packageTop:packageDir
+ showSplashInLevels:0.
+ ^ true
].
"/ doLoadAsAutoloaded ifFalse:[
@@ -2815,7 +2831,7 @@
methods := OrderedCollection new.
self allClassesDo:[:eachClass |
- methods addAll:(eachClass extensionsFrom:aProjectID).
+ methods addAll:(eachClass extensionsFrom:aProjectID).
].
^ methods
!
@@ -4036,186 +4052,186 @@
Initializing := true.
(StartupClass perform:#keepSplashWindowOpen ifNotUnderstood:[false]) ifFalse:[
- self hideSplashWindow. "/ if there is one, it's now time to hide it
+ self hideSplashWindow. "/ if there is one, it's now time to hide it
].
"
while reading patches- and rc-file, do not add things into change-file
"
Class withoutUpdatingChangesDo:[
- |commandFile defaultRC prevCatchSetting|
-
- didReadRCFile := false.
-
- StandAlone ifFalse:[
- "/
- "/ look for any '-q', '-e' or '-f' command line arguments
- "/ and handle them;
- "/ read startup and patches file
- "/
- idx := CommandLineArguments indexOf:'-q'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--silent'.
- ].
- idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
- ].
-
- "/ look for a '--repl' argument
- "/ then go into a read-eval-print loop immediately
- idx := CommandLineArguments indexOf:'--repl'.
- idx ~~ 0 ifTrue:[
- CommandLineArguments removeAtIndex:idx.
- self startSchedulerAndBackgroundCollector.
- self readEvalPrint.
- self exit.
- ].
-
- "/ look for a '-e filename' or '--execute filename' argument
- "/ this will force fileIn of filename only, no standard startup.
-
- idx := CommandLineArguments indexOf:'-e'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--execute'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--script'.
- idx ~~ 0 ifTrue:[
- SilentLoading := true.
- ].
- ].
- ].
- idx ~~ 0 ifTrue:[
- |process|
-
- CommandName := arg := CommandLineArguments at:idx + 1.
-
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
-
- self startSchedulerAndBackgroundCollector.
- Initializing := false.
-
- process := [
- arg = '-' ifTrue:[
- self fileInStream:Stdin
- lazy:nil
- silent:nil
- logged:false
- addPath:nil
- ] ifFalse:[
- IsSTScript := true.
- self fileIn:arg.
- ].
- self exit.
- ] newProcess.
- process priority:(Processor userSchedulingPriority).
- process name:'main'.
- process beGroupLeader.
- process resume.
-
- Processor dispatchLoop.
- self exit
- ].
-
- "/ look for a '-E expr' or '--eval expr' argument
- "/ this will force evaluation of expr only, no standard startup
- idx := CommandLineArguments indexOf:'-E'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--eval'.
- ].
- idx ~~ 0 ifTrue:[
- arg := CommandLineArguments at:idx + 1.
-
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
-
- self startSchedulerAndBackgroundCollector.
- Initializing := false.
-
- self
- fileInStream:arg readStream
- lazy:nil
- silent:nil
- logged:false
- addPath:nil.
-
- self exit
- ].
-
- "look for a '-f filename' or '--file filename' argument
- this will force evaluation of filename instead of smalltalk.rc"
-
- idx := CommandLineArguments indexOf:'-f'.
- idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--file'.
- ].
- idx ~~ 0 ifTrue:[
- CommandName := commandFile := CommandLineArguments at:idx+1.
- CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- ].
- ].
-
- commandFile notNil ifTrue:[
- self startSchedulerAndBackgroundCollector.
- Initializing := false.
-
- (self secureFileIn:commandFile) ifFalse:[
- ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
- OperatingSystem exit:1.
- ].
- ] ifFalse:[
- "/ look for <command>.rc
- "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
-
- commandFile := self commandName asFilename withSuffix:'rc'.
- (didReadRCFile := commandFile exists and:[self secureFileIn:commandFile]) ifFalse:[
- StandAlone ifFalse:[
- defaultRC := 'smalltalk.rc' asFilename
- ] ifTrue:[
- defaultRC := 'stxapp.rc' asFilename
- ].
-
- didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
- didReadRCFile ifFalse:[
- StandAlone ifFalse:[
- 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
- graphicalMode := false.
- ]
- ]
- ].
-
- "/ ('StandAlone is %1' bindWith:StandAlone) printCR.
- "/ ('Headless is %1' bindWith:HeadlessOperation) printCR.
- "/ ('Display is %1' bindWith:Display) printCR.
- "/ ('Screen is %1' bindWith:Screen) printCR.
-
- didReadRCFile ifFalse:[
- 'private.rc' asFilename exists ifTrue:[ self secureFileIn:'private.rc' ].
-
- "/
- "/ No RC file found;
- "/ Setup more default stuff
- "/
- StandAlone ifFalse:[
- "/ its a smalltalk - proceed in interpreter.
- 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
- graphicalMode := false.
- ].
-
- "/ setup more defaults...
+ |commandFile defaultRC prevCatchSetting|
+
+ didReadRCFile := false.
+
+ StandAlone ifFalse:[
+ "/
+ "/ look for any '-q', '-e' or '-f' command line arguments
+ "/ and handle them;
+ "/ read startup and patches file
+ "/
+ idx := CommandLineArguments indexOf:'-q'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--silent'.
+ ].
+ idx ~~ 0 ifTrue:[
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
+ ].
+
+ "/ look for a '--repl' argument
+ "/ then go into a read-eval-print loop immediately
+ idx := CommandLineArguments indexOf:'--repl'.
+ idx ~~ 0 ifTrue:[
+ CommandLineArguments removeAtIndex:idx.
+ self startSchedulerAndBackgroundCollector.
+ self readEvalPrint.
+ self exit.
+ ].
+
+ "/ look for a '-e filename' or '--execute filename' argument
+ "/ this will force fileIn of filename only, no standard startup.
+
+ idx := CommandLineArguments indexOf:'-e'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--execute'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--script'.
+ idx ~~ 0 ifTrue:[
+ SilentLoading := true.
+ ].
+ ].
+ ].
+ idx ~~ 0 ifTrue:[
+ |process|
+
+ CommandName := arg := CommandLineArguments at:idx + 1.
+
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+
+ self startSchedulerAndBackgroundCollector.
+ Initializing := false.
+
+ process := [
+ arg = '-' ifTrue:[
+ self fileInStream:Stdin
+ lazy:nil
+ silent:nil
+ logged:false
+ addPath:nil
+ ] ifFalse:[
+ IsSTScript := true.
+ self fileIn:arg.
+ ].
+ self exit.
+ ] newProcess.
+ process priority:(Processor userSchedulingPriority).
+ process name:'main'.
+ process beGroupLeader.
+ process resume.
+
+ Processor dispatchLoop.
+ self exit
+ ].
+
+ "/ look for a '-E expr' or '--eval expr' argument
+ "/ this will force evaluation of expr only, no standard startup
+ idx := CommandLineArguments indexOf:'-E'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--eval'.
+ ].
+ idx ~~ 0 ifTrue:[
+ arg := CommandLineArguments at:idx + 1.
+
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+
+ self startSchedulerAndBackgroundCollector.
+ Initializing := false.
+
+ self
+ fileInStream:arg readStream
+ lazy:nil
+ silent:nil
+ logged:false
+ addPath:nil.
+
+ self exit
+ ].
+
+ "look for a '-f filename' or '--file filename' argument
+ this will force evaluation of filename instead of smalltalk.rc"
+
+ idx := CommandLineArguments indexOf:'-f'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--file'.
+ ].
+ idx ~~ 0 ifTrue:[
+ CommandName := commandFile := CommandLineArguments at:idx+1.
+ CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
+ ].
+ ].
+
+ commandFile notNil ifTrue:[
+ self startSchedulerAndBackgroundCollector.
+ Initializing := false.
+
+ (self secureFileIn:commandFile) ifFalse:[
+ ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
+ OperatingSystem exit:1.
+ ].
+ ] ifFalse:[
+ "/ look for <command>.rc
+ "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
+
+ commandFile := self commandName asFilename withSuffix:'rc'.
+ (didReadRCFile := commandFile exists and:[self secureFileIn:commandFile]) ifFalse:[
+ StandAlone ifFalse:[
+ defaultRC := 'smalltalk.rc' asFilename
+ ] ifTrue:[
+ defaultRC := 'stxapp.rc' asFilename
+ ].
+
+ didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
+ didReadRCFile ifFalse:[
+ StandAlone ifFalse:[
+ 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
+ graphicalMode := false.
+ ]
+ ]
+ ].
+
+ "/ ('StandAlone is %1' bindWith:StandAlone) printCR.
+ "/ ('Headless is %1' bindWith:HeadlessOperation) printCR.
+ "/ ('Display is %1' bindWith:Display) printCR.
+ "/ ('Screen is %1' bindWith:Screen) printCR.
+
+ didReadRCFile ifFalse:[
+ 'private.rc' asFilename exists ifTrue:[ self secureFileIn:'private.rc' ].
+
+ "/
+ "/ No RC file found;
+ "/ Setup more default stuff
+ "/
+ StandAlone ifFalse:[
+ "/ its a smalltalk - proceed in interpreter.
+ 'Smalltalk [warning]: no startup rc-file found. Going into line-by-line interpreter.' infoPrintCR.
+ graphicalMode := false.
+ ].
+
+ "/ setup more defaults...
"/ ObjectMemory startBackgroundCollectorAt:5.
"/ ObjectMemory startBackgroundFinalizationAt:5.
- self addStartBlock:[
- self startSchedulerAndBackgroundCollector
- ].
- ].
- ].
+ self addStartBlock:[
+ self startSchedulerAndBackgroundCollector
+ ].
+ ].
+ ].
].
HeadlessOperation ifTrue:[
- graphicalMode := false.
+ graphicalMode := false.
].
self mainStartup:graphicalMode
@@ -5603,309 +5619,309 @@
wasLazy := Compiler compileLazy:loadLazy.
beSilent notNil ifTrue:[
- wasSilent := self silentLoading:beSilent.
+ wasSilent := self silentLoading:beSilent.
].
classFileName := Smalltalk fileNameForClass:aClassName.
(classFileName = aClassName) ifTrue:[
- "/ no abbrev.stc translation for className
- (aClassName includes:$:) ifTrue:[
- "/ a nameSpace name
- alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1
- ].
+ "/ no abbrev.stc translation for className
+ (aClassName includes:$:) ifTrue:[
+ "/ a nameSpace name
+ alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1
+ ].
].
classFileName asFilename isAbsolute ifTrue:[
- classFileName asFilename suffix notEmptyOrNil ifTrue:[
- ok := self fileIn:classFileName lazy:loadLazy silent:beSilent.
- ] ifFalse:[
- ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent.
- ]
+ classFileName asFilename suffix notEmptyOrNil ifTrue:[
+ ok := self fileIn:classFileName lazy:loadLazy silent:beSilent.
+ ] ifFalse:[
+ ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent.
+ ]
] ifFalse:[
- classFileName := classFileName copyReplaceAll:$: with:$_.
- [
- Class withoutUpdatingChangesDo:[
- |zarFn zar entry|
-
- ok := false.
-
- package notNil ifTrue:[
- packageDir := package asPackageId projectDirectory.
- "/ packageDir := package asString.
- "/ packageDir := packageDir copyReplaceAll:$: with:$/.
- packageDir isNil ifTrue:[
- packageDir := self packageDirectoryForPackageId:package
- ].
- ].
-
- Class packageQuerySignal answer:package do:[
- "
- then, if dynamic linking is available,
- "
- (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
- sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
- "
- first look for a class packages shared binary in binary/xxx.o
- "
- libName := self libraryFileNameOfClass:aClassName.
- libName notNil ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(libName, '.o')
- ]
- ].
- ].
- "
- then, look for a shared binary in binary/xxx.o
- "
- ok ifFalse:[
- (ok := self fileInClass:aClassName fromObject:(classFileName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(classFileName, '.o')
- ].
- ok ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o')
- ]
- ]
- ].
- ].
- ].
- ].
- ].
-
- "
- if that did not work, look for a compiled-bytecode file ...
- "
- ok ifFalse:[
- (ok := self fileIn:(classFileName , '.cls') lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-cls file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/classes/' , classFileName , '.cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/classes/' , classFileName , '.cls').
- ].
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/classes/' , alternativeClassFileName , '.cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/classes/' , alternativeClassFileName , '.cls').
- ].
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ]
- ].
-
- zarFn := self getPackageFileName:(packageDir , '/classes.zip').
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(classFileName , '.cls').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(alternativeClassFileName , '.cls').
- ].
- entry notNil ifTrue:[
- bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
- bos next.
- bos close.
- ok := true
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work, look for an st-source file ...
- "
- ok ifFalse:[
- filenameToSet := classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- filenameToSet := 'source/' , classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := 'source/' , alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-source file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- packageFile := self getPackageSourceFileName:(packageDir , '/source/' , classFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/source/' , classFileName).
- ].
- filenameToSet := packageFile.
- (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageSourceFileName:(packageDir , '/source/' , alternativeClassFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/source/' , alternativeClassFileName).
- ].
- filenameToSet := packageFile.
- ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- packageFile := self getPackageSourceFileName:(packageDir , '/' , classFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/' , classFileName).
- ].
- filenameToSet := packageFile.
- (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir , '/' , alternativeClassFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir , '/' , alternativeClassFileName).
- ].
- filenameToSet := packageFile.
- ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- filenameToSet := 'source/' , packageDir , '/' , classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := 'source/' , packageDir , '/' , alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- ].
- ].
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- zarFn := self getPackageFileName:(packageDir , '/source.zip').
- zarFn isNil ifTrue:[
- zarFn := packageDir asFilename withSuffix:'zip'.
- zarFn := self getSourceFileName:zarFn.
- ].
- (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(classFileName , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- filenameToSet := zarFn.
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- zarFn := self getSourceFileName:'source.zip'.
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(zarFn := classFileName , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(zarFn := alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- filenameToSet := zarFn.
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ].
- ok ifFalse:[
- "
- if there is a sourceCodeManager, ask it for the classes sourceCode
- "
- (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
- inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName inPackage:package.
- inStream notNil ifTrue:[
- filenameToSet := nil.
- ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
- ]
- ].
- ].
- ].
- ]
- ].
- ] ensure:[
- Compiler compileLazy:wasLazy.
- wasSilent notNil ifTrue:[
- self silentLoading:wasSilent
- ]
- ].
+ classFileName := classFileName copyReplaceAll:$: with:$_.
+ [
+ Class withoutUpdatingChangesDo:[
+ |zarFn zar entry|
+
+ ok := false.
+
+ package notNil ifTrue:[
+ packageDir := package asPackageId projectDirectory.
+ "/ packageDir := package asString.
+ "/ packageDir := packageDir copyReplaceAll:$: with:$/.
+ packageDir isNil ifTrue:[
+ packageDir := self packageDirectoryForPackageId:package
+ ].
+ ].
+
+ Class packageQuerySignal answer:package do:[
+ "
+ then, if dynamic linking is available,
+ "
+ (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
+ sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
+ "
+ first look for a class packages shared binary in binary/xxx.o
+ "
+ libName := self libraryFileNameOfClass:aClassName.
+ libName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(libName, '.o')
+ ]
+ ].
+ ].
+ "
+ then, look for a shared binary in binary/xxx.o
+ "
+ ok ifFalse:[
+ (ok := self fileInClass:aClassName fromObject:(classFileName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(classFileName, '.o')
+ ].
+ ok ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o')
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ "
+ if that did not work, look for a compiled-bytecode file ...
+ "
+ ok ifFalse:[
+ (ok := self fileIn:(classFileName , '.cls') lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-cls file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , classFileName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , classFileName , '.cls').
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , alternativeClassFileName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , alternativeClassFileName , '.cls').
+ ].
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ]
+ ].
+
+ zarFn := self getPackageFileName:(packageDir , '/classes.zip').
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(classFileName , '.cls').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(alternativeClassFileName , '.cls').
+ ].
+ entry notNil ifTrue:[
+ bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
+ bos next.
+ bos close.
+ ok := true
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work, look for an st-source file ...
+ "
+ ok ifFalse:[
+ filenameToSet := classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source/' , classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source/' , alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-source file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ packageFile := self getPackageSourceFileName:(packageDir , '/source/' , classFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , classFileName).
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageSourceFileName:(packageDir , '/source/' , alternativeClassFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , alternativeClassFileName).
+ ].
+ filenameToSet := packageFile.
+ ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ packageFile := self getPackageSourceFileName:(packageDir , '/' , classFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , classFileName).
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/' , alternativeClassFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , alternativeClassFileName).
+ ].
+ filenameToSet := packageFile.
+ ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source/' , packageDir , '/' , classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source/' , packageDir , '/' , alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ zarFn := self getPackageFileName:(packageDir , '/source.zip').
+ zarFn isNil ifTrue:[
+ zarFn := packageDir asFilename withSuffix:'zip'.
+ zarFn := self getSourceFileName:zarFn.
+ ].
+ (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(classFileName , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ filenameToSet := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ zarFn := self getSourceFileName:'source.zip'.
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(zarFn := classFileName , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(zarFn := alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ filenameToSet := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ].
+ ok ifFalse:[
+ "
+ if there is a sourceCodeManager, ask it for the classes sourceCode
+ "
+ (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
+ inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName inPackage:package.
+ inStream notNil ifTrue:[
+ filenameToSet := nil.
+ ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ ] ensure:[
+ Compiler compileLazy:wasLazy.
+ wasSilent notNil ifTrue:[
+ self silentLoading:wasSilent
+ ]
+ ].
].
ok ifTrue:[
- newClass := self at:(aClassName asSymbol).
- newClass notNil ifTrue:[
- "set the classes name - but do not change if already set"
- filenameToSet notNil ifTrue:[
- newClass getClassFilename isNil ifTrue:[
- newClass setClassFilename:(filenameToSet asFilename baseName)
- ].
- ].
-
- doInit ifTrue:[
- newClass initialize
- ]
- ]
+ newClass := self at:(aClassName asSymbol).
+ newClass notNil ifTrue:[
+ "set the classes name - but do not change if already set"
+ filenameToSet notNil ifTrue:[
+ newClass getClassFilename isNil ifTrue:[
+ newClass setClassFilename:(filenameToSet asFilename baseName)
+ ].
+ ].
+
+ doInit ifTrue:[
+ newClass initialize
+ ]
+ ]
].
^ newClass
@@ -7432,7 +7448,7 @@
packageDir := self getPackageFileName:packageDirName.
packageDir isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
^ packageDir asFilename
@@ -7448,11 +7464,11 @@
projectDefinition := aPackageIdOrPackage.
projectDefinition isProjectDefinition ifFalse:[
- projectDefinition := projectDefinition asPackageId projectDefinitionClass.
- projectDefinition isNil ifTrue:[
- 'Smalltalk [info] trying to unload non-existing package: ' infoPrint. aPackageIdOrPackage infoPrintCR.
- ^ self.
- ].
+ projectDefinition := projectDefinition asPackageId projectDefinitionClass.
+ projectDefinition isNil ifTrue:[
+ 'Smalltalk [info] trying to unload non-existing package: ' infoPrint. aPackageIdOrPackage infoPrintCR.
+ ^ self.
+ ].
].
projectDefinition unloadPackage.
@@ -7738,13 +7754,13 @@
Now releaseNr is the build number (BUILD_NUMBER from Jenkins)
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
|releaseNumber|
releaseNumber := Smalltalk versionBuildNumber.
releaseNumber isEmpty ifTrue:[
- ^ 0.
+ ^ 0.
].
^ releaseNumber
@@ -7766,7 +7782,7 @@
to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 3
@@ -7881,14 +7897,13 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1015 2013-03-19 17:14:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1016 2013-03-22 11:47:11 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1015 2013-03-19 17:14:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1016 2013-03-22 11:47:11 cg Exp $'
!
version_SVN
^ '§ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1 §'
! !
-