--- a/extensions.st Mon Oct 26 16:26:40 2009 +0100
+++ b/extensions.st Mon Oct 26 17:36:21 2009 +0100
@@ -1,20 +1,35 @@
-"{ Package: 'stx:goodies/monticello' }"
-!
+"{ Package: 'stx:goodies/monticello' }"!
+
+!Behavior methodsFor:'* monticello'!
+
+typeOfClass
+ "Answer a symbol uniquely describing the type of the receiver"
+
+ "/ self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
+ (self isSubclassOf:#CompiledCode) ifTrue:[^#compiledMethod]. "Very special!!"
+ self isBytes ifTrue:[^#bytes].
+ (self isWords and:[self isPointers not]) ifTrue:[^#words].
+ (self isLongs and:[self isPointers not]) ifTrue:[^#longs].
+ self isWeakPointers ifTrue:[^#weak].
+ "/ self isWeak ifTrue:[^#weak].
+ self isVariable ifTrue:[^#variable].
+ ^#normal.
+! !
!Class methodsFor:'*monticello'!
asClassDefinition
- ^ MCClassDefinition
- name: self name
- superclassName: self superclass name
- category: self category
- instVarNames: self instVarNames
- classVarNames: self classVarNames
- poolDictionaryNames: self poolDictionaryNames
- classInstVarNames: self class instVarNames
- type: self typeOfClass
- comment: self organization classComment asString
- commentStamp: self organization commentStamp
+ ^ MCClassDefinition
+ name: self name
+ superclassName: self superclass name
+ category: self category
+ instVarNames: self instVarNames
+ classVarNames: self classVarNames
+ poolDictionaryNames: self poolDictionaryNames
+ classInstVarNames: self class instVarNames
+ type: self typeOfClass
+ comment: (Smalltalk isSmalltalkX ifTrue:[self comment] ifFalse:[ self organization classComment asString ])
+ commentStamp: (Smalltalk isSmalltalkX ifTrue:[nil] ifFalse:[self organization commentStamp])
! !
!Class methodsFor:'*monticello'!
@@ -29,6 +44,40 @@
^ self sharedPools collect: [:ea | self environment keyAtIdentityValue: ea]
! !
+!ClassBuilder methodsFor:'compatibility - squeak'!
+
+name:newName
+ inEnvironment:aSystemDictionaryOrClass
+ subclassOf:aClass
+ type: type
+ instanceVariableNames: stringOfInstVarNames
+ classVariableNames: stringOfClassVarNames
+ poolDictionaries: stringOfPoolNames
+ category: categoryString
+
+ |variableBoolean wordsBoolean pointersBoolean|
+
+ variableBoolean := wordsBoolean := pointersBoolean := false.
+ type ~~ #normal ifTrue:[
+self halt:'todo'.
+ ].
+
+ self
+ name:newName
+ inEnvironment:aSystemDictionaryOrClass
+ subclassOf:aClass
+ instanceVariableNames:stringOfInstVarNames
+ variable:variableBoolean
+ words:wordsBoolean
+ pointers:pointersBoolean
+ classVariableNames:stringOfClassVarNames
+ poolDictionaries:stringOfPoolNames
+ category:categoryString
+ comment:''
+ changed:false
+ classInstanceVariableNames:''.
+! !
+
!Object methodsFor:'*monticello'!
isConflict
@@ -47,3 +96,11 @@
^ ('0', self select: [:ea | ea isDigit]) asNumber
! !
+!UndefinedObject methodsFor:'* monticello'!
+
+typeOfClass
+ "Necessary to support disjoint class hierarchies."
+
+ ^#normal
+! !
+