--- a/Smalltalk.st Thu Apr 13 12:51:54 2000 +0200
+++ b/Smalltalk.st Thu Apr 13 12:55:21 2000 +0200
@@ -1010,31 +1010,31 @@
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.
aClass isPrivate ifTrue:[
- oldNameSpace := aClass topOwningClass nameSpace.
+ oldNameSpace := aClass topOwningClass nameSpace.
] ifFalse:[
- oldNameSpace := aClass nameSpace.
+ oldNameSpace := aClass nameSpace.
].
oldBaseName := aClass nameWithoutNameSpacePrefix.
oldBaseNameWithoutPrefix := aClass nameWithoutPrefix.
@@ -1042,8 +1042,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
@@ -1067,35 +1067,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 class methodDictionary do:[:aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ].
- aSubClass methodDictionary do:[: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 allSelectorsAndMethodsDo:[:sel :aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ].
+ ].
+
+ "/ and also in privateClasses ? ...
"/ privateClasses size > 0 ifTrue:[
"/ privateClasses do:[:aPrivateClass |
@@ -1116,81 +1113,81 @@
"/ clear the namespace (for namespace query to work)
aClass setEnvironment:nil.
aClass isPrivate ifTrue:[
- newNameSpace := aClass topOwningClass nameSpace.
+ newNameSpace := aClass topOwningClass nameSpace.
] ifFalse:[
- newNameSpace := aClass nameSpace.
+ newNameSpace := aClass nameSpace.
].
privateClasses size > 0 ifTrue:[
- "/ must rename privateClasses as well
- privateClasses do:[:aPrivateClass |
- self renameClass:aPrivateClass
- to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
+ "/ must rename privateClasses as well
+ privateClasses do:[:aPrivateClass |
+ self renameClass:aPrivateClass
+ to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
- Class class
- recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
- in:newNameSpace
- except:nil.
- ]
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
+ Class class
+ 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 , ''' ...'.
-
- Class class
- 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 , ''' ...'.
-
- Class class
- 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 , ''' ...'.
+
+ Class class
+ 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 , ''' ...'.
+
+ Class class
+ 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.
].
"Created: / 29.10.1995 / 19:58:32 / cg"
@@ -1780,6 +1777,10 @@
"Created: 11.10.1996 / 18:10:43 / cg"
!
+isTopLevelNameSpace
+ ^ true
+!
+
isTopLevelNamespace
"obsolete - use isTopLevelNameSpace"
@@ -1788,10 +1789,6 @@
"Created: 11.10.1996 / 18:10:43 / cg"
!
-isTopLevelNameSpace
- ^ true
-!
-
numberOfGlobals
"return the number of global variables in the system"
@@ -1891,7 +1888,7 @@
selectorCompletion:aPartialSymbolName
"given a partial selector, return an array consisting of
2 entries: 1st: collection consisting of matching implemented selectors
- 2nd: the longest match"
+ 2nd: the longest match"
|matches best lcSym|
@@ -1899,39 +1896,29 @@
"/ search for exact match
self allClassesDo:[:aClass |
- aClass methodDictionary keysAndValuesDo:[:aSelector :aMethod |
- (aSelector startsWith:aPartialSymbolName) ifTrue:[
- matches add:aSelector
- ]
- ].
- aClass class methodDictionary keysAndValuesDo:[:aSelector :aMethod |
- (aSelector startsWith:aPartialSymbolName) ifTrue:[
- matches add:aSelector
- ]
- ]
+ aClass allSelectorsAndMethodsDo:[:aSelector :aMethod |
+ (aSelector startsWith:aPartialSymbolName) ifTrue:[
+ matches add:aSelector
+ ]
+ ].
].
matches isEmpty ifTrue:[
- "/ search for case-ignoring match
- lcSym := aPartialSymbolName asLowercase.
- self allClassesDo:[:aClass |
- aClass methodDictionary keysAndValuesDo:[:aSelector :aMethod |
- (aSelector asLowercase startsWith:lcSym) ifTrue:[
- matches add:aSelector
- ]
- ].
- aClass class methodDictionary keysAndValuesDo:[:aSelector :aMethod |
- (aSelector asLowercase startsWith:lcSym) ifTrue:[
- matches add:aSelector
- ]
- ]
- ].
+ "/ search for case-ignoring match
+ lcSym := aPartialSymbolName asLowercase.
+ self allClassesDo:[:aClass |
+ aClass allSelectorsAndMethodsDo:[:aSelector :aMethod |
+ (aSelector asLowercase startsWith:lcSym) ifTrue:[
+ matches add:aSelector
+ ]
+ ].
+ ].
].
matches isEmpty ifTrue:[
- ^ Array with:aPartialSymbolName with:(Array with:aPartialSymbolName)
+ ^ Array with:aPartialSymbolName with:(Array with:aPartialSymbolName)
].
matches size == 1 ifTrue:[
- ^ Array with:matches first with:(matches asArray)
+ ^ Array with:matches first with:(matches asArray)
].
matches := matches asSortedCollection.
best := matches longestCommonPrefix.
@@ -5569,5 +5556,5 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.446 2000-04-12 21:37:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.447 2000-04-13 10:55:21 cg Exp $'
! !