--- 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 $'
! !