Metaclass.st
changeset 1733 2cc88c50db99
parent 1732 99980cae1db3
child 1742 e1ee359969f5
--- 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 $'
 ! !