# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 1020329496 -7200
# Node ID 8cac16d95cb3790d5b8c801d30263aa8d1ee83eb
# Parent  d7bc1d1dab4b33c03125a5536c25c07c8a5e2946
care for private metaclass

diff -r d7bc1d1dab4b -r 8cac16d95cb3 ClassBuilder.st
--- a/ClassBuilder.st	Thu May 02 10:50:46 2002 +0200
+++ b/ClassBuilder.st	Thu May 02 10:51:36 2002 +0200
@@ -4,7 +4,7 @@
 	instanceVariableNames:'className environment superClass instanceVariableNames variable
 		words pointers classVariableNames poolDictionaries category
 		comment changed classInstanceVariableNames oldMetaClass
-		realNewName'
+		realNewName buildPrivateClass'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Kernel-Support'
@@ -299,11 +299,11 @@
      classVarChange instVarChange superClassChange newComment
      changeSet1 changeSet2 addedNames
      anyChange oldInstVars newInstVars oldClassVars newClassVars superFlags newFlags
-     pkg oldPkg idx spec nClassInstVars 
-     thisIsPrivate oldCIVNames newCIVNames nsName namespace
+     pkg oldPkg idx spec  
+     oldCIVNames newCIVNames nsName namespace
      oldSuperClass newSuperClass oldCategory
-     recompileGlobalAccessTo stringOfClassInstVarNames answer
-     oldClassToBecomeNew classesSuperclass newInstSize doCreate|
+     recompileGlobalAccessTo answer
+     oldClassToBecomeNew newInstSize doCreate|
 
     "NOTICE:
      this method is too complex and should be splitted into managable pieces ...
@@ -351,10 +351,10 @@
 
     (namespace notNil
     and:[namespace isNameSpace not]) ifTrue:[
-        thisIsPrivate := true.
+        buildPrivateClass := true.
         realNewName := (namespace name , '::' , classSymbol) asSymbol.
     ] ifFalse:[
-        thisIsPrivate := false.
+        buildPrivateClass := false.
         realNewName := classSymbol.
 
         "/ does the name imply a nameSpace ?
@@ -385,7 +385,7 @@
                     (namespace isBehavior
                     and:[namespace isMeta not])
                     ifTrue:[
-                        thisIsPrivate := true.
+                        buildPrivateClass := true.
                         realNewName := classSymbol asSymbol.
                     ] ifFalse:[
                         self warn:('A global named ' , nsName , ' exists, but is no namespace.') withCRs.
@@ -410,7 +410,7 @@
 
     "look, if it already exists as a class"
     namespace notNil ifTrue:[
-        thisIsPrivate ifFalse:[
+        buildPrivateClass ifFalse:[
             oldClass := namespace at:nameKey ifAbsent:[nil].
         ] ifTrue:[
             oldClass := namespace privateClassesAt:classSymbol.
@@ -424,7 +424,7 @@
     (oldClass isBehavior and:[oldClass isLoaded]) ifFalse:[
         oldClass := nil.
 
-        thisIsPrivate ifTrue:[
+        buildPrivateClass ifTrue:[
             Compiler warnSTXSpecials ifTrue:[
                 (self confirm:('support for private classes is an ST/X extension.\\continue ?') withCRs)
                 ifFalse:[^ nil].
@@ -517,29 +517,14 @@
 
     classInstanceVariableNames isNil ifTrue:[
         oldClass isNil ifTrue:[
-            stringOfClassInstVarNames := ''
+            classInstanceVariableNames := ''
         ] ifFalse:[
-            stringOfClassInstVarNames := oldClass class instanceVariableString
+            classInstanceVariableNames := oldClass class instanceVariableString
         ]
-    ] ifFalse:[
-        stringOfClassInstVarNames := classInstanceVariableNames
     ].
 
-    nClassInstVars := stringOfClassInstVarNames countWords.
-
     "create the metaclass first"
-    thisIsPrivate ifTrue:[
-        newMetaclass := PrivateMetaclass new
-    ] ifFalse:[
-        newMetaclass := Metaclass new.
-    ].
-    superClass isNil ifTrue:[
-        classesSuperclass := Class.
-    ] ifFalse:[
-        classesSuperclass := superClass class.
-    ].
-    newMetaclass setSuperclass:classesSuperclass instSize:(classesSuperclass instSize + nClassInstVars).
-    newMetaclass setInstanceVariableString:stringOfClassInstVarNames.
+    newMetaclass := self instantiateMetaclass.
 
     "then let the new meta create the class"
     newClass := newMetaclass new.
@@ -550,7 +535,7 @@
     ].
     newClass setSuperclass:superClass instSize:newInstSize.
 
-    thisIsPrivate ifTrue:[
+    buildPrivateClass ifTrue:[
         "/ some private class
         newMetaclass setOwningClass:namespace.
     ].
@@ -608,7 +593,7 @@
             pkg := oldPkg
         ] ifTrue:[
             "/ not autoloading, check for packageRedef ...
-            thisIsPrivate ifTrue:[
+            buildPrivateClass ifTrue:[
                 pkg := namespace package.
             ] ifFalse:[
                 pkg := Class packageQuerySignal query.
@@ -700,7 +685,7 @@
             newClass comment:comment
         ].
         namespace notNil ifTrue:[
-            thisIsPrivate ifTrue:[
+            buildPrivateClass ifTrue:[
                 namespace privateClassesAt:classSymbol put:newClass.
             ] ifFalse:[
                 namespace at:nameKey put:newClass.
@@ -731,7 +716,7 @@
 
         Smalltalk changed:#newClass with:newClass.
         namespace notNil ifTrue:[
-            thisIsPrivate ifTrue:[
+            buildPrivateClass ifTrue:[
                 namespace changed.
             ] ifFalse:[
                 namespace ~~ Smalltalk ifTrue:[
@@ -752,7 +737,7 @@
                 in:namespace except:newClass.
         ].
 
-        (thisIsPrivate 
+        (buildPrivateClass 
         and:[newClass owningClass nameSpace notNil]) ifTrue:[
             "/ namespace is a class; 
             "/ if this owner is itself in a namespace,
@@ -816,7 +801,7 @@
                           newClass addChangeRecordForClass:newClass.
                       ].    
                       namespace notNil ifTrue:[
-                          thisIsPrivate ifFalse:[
+                          buildPrivateClass ifFalse:[
                               "notify change of category"
                               namespace changed:#organization.
                               namespace ~~ Smalltalk ifTrue:[
@@ -836,7 +821,7 @@
                   "notify change of organization"
                   oldClass category:category. 
                   namespace notNil ifTrue:[
-                      thisIsPrivate ifFalse:[ 
+                      buildPrivateClass ifFalse:[ 
                           "notify change of organization"
                           namespace changed:#organization.
                           namespace ~~ Smalltalk ifTrue:[
@@ -1204,7 +1189,7 @@
     "/ and make the new class globally known
 
     namespace notNil ifTrue:[
-        thisIsPrivate ifTrue:[
+        buildPrivateClass ifTrue:[
             namespace privateClassesAt:classSymbol put:newClass.
         ] ifFalse:[
             namespace at:nameKey put:newClass.
@@ -1241,7 +1226,7 @@
 
     oldClass ~~ newClass ifTrue:[
         namespace notNil ifTrue:[
-            thisIsPrivate ifFalse:[
+            buildPrivateClass ifFalse:[
                 namespace == Smalltalk ifTrue:[
                     ClassBuilder checkForAliasesOf:oldClass with:newClass.
                 ].
@@ -1259,7 +1244,7 @@
 !
 
 changeReferencesFrom:oldClass to:newClass
-    |answer refs|
+    | refs|
 
     refs := OrderedCollection new.
     ObjectMemory allObjectsDo:[:obj |
@@ -1311,6 +1296,26 @@
     ].
 !
 
+instantiateMetaclass
+    "create the metaclass proper"
+
+    |newMetaclass classesSuperclass|
+
+    buildPrivateClass ifTrue:[
+        newMetaclass := PrivateMetaclass new
+    ] ifFalse:[
+        newMetaclass := Metaclass new.
+    ].
+    superClass isNil ifTrue:[
+        classesSuperclass := Class.
+    ] ifFalse:[
+        classesSuperclass := superClass class.
+    ].
+    newMetaclass setSuperclass:classesSuperclass instSize:(classesSuperclass instSize + classInstanceVariableNames countWords).
+    newMetaclass setInstanceVariableString:classInstanceVariableNames.
+    ^ newMetaclass
+!
+
 rebuildForChangedInstanceVariables
     "changing / adding class-inst vars -
      this actually creates a new metaclass and class, leaving the original
@@ -1387,10 +1392,10 @@
      create the new metaclass
     "
     oldMetaClass isPrivate ifTrue:[
-        newMetaclass := PrivateMetaclass new.
+        newMetaclass := oldMetaClass class "PrivateMetaclass" new.
         newMetaclass setOwningClass:(oldMetaClass owningClass).
     ] ifFalse:[
-        newMetaclass := Metaclass new.
+        newMetaclass := oldMetaClass class "Metaclass" new.
     ].
     superclass := oldMetaClass superclass.
     newMetaclass setSuperclass:superclass.
@@ -1906,5 +1911,5 @@
 !ClassBuilder class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.14 2002-02-26 10:27:31 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.15 2002-05-02 08:51:36 cg Exp $'
 ! !