--- a/ClassBuilder.st Mon Jun 11 12:51:48 2007 +0200
+++ b/ClassBuilder.st Mon Jun 11 12:52:23 2007 +0200
@@ -13,11 +13,11 @@
Object subclass:#ClassBuilder
instanceVariableNames:'metaclass className environment superClass instanceVariableNames
- variable words pointers classVariableNames poolDictionaries
- category comment changed classInstanceVariableNames oldMetaClass
- oldClass oldPoolDictionaries oldSuperClass oldClassVars
- oldInstVars realNewName buildPrivateClass buildingPrivateClass
- nameKey newSuperClass superClassChange newClassVars newInstVars
+ flags classVariableNames poolDictionaries category comment
+ changed classInstanceVariableNames oldMetaClass oldClass
+ oldPoolDictionaries oldSuperClass oldClassVars oldInstVars
+ realNewName buildPrivateClass buildingPrivateClass nameKey
+ newSuperClass superClassChange newClassVars newInstVars
classVarChange instVarChange recompileGlobalAccessTo
oldClassToBecomeNew'
classVariableNames:''
@@ -288,15 +288,22 @@
environment := aSystemDictionaryOrClass.
superClass := aClass.
instanceVariableNames := stringOfInstVarNames.
- variable := variableBoolean.
- words := wordsBoolean.
- pointers := pointersBoolean.
+
+ "/ Allowing non-booleans as variableBoolean
+ "/ is a hack for backward (ST-80) compatibility:
+ "/ ST-80 code will pass true or false as variableBoolean,
+ "/ while ST/X also calls it with symbols such as #float, #double etc.
+
+ flags := self flagsForVariable:variableBoolean pointers:pointersBoolean words:wordsBoolean.
+
classVariableNames := stringOfClassVarNames.
poolDictionaries := stringOfPoolNames.
category := categoryString.
comment := commentString.
changed := changedBoolean.
classInstanceVariableNames := stringOfClassInstVarNamesOrNil
+
+ "Modified: / 07-06-2007 / 12:16:57 / cg"
!
oldMetaclass:aMetaclass instanceVariableNames:stringOfInstVarNames
@@ -370,8 +377,9 @@
].
].
+ buildingPrivateClass := false.
environment notNil ifTrue:[
- (self determineNewName) ifFalse:[
+ self determineNewName ifFalse:[
^ nil.
].
].
@@ -444,7 +452,9 @@
"/ hints - warn, if creating a variableSubclass of a Set
"/ (common error - containers in ST/X do not use variable-slots)
"/
- ((variable == true) and:[pointers]) ifTrue:[
+
+ (flags bitAnd:Behavior maskIndexType) == (Behavior flagForSymbolic:#objects)
+ "((variable == true) and:[pointers])" ifTrue:[
(oldClass isKindOf:Set class) ifTrue:[
(self confirm:('ST/X Set & Dictionary are not variable-classes.\Create %1 anyway ?' bindWith:className) withCRs)
ifFalse:[
@@ -569,7 +579,19 @@
"Created: / 26-05-1996 / 11:55:26 / cg"
"Modified: / 18-03-1999 / 18:23:31 / stefan"
- "Modified: / 16-05-2007 / 13:31:36 / cg"
+ "Modified: / 07-06-2007 / 12:20:36 / cg"
+!
+
+newSubclassOf:baseClass type:typeOfClass instanceVariables:instanceVariables from:oldClassArg
+ "anonymous classes can be built with this entry"
+
+ superClass := baseClass.
+ flags := Behavior flagForSymbolic:typeOfClass.
+ instanceVariableNames := instanceVariables.
+ oldClass := oldClassArg.
+ ^ self buildClass.
+
+ "Created: / 07-06-2007 / 12:04:47 / cg"
! !
!ClassBuilder methodsFor:'building-helpers'!
@@ -953,6 +975,30 @@
].
!
+flagsForVariable:variable pointers:pointers words:words
+ "/ Allowing non-booleans as variable is a hack for STX / ST80 compatibility:
+ "/ ST80 code will pass true or false as variableBoolean,
+ "/ STX also calls it with symbols such as #float, #double, #longLong etc.
+
+ variable isSymbol ifTrue:[
+ ^ Behavior flagForSymbolic:variable.
+ ].
+
+ variable ifFalse:[
+ ^ Behavior flagRegular
+ ].
+
+ pointers ifTrue:[
+ ^ Behavior flagPointers
+ ].
+ words ifTrue:[
+ ^ Behavior flagWords
+ ].
+ ^ Behavior flagBytes
+
+ "Created: / 07-06-2007 / 12:08:47 / cg"
+!
+
handleEasyNewClass:newClass
"instance layout remains the same.
We only have to recompile methods which access changed class variables
@@ -1277,7 +1323,7 @@
instantiateMetaclass
"create the metaclass proper"
- |newMetaclass classesSuperclass|
+ |metaclassClass newMetaclass classesSuperclass|
classInstanceVariableNames isNil ifTrue:[
oldClass isNil ifTrue:[
@@ -1287,11 +1333,11 @@
]
].
+ metaclassClass := metaclass ? Metaclass.
buildingPrivateClass ifTrue:[
- newMetaclass := metaclass asPrivate new
- ] ifFalse:[
- newMetaclass := metaclass new.
+ metaclassClass := metaclassClass asPrivate
].
+ newMetaclass := metaclassClass new.
superClass isNil ifTrue:[
classesSuperclass := self classClass.
] ifFalse:[
@@ -1303,6 +1349,8 @@
newMetaclass setOwningClass:environment.
].
^ newMetaclass
+
+ "Modified: / 07-06-2007 / 12:24:34 / cg"
!
instantiateNewClassFrom:newMetaclass
@@ -1797,25 +1845,7 @@
nInstVars := 0.
].
- "/ Allowing non-booleans as variableBoolean
- "/ is a hack for backward (ST-80) compatibility:
- "/ ST-80 code will pass true or false as variableBoolean,
- "/ while ST/X also calls it with symbols such as #float, #double etc.
-
- (variable == true) ifTrue:[
- pointers ifTrue:[
- newFlags := Behavior flagPointers
- ] ifFalse:[
- words ifTrue:[
- newFlags := Behavior flagWords
- ] ifFalse:[
- newFlags := Behavior flagBytes
- ]
- ]
- ] ifFalse:[
- "/ false or symbol.
- newFlags := Behavior flagForSymbolic:variable.
- ].
+ newFlags := flags. "/ self flagsForVariable:variable pointers:pointers words:words.
superClass isNil ifTrue:[
superFlags := 0
] ifFalse:[
@@ -1846,7 +1876,7 @@
].
newClass setClassVariableString:classVariableNames.
- "Modified: / 06-10-2006 / 13:17:14 / cg"
+ "Modified: / 07-06-2007 / 12:13:55 / cg"
! !
!ClassBuilder methodsFor:'checks'!
@@ -2135,5 +2165,5 @@
!ClassBuilder class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.73 2007-05-16 18:41:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.74 2007-06-11 10:52:23 cg Exp $'
! !