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