diff -r 6a03b5a9d4e2 -r 8ba8b1002902 UndefinedObject.st --- 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!