--- a/Metaclass.st Mon Oct 14 17:42:57 1996 +0200
+++ b/Metaclass.st Mon Oct 14 17:51:35 1996 +0200
@@ -183,7 +183,12 @@
"
create the new metaclass
"
- newMetaclass := Metaclass new.
+ self isPrivate ifTrue:[
+ newMetaclass := PrivateMetaclass new.
+ newMetaclass setOwningClass:(self owningClass).
+ ] ifFalse:[
+ newMetaclass := Metaclass new.
+ ].
newMetaclass setSuperclass:superclass.
newMetaclass instSize:(superclass instSize + nClassInstVars).
(nClassInstVars ~~ 0) ifTrue:[
@@ -197,12 +202,6 @@
"find the class which is my sole instance"
-"/ t := Smalltalk allClasses select:[:element | element class == self].
-"/ (t size > 1) ifTrue:[
-"/ self error:'oops - I should have exactly one instance'.
-"/ ^ nil
-"/ ].
-"/ oldClass := t anElement.
oldClass := myClass.
"
@@ -237,10 +236,9 @@
or:[newNames startsWith:oldNames]) ifTrue:[
"new variable(s) has/have been added - old methods still work"
-" "
- Transcript showCR:'copying methods ...'.
- Transcript endEntry.
-" "
+"/ Transcript showCR:'copying methods ...'.
+"/ Transcript endEntry.
+
self copyMethodsFrom:self for:newMetaclass.
self copyMethodsFrom:oldClass for:newClass.
@@ -250,10 +248,10 @@
"
addedNames := newNames select:[:nm | (oldNames includes:nm) not].
-" "
- Transcript showCR:'recompiling methods accessing ' , addedNames printString , '...'.
- Transcript endEntry.
-" "
+
+"/ Transcript showCR:'recompiling methods accessing ' , addedNames printString , '...'.
+"/ Transcript endEntry.
+
"recompile class-methods"
newMetaclass recompileMethodsAccessingAny:addedNames.
] ifFalse:[
@@ -291,10 +289,9 @@
]
].
-" "
- Transcript showCR:'recompiling methods accessing ' , changeSet printString , ' ...'.
- Transcript endEntry.
-" "
+"/ Transcript showCR:'recompiling methods accessing ' , changeSet printString , ' ...'.
+"/ Transcript endEntry.
+
"
recompile class-methods
"
@@ -367,8 +364,8 @@
newSubclass := oldToNew at:oldSubclass.
-Transcript showCR:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , changeSet printString.
+ Transcript showCR:'recompiling class methods of ' , newSubclass class name ,
+ ' accessing any of ' , changeSet printString.
newSubclass class recompileMethodsAccessingAny:changeSet.
]
@@ -390,8 +387,8 @@
classInstVars removeAll:commonClassInstVars.
classInstVars addAll:changeSet.
-Transcript showCR:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , classInstVars printString.
+ Transcript showCR:'recompiling class methods of ' , newSubclass class name ,
+ ' accessing any of ' , classInstVars printString.
newSubclass class recompileMethodsAccessingAny:classInstVars.
]
@@ -410,10 +407,10 @@
|newSubClass|
newSubClass := oldToNew at:oldSubClass.
-"
-Transcript showCR:'install ' , newSubClass name , '(' , newSubClass category , ')' ,
- ' as ' , newSubClass name.
-"
+
+"/ Transcript showCR:'install ' , newSubClass name , '(' , newSubClass category , ')' ,
+"/ ' as ' , newSubClass name.
+
(Smalltalk at:(oldSubClass name asSymbol) ifAbsent:nil) == oldSubClass ifTrue:[
Smalltalk at:oldSubClass name asSymbol put:newSubClass.
].
@@ -429,7 +426,7 @@
"Created: 29.10.1995 / 19:57:08 / cg"
"Modified: 7.6.1996 / 08:43:19 / stefan"
- "Modified: 21.9.1996 / 15:40:54 / cg"
+ "Modified: 14.10.1996 / 16:48:11 / cg"
! !
!Metaclass methodsFor:'copying'!
@@ -489,6 +486,16 @@
^ nil
].
+ (newName isSymbol not
+ or:[newName size == 0]) ifTrue:[
+ self error:'invalid class name (must be a nonEmpty symbol)'.
+ ^ nil
+ ].
+ newName first isLetter ifFalse:[
+ self error:'invalid class name (must start with a letter)'.
+ ^ nil
+ ].
+
"check for invalid subclassing of UndefinedObject and SmallInteger"
aClass canBeSubclassed ifFalse:[
self error:('it is not possible to subclass ' , aClass name).
@@ -614,7 +621,7 @@
"create the metaclass first"
(aSystemDictionaryOrClass notNil
and:[aSystemDictionaryOrClass isNamespace not]) ifTrue:[
- newMetaclass := PrivateMetaclass new
+ newMetaclass := PrivateMetaclass new
] ifFalse:[
newMetaclass := Metaclass new.
].
@@ -1144,7 +1151,7 @@
"Created: 26.5.1996 / 11:55:26 / cg"
"Modified: 18.6.1996 / 14:19:39 / stefan"
- "Modified: 12.10.1996 / 20:18:22 / cg"
+ "Modified: 14.10.1996 / 16:50:19 / cg"
!
name:newName inEnvironment:aSystemDictionary
@@ -1501,5 +1508,5 @@
!Metaclass class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.67 1996-10-14 15:42:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.68 1996-10-14 15:51:35 cg Exp $'
! !