Mercurial Mercurial > hg > stx-libbasic / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | zip | gz | bz2 | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
class: Smalltalk
authorStefan Vogel <sv@exept.de>
Wed, 19 Dec 2012 10:56:30 +0100
changeset 14611 5c3a6b7ed01d
parent 14610 27ccd628f537
child 14612 afcc0becdf7e
class: Smalltalk changed: #unloadPackage:
Smalltalk.st file | annotate | diff | comparison | revisions 
--- a/Smalltalk.st	Wed Dec 19 10:32:27 2012 +0100
+++ b/Smalltalk.st	Wed Dec 19 10:56:30 2012 +0100
@@ -1362,24 +1362,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.
@@ -1390,8 +1390,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
@@ -1400,42 +1400,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.
@@ -1455,32 +1455,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 |
@@ -1503,88 +1503,88 @@
     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.
-    Smalltalk changed:#classRename with:(Array with:aClass with:oldName).
+    self changed:#classRename with:(Array with:aClass with:oldName).
 
     "Created: / 29-10-1995 / 19:58:32 / cg"
     "Modified: / 18-06-1996 / 14:20:50 / stefan"
@@ -7379,7 +7379,11 @@
 
     projectDefinition := aPackageIdOrPackage.
     projectDefinition isProjectDefinition ifFalse:[
-	projectDefinition := projectDefinition asPackageId projectDefinitionClass
+        projectDefinition := projectDefinition asPackageId projectDefinitionClass.
+        projectDefinition isNil ifTrue:[
+            'Smalltalk [info] trying to unload non-existing package: ' infoPrint. aPackageIdOrPackage infoPrintCR.
+            ^ self.
+        ].
     ].
     projectDefinition unloadPackage.
 
@@ -7807,13 +7811,14 @@
 !Smalltalk class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1004 2012-12-13 18:40:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1005 2012-12-19 09:56:30 stefan Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1004 2012-12-13 18:40:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1005 2012-12-19 09:56:30 stefan Exp $'
 !
 
 version_SVN
     ^ '§ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1  §'
 ! !
+
hg/stx-libbasic