Metaclass.st
changeset 1724 ef3f680996db
parent 1698 0aaf983588b8
child 1725 eaa45019ad44
--- a/Metaclass.st	Sat Oct 12 21:15:01 1996 +0200
+++ b/Metaclass.st	Sat Oct 12 21:18:48 1996 +0200
@@ -442,7 +442,7 @@
 
 !Metaclass methodsFor:'creating classes'!
 
-name:newName in:aSystemDictionary
+name:newName in:aSystemDictionaryOrClass
              subclassOf:aClass
              instanceVariableNames:stringOfInstVarNames
              variable:variableBoolean
@@ -501,8 +501,12 @@
     newComment := commentString.
 
     "look, if it already exists as a class"
-    aSystemDictionary notNil ifTrue:[
-        oldClass := aSystemDictionary at:classSymbol ifAbsent:[nil].
+    aSystemDictionaryOrClass notNil ifTrue:[
+        aSystemDictionaryOrClass isNamespace ifTrue:[
+            oldClass := aSystemDictionaryOrClass at:classSymbol ifAbsent:[nil].
+        ] ifFalse:[
+            oldClass := aSystemDictionaryOrClass privateClassesAt:classSymbol.
+        ]
     ].
     (oldClass isBehavior and:[oldClass isLoaded]) ifFalse:[
         oldClass := nil.
@@ -608,19 +612,27 @@
     nClassInstVars := stringOfClassInstVarNames countWords.
 
     "create the metaclass first"
-    newMetaclass := Metaclass new.
+    newMetaclass := self new.
     newMetaclass setSuperclass:(aClass class).
     newMetaclass instSize:(aClass class instSize + nClassInstVars).
-    newMetaclass setName:(nameString , ' class') asSymbol.
-    newMetaclass classVariableString:'' "stringOfClassVarNames".
-"/    newMetaclass setComment:newComment category:categoryString.
+    newMetaclass classVariableString:''.
+
+
     newMetaclass setInstanceVariableString:stringOfClassInstVarNames.
 
     "then let the new meta create the class"
     newClass := newMetaclass new.
     newClass setSuperclass:aClass.
     newClass instSize:(aClass instSize + nInstVars).
-    newClass setName:classSymbol.
+
+    (aSystemDictionaryOrClass notNil
+    and:[aSystemDictionaryOrClass isNamespace not]) ifTrue:[
+        "/ some private class
+        newMetaclass setOwningClass:aSystemDictionaryOrClass.
+        newClass setName:(aSystemDictionaryOrClass name , '::' , classSymbol) asSymbol.
+    ] ifFalse:[
+        newClass setName:classSymbol.
+    ].
     newClass setComment:newComment category:categoryString.
 
     "/ set the new classes package
@@ -704,8 +716,12 @@
             newClass comment:commentString
         ].
 
-        aSystemDictionary notNil ifTrue:[
-            aSystemDictionary at:classSymbol put:newClass.
+        aSystemDictionaryOrClass notNil ifTrue:[
+            aSystemDictionaryOrClass isNamespace ifFalse:[
+                aSystemDictionaryOrClass privateClassesAt:classSymbol put:newClass.
+            ] ifTrue:[
+                aSystemDictionaryOrClass at:classSymbol put:newClass.
+            ]
         ].
 
         oldClass isNil ifTrue:[
@@ -720,8 +736,12 @@
             ].
         ].
 
-        aSystemDictionary notNil ifTrue:[
-            aSystemDictionary changed:#newClass with:newClass.
+        aSystemDictionaryOrClass notNil ifTrue:[
+            aSystemDictionaryOrClass isNamespace ifFalse:[
+                aSystemDictionaryOrClass changed.
+            ] ifTrue:[
+                aSystemDictionaryOrClass changed:#newClass with:newClass.
+            ]
         ].
         ^ newClass
     ].
@@ -772,9 +792,11 @@
                     changed ifTrue:[
                         self addChangeRecordForClass:newClass.
                     ].    
-                    aSystemDictionary notNil ifTrue:[
-                        "notify change of category"
-                        aSystemDictionary changed:#organization
+                    aSystemDictionaryOrClass notNil ifTrue:[
+                        aSystemDictionaryOrClass isNamespace ifTrue:[
+                            "notify change of category"
+                            aSystemDictionaryOrClass changed:#organization
+                        ]
                     ]
                 ].
                 "notify change of class"
@@ -788,9 +810,11 @@
               oldClass category ~= categoryString ifTrue:[
                   "notify change of organization"
                   oldClass category:categoryString. 
-                  aSystemDictionary notNil ifTrue:[
-                      "notify change of organization"
-                      aSystemDictionary changed:#organization
+                  aSystemDictionaryOrClass notNil ifTrue:[
+                       aSystemDictionaryOrClass isNamespace ifTrue:[ 
+                          "notify change of organization"
+                          aSystemDictionaryOrClass changed:#organization
+                        ]
                   ].
               ].
 
@@ -1084,12 +1108,16 @@
     "
      and make the new class globally known
     "
-    aSystemDictionary notNil ifTrue:[
-        aSystemDictionary at:classSymbol put:newClass.
+    aSystemDictionaryOrClass notNil ifTrue:[
+        aSystemDictionaryOrClass isNamespace ifFalse:[
+            aSystemDictionaryOrClass privateClassesAt:classSymbol put:newClass.
+        ] ifTrue:[
+            aSystemDictionaryOrClass at:classSymbol put:newClass.
 
-        oldClass category ~= categoryString ifTrue:[
-            "notify change of organization"
-            aSystemDictionary changed:#organization
+            oldClass category ~= categoryString ifTrue:[
+                "notify change of organization"
+                aSystemDictionaryOrClass changed:#organization
+            ]
         ].
     ].
 
@@ -1113,7 +1141,7 @@
 
     "Created: 26.5.1996 / 11:55:26 / cg"
     "Modified: 18.6.1996 / 14:19:39 / stefan"
-    "Modified: 8.10.1996 / 15:46:04 / cg"
+    "Modified: 12.10.1996 / 20:18:22 / cg"
 !
 
 name:newName inEnvironment:aSystemDictionary
@@ -1453,6 +1481,14 @@
     ^ true
 !
 
+owningClass
+    "return nil here - regular metaclasses are never private"
+
+    ^ nil
+
+    "Created: 12.10.1996 / 20:12:16 / cg"
+!
+
 soleInstance 
     "return my sole class."
 
@@ -1462,5 +1498,5 @@
 !Metaclass  class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.64 1996-10-08 14:49:06 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.65 1996-10-12 19:18:48 cg Exp $'
 ! !