avoid intermediate Object subclass creation.
Only create minimum protocol, if the corresponding
query returns true (which is true if done in the browser).
This avoids those methods to be defined for filedIn classes.
--- a/UndefObj.st Fri Jan 03 16:38:26 1997 +0100
+++ b/UndefObj.st Fri Jan 03 16:40:48 1997 +0100
@@ -12,7 +12,7 @@
Object subclass:#UndefinedObject
instanceVariableNames:''
- classVariableNames:''
+ classVariableNames:'CreateMinimumProtocolInNewSubclassQuery'
poolDictionaries:''
category:'Kernel-Objects'
!
@@ -41,9 +41,9 @@
All instance variables, array elements and even method/block local
variables are initially set to nil.
- Since in Smalltalk/X, nil is represented by a special pointer value (NULL),
- there can be only one instance of UndefinedObject, and no subclassing is
- possible.
+ Since in Smalltalk/X (and in other smalltalks), nil is represented by
+ a special pointer value (NULL), there can be only one instance of UndefinedObject,
+ and no subclassing is possible.
(to be exact: subclassing UndefinedObject is technically possible,
but instances of it would not be recognized as being nil
- therefore, subclassing is blocked and an error is raised when it is tried)
@@ -61,6 +61,23 @@
"
! !
+!UndefinedObject class methodsFor:'initialization'!
+
+initialize
+ CreateMinimumProtocolInNewSubclassQuery isNil ifTrue:[
+ CreateMinimumProtocolInNewSubclassQuery := QuerySignal new.
+ CreateMinimumProtocolInNewSubclassQuery nameClass:self message:#createMinimumProtocolInNewSubclassQuery.
+ CreateMinimumProtocolInNewSubclassQuery defaultAnswer:false.
+ ].
+
+ "
+ UndefinedObject initialize
+ "
+
+ "Created: 3.1.1997 / 15:02:40 / cg"
+ "Modified: 3.1.1997 / 15:18:33 / cg"
+! !
+
!UndefinedObject class methodsFor:'instance creation'!
basicNew
@@ -75,6 +92,21 @@
^ nil
! !
+!UndefinedObject class methodsFor:'Signal constants'!
+
+createMinimumProtocolInNewSubclassQuery
+ "return the signal used to ask if the minimum required protocol
+ should be created for nil subclasses.
+ By default, this is not done, however, the browser answers true
+ here, to avoid big trouble with nil subclasses which do not define
+ some methods which the inspector needs."
+
+ ^ CreateMinimumProtocolInNewSubclassQuery
+
+ "Created: 3.1.1997 / 15:05:48 / cg"
+ "Modified: 3.1.1997 / 15:06:15 / cg"
+! !
+
!UndefinedObject class methodsFor:'queries'!
canBeSubclassed
@@ -167,34 +199,40 @@
!UndefinedObject methodsFor:'subclass creation'!
-nilSubclass:selector args:args
+nilSubclass:action
"common helper for subclass creation.
- Creates a nil-superclass class with entries for the minimum
- required protocol (#class, #isBehavior and #doesNotUnderstand:).
+ Creates a nil-superclass class.
+ If the CreateMinimumProtocolInNewSubclassQuery answers true,
+ entries for the minimum required protocol (#class, #isBehavior
+ and #doesNotUnderstand:) are also automatically created.
+ (this query is typically answered by the browser)
These are required to avoid getting into deep trouble when
inspecting or debugging instances of this new class.
-
The methods get a modified source code to remind you that these
methods were automatically generated."
|newClass methodDict method|
Class withoutUpdatingChangesDo:[
- newClass := Object perform:selector withArguments:args
+ newClass := action value
].
newClass notNil ifTrue:[
newClass setSuperclass:nil.
newClass class setSuperclass:Class.
newClass methodDictionary size == 0 ifTrue:[
- "
- copy over method objects from Object
- and modify the source code
- "
- methodDict := MethodDictionary new:3.
- #(#class #isBehavior #doesNotUnderstand:) do:[:sel|
- method := (Object compiledMethodAt:sel) copy.
- method source: method source , '
+ Class addChangeRecordForClass:newClass.
+
+ CreateMinimumProtocolInNewSubclassQuery raise
+ ifTrue:[
+ "
+ copy over method objects from Object
+ and modify the source code
+ "
+ methodDict := MethodDictionary new:3.
+ #(#class #isBehavior #doesNotUnderstand:) do:[:sel|
+ method := (Object compiledMethodAt:sel) copy.
+ method source: method source , '
"
*** WARNING
***
@@ -206,37 +244,90 @@
*** if you remove/change this method.
"
'.
- methodDict at:sel put:method.
- ].
- newClass methodDictionary:methodDict.
- Class addChangeRecordForClass:newClass.
+ methodDict at:sel put:method.
+"/ newClass addChangeRecordForMethod:method
+ ].
+ newClass methodDictionary:methodDict.
+ ]
]
].
^ newClass
"Modified: 12.6.1996 / 10:46:15 / stefan"
- "Modified: 22.10.1996 / 20:30:06 / cg"
+ "Modified: 3.1.1997 / 15:53:21 / cg"
+ "Created: 3.1.1997 / 16:00:34 / cg"
!
-subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
"create a new class which has nil as superclass
- - i.e. traps into doesNotUnderstand: for all of its messages."
+ - i.e. traps into #doesNotUnderstand: for all of its messages."
- ^ self nilSubclass:(thisContext selector) args:(thisContext args)
+ ^ self
+ nilSubclass:[
+ Object class
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal raise)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:false
+ words:true
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ ]
+
+ "Modified: 3.1.1997 / 16:00:39 / cg"
!
-variableByteSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+variableByteSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
"create a new class which has nil as superclass
- - i.e. traps into doesNotUnderstand: for all of its messages."
+ - i.e. traps into #doesNotUnderstand: for all of its messages."
- ^ self nilSubclass:(thisContext selector) args:(thisContext args)
+ ^ self
+ nilSubclass:[
+ Object class
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal raise)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ ]
+
+ "Modified: 3.1.1997 / 16:00:42 / cg"
!
-variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
"create a new class which has nil as superclass
- - i.e. traps into doesNotUnderstand: for all of its messages."
+ - i.e. traps into #doesNotUnderstand: for all of its messages."
- ^ self nilSubclass:(thisContext selector) args:(thisContext args)
+ ^ self
+ nilSubclass:[
+ Object class
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal raise)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ ]
+
+ "Modified: 3.1.1997 / 16:00:45 / cg"
! !
!UndefinedObject methodsFor:'testing'!
@@ -325,5 +416,6 @@
!UndefinedObject class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Attic/UndefObj.st,v 1.28 1996-11-10 17:37:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Attic/UndefObj.st,v 1.29 1997-01-03 15:40:48 cg Exp $'
! !
+UndefinedObject initialize!
--- a/UndefinedObject.st Fri Jan 03 16:38:26 1997 +0100
+++ b/UndefinedObject.st Fri Jan 03 16:40:48 1997 +0100
@@ -12,7 +12,7 @@
Object subclass:#UndefinedObject
instanceVariableNames:''
- classVariableNames:''
+ classVariableNames:'CreateMinimumProtocolInNewSubclassQuery'
poolDictionaries:''
category:'Kernel-Objects'
!
@@ -41,9 +41,9 @@
All instance variables, array elements and even method/block local
variables are initially set to nil.
- Since in Smalltalk/X, nil is represented by a special pointer value (NULL),
- there can be only one instance of UndefinedObject, and no subclassing is
- possible.
+ Since in Smalltalk/X (and in other smalltalks), nil is represented by
+ a special pointer value (NULL), there can be only one instance of UndefinedObject,
+ and no subclassing is possible.
(to be exact: subclassing UndefinedObject is technically possible,
but instances of it would not be recognized as being nil
- therefore, subclassing is blocked and an error is raised when it is tried)
@@ -61,6 +61,23 @@
"
! !
+!UndefinedObject class methodsFor:'initialization'!
+
+initialize
+ CreateMinimumProtocolInNewSubclassQuery isNil ifTrue:[
+ CreateMinimumProtocolInNewSubclassQuery := QuerySignal new.
+ CreateMinimumProtocolInNewSubclassQuery nameClass:self message:#createMinimumProtocolInNewSubclassQuery.
+ CreateMinimumProtocolInNewSubclassQuery defaultAnswer:false.
+ ].
+
+ "
+ UndefinedObject initialize
+ "
+
+ "Created: 3.1.1997 / 15:02:40 / cg"
+ "Modified: 3.1.1997 / 15:18:33 / cg"
+! !
+
!UndefinedObject class methodsFor:'instance creation'!
basicNew
@@ -75,6 +92,21 @@
^ nil
! !
+!UndefinedObject class methodsFor:'Signal constants'!
+
+createMinimumProtocolInNewSubclassQuery
+ "return the signal used to ask if the minimum required protocol
+ should be created for nil subclasses.
+ By default, this is not done, however, the browser answers true
+ here, to avoid big trouble with nil subclasses which do not define
+ some methods which the inspector needs."
+
+ ^ CreateMinimumProtocolInNewSubclassQuery
+
+ "Created: 3.1.1997 / 15:05:48 / cg"
+ "Modified: 3.1.1997 / 15:06:15 / cg"
+! !
+
!UndefinedObject class methodsFor:'queries'!
canBeSubclassed
@@ -167,34 +199,40 @@
!UndefinedObject methodsFor:'subclass creation'!
-nilSubclass:selector args:args
+nilSubclass:action
"common helper for subclass creation.
- Creates a nil-superclass class with entries for the minimum
- required protocol (#class, #isBehavior and #doesNotUnderstand:).
+ Creates a nil-superclass class.
+ If the CreateMinimumProtocolInNewSubclassQuery answers true,
+ entries for the minimum required protocol (#class, #isBehavior
+ and #doesNotUnderstand:) are also automatically created.
+ (this query is typically answered by the browser)
These are required to avoid getting into deep trouble when
inspecting or debugging instances of this new class.
-
The methods get a modified source code to remind you that these
methods were automatically generated."
|newClass methodDict method|
Class withoutUpdatingChangesDo:[
- newClass := Object perform:selector withArguments:args
+ newClass := action value
].
newClass notNil ifTrue:[
newClass setSuperclass:nil.
newClass class setSuperclass:Class.
newClass methodDictionary size == 0 ifTrue:[
- "
- copy over method objects from Object
- and modify the source code
- "
- methodDict := MethodDictionary new:3.
- #(#class #isBehavior #doesNotUnderstand:) do:[:sel|
- method := (Object compiledMethodAt:sel) copy.
- method source: method source , '
+ Class addChangeRecordForClass:newClass.
+
+ CreateMinimumProtocolInNewSubclassQuery raise
+ ifTrue:[
+ "
+ copy over method objects from Object
+ and modify the source code
+ "
+ methodDict := MethodDictionary new:3.
+ #(#class #isBehavior #doesNotUnderstand:) do:[:sel|
+ method := (Object compiledMethodAt:sel) copy.
+ method source: method source , '
"
*** WARNING
***
@@ -206,37 +244,90 @@
*** if you remove/change this method.
"
'.
- methodDict at:sel put:method.
- ].
- newClass methodDictionary:methodDict.
- Class addChangeRecordForClass:newClass.
+ methodDict at:sel put:method.
+"/ newClass addChangeRecordForMethod:method
+ ].
+ newClass methodDictionary:methodDict.
+ ]
]
].
^ newClass
"Modified: 12.6.1996 / 10:46:15 / stefan"
- "Modified: 22.10.1996 / 20:30:06 / cg"
+ "Modified: 3.1.1997 / 15:53:21 / cg"
+ "Created: 3.1.1997 / 16:00:34 / cg"
!
-subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
"create a new class which has nil as superclass
- - i.e. traps into doesNotUnderstand: for all of its messages."
+ - i.e. traps into #doesNotUnderstand: for all of its messages."
- ^ self nilSubclass:(thisContext selector) args:(thisContext args)
+ ^ self
+ nilSubclass:[
+ Object class
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal raise)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:false
+ words:true
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ ]
+
+ "Modified: 3.1.1997 / 16:00:39 / cg"
!
-variableByteSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+variableByteSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
"create a new class which has nil as superclass
- - i.e. traps into doesNotUnderstand: for all of its messages."
+ - i.e. traps into #doesNotUnderstand: for all of its messages."
- ^ self nilSubclass:(thisContext selector) args:(thisContext args)
+ ^ self
+ nilSubclass:[
+ Object class
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal raise)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:false
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ ]
+
+ "Modified: 3.1.1997 / 16:00:42 / cg"
!
-variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
"create a new class which has nil as superclass
- - i.e. traps into doesNotUnderstand: for all of its messages."
+ - i.e. traps into #doesNotUnderstand: for all of its messages."
- ^ self nilSubclass:(thisContext selector) args:(thisContext args)
+ ^ self
+ nilSubclass:[
+ Object class
+ name:nameSymbol
+ inEnvironment:(Class nameSpaceQuerySignal raise)
+ subclassOf:self
+ instanceVariableNames:instVarNameString
+ variable:true
+ words:false
+ pointers:true
+ classVariableNames:classVarString
+ poolDictionaries:pool
+ category:cat
+ comment:nil
+ changed:true
+ ]
+
+ "Modified: 3.1.1997 / 16:00:45 / cg"
! !
!UndefinedObject methodsFor:'testing'!
@@ -325,5 +416,6 @@
!UndefinedObject class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.28 1996-11-10 17:37:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.29 1997-01-03 15:40:48 cg Exp $'
! !
+UndefinedObject initialize!