Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

4488 lines (3413 sloc) 152.317 kb
ProtoObject subclass: #ProtoObject
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Objects'.
"ProtoObject superclass: nil"!
!ProtoObject commentStamp: '<historical>' prior: 0!
ProtoObject establishes minimal behavior required of any object in Squeak, even objects that should balk at normal object behavior. Generally these are proxy objects designed to read themselves in from the disk, or to perform some wrapper behavior, before responding to a message. Current examples are ObjectOut and ImageSegmentRootStub, and one could argue that ObjectTracer should also inherit from this class.
ProtoObject has no instance variables, nor should any be added.!
!ProtoObject methodsFor: '*deprecated13' stamp: 'MarcusDenker 4/27/2011 19:58'!
executeMethod: compiledMethod
"Execute compiledMethod against the receiver with no args"
self deprecated: 'use #withArgs:executeMethod:' on: '2011-04-27' in: 'Pharo1.3'.
^ self withArgs: #() executeMethod: compiledMethod! !
!ProtoObject methodsFor: '*deprecated13' stamp: 'MarcusDenker 4/27/2011 19:58'!
with: arg1 executeMethod: compiledMethod
"Execute compiledMethod against the receiver and arg1"
self deprecated: 'use #withArgs:executeMethod:' on: '2011-04-27' in: 'Pharo1.3'.
^ self withArgs: {arg1} executeMethod: compiledMethod! !
!ProtoObject methodsFor: '*deprecated13' stamp: 'MarcusDenker 4/27/2011 19:58'!
with: arg1 with: arg2 executeMethod: compiledMethod
"Execute compiledMethod against the receiver and arg1 & arg2"
self deprecated: 'use #withArgs:executeMethod:' on: '2011-04-27' in: 'Pharo1.3'.
^ self withArgs: {arg1. arg2} executeMethod: compiledMethod! !
!ProtoObject methodsFor: '*deprecated13' stamp: 'MarcusDenker 4/27/2011 19:58'!
with: arg1 with: arg2 with: arg3 executeMethod: compiledMethod
"Execute compiledMethod against the receiver and arg1, arg2, & arg3"
self deprecated: 'use #withArgs:executeMethod:' on: '2011-04-27' in: 'Pharo1.3'.
^ self withArgs: {arg1. arg2. arg3} executeMethod: compiledMethod! !
!ProtoObject methodsFor: '*deprecated13' stamp: 'MarcusDenker 4/27/2011 19:58'!
with: arg1 with: arg2 with: arg3 with: arg4 executeMethod: compiledMethod
"Execute compiledMethod against the receiver and arg1, arg2, arg3, & arg4"
self deprecated: 'use #withArgs:executeMethod:' on: '2011-04-27' in: 'Pharo1.3'.
^ self withArgs: {arg1. arg2. arg3. arg4} executeMethod: compiledMethod! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:20'!
tryNamedPrimitive
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:20'!
tryNamedPrimitive: arg1
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:20'!
tryNamedPrimitive: arg1 with: arg2
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:20'!
tryNamedPrimitive: arg1 with: arg2 with: arg3
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:20'!
tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:21'!
tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:21'!
tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:21'!
tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:21'!
tryNamedPrimitive: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive:'' module:''>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'apply primitives' stamp: 'ajh 1/31/2003 22:21'!
tryPrimitive: primIndex withArgs: argumentArray
"This method is a template that the Smalltalk simulator uses to
execute primitives. See Object documentation whatIsAPrimitive."
<primitive: 118>
^ ContextPart primitiveFailToken! !
!ProtoObject methodsFor: 'comparing' stamp: 'G.C 10/23/2008 10:13'!
== anObject
"Primitive. Answer whether the receiver and the argument are the same
object (have the same object pointer). Do not redefine the message == in
any other class!! Essential. No Lookup. Do not override in any subclass.
See Object documentation whatIsAPrimitive."
<primitive: 110>
self primitiveFailed! !
!ProtoObject methodsFor: 'comparing' stamp: 'MartinMcClure 3/21/2010 16:40'!
identityHash
"Answer a SmallInteger whose value is related to the receiver's identity.
This method must not be overridden, except by SmallInteger.
Do not override."
^ self basicIdentityHash bitShift: 18! !
!ProtoObject methodsFor: 'comparing' stamp: 'md 11/24/1999 19:27'!
~~ anObject
"Answer whether the receiver and the argument are not the same object
(do not have the same object pointer)."
self == anObject
ifTrue: [^ false]
ifFalse: [^ true]! !
!ProtoObject methodsFor: 'debugging' stamp: 'simon.denier 6/11/2010 14:47'!
doOnlyOnce: aBlock
"If the 'one-shot' mechanism is armed, evaluate aBlock once and disarm the one-shot mechanism. To rearm the mechanism, evaluate 'self rearmOneShot' manually."
(Smalltalk globals at: #OneShotArmed ifAbsent: [ true ])
ifTrue: [
Smalltalk globals at: #OneShotArmed put: false.
aBlock value ]! !
!ProtoObject methodsFor: 'debugging' stamp: 'marcus.denker 8/25/2008 09:12'!
flag: aSymbol
"Send this message, with a relevant symbol as argument, to flag a message for subsequent retrieval. For example, you might put the following line in a number of messages:
self flag: #returnHereUrgently
Then, to retrieve all such messages, browse all senders of #returnHereUrgently."! !
!ProtoObject methodsFor: 'debugging' stamp: 'simon.denier 6/11/2010 14:47'!
rearmOneShot
"Call this manually to arm the one-shot mechanism; use the mechanism in code by calling
self doOnlyOnce: <a block>"
Smalltalk globals at: #OneShotArmed put: true
"self rearmOneShot"
! !
!ProtoObject methodsFor: 'debugging' stamp: 'eem 4/8/2009 19:10'!
withArgs: argArray executeMethod: compiledMethod
"Execute compiledMethod against the receiver and args in argArray"
<primitive: 188>
self primitiveFailed! !
!ProtoObject methodsFor: 'initialize-release'!
initialize
^ self! !
!ProtoObject methodsFor: 'objects from disk' stamp: 'md 11/24/1999 20:03'!
rehash
"Do nothing. Here so sending this to a Set does not have to do a time consuming respondsTo:"! !
!ProtoObject methodsFor: 'system primitives' stamp: 'MartinMcClure 1/12/2010 21:10'!
basicIdentityHash
"Answer a SmallInteger whose value is related to the receiver's identity.
This method must not be overridden, except by SmallInteger.
Primitive. Fails if the receiver is a SmallInteger. Essential.
See Object documentation whatIsAPrimitive.
Do not override. Use #identityHash unless you really know what you're doing.'"
<primitive: 75>
self primitiveFailed! !
!ProtoObject methodsFor: 'system primitives' stamp: 'md 11/24/1999 19:30'!
become: otherObject
"Primitive. Swap the object pointers of the receiver and the argument.
All variables in the entire system that used to point to the
receiver now point to the argument, and vice-versa.
Fails if either object is a SmallInteger"
(Array with: self)
elementsExchangeIdentityWith:
(Array with: otherObject)! !
!ProtoObject methodsFor: 'system primitives' stamp: 'ajh 1/13/2002 17:02'!
cannotInterpret: aMessage
"Handle the fact that there was an attempt to send the given message to the receiver but a null methodDictionary was encountered while looking up the message selector. Hopefully this is the result of encountering a stub for a swapped out class which induces this exception on purpose."
"If this is the result of encountering a swap-out stub, then simulating the lookup in Smalltalk should suffice to install the class properly, and the message may be resent."
(self class lookupSelector: aMessage selector) == nil ifFalse:
["Simulated lookup succeeded -- resend the message."
^ aMessage sentTo: self].
"Could not recover by simulated lookup -- it's an error"
Error signal: 'MethodDictionary fault'.
"Try again in case an error handler fixed things"
^ aMessage sentTo: self! !
!ProtoObject methodsFor: 'system primitives' stamp: 'ajh 10/9/2001 17:20'!
doesNotUnderstand: aMessage
^ MessageNotUnderstood new
message: aMessage;
receiver: self;
signal! !
!ProtoObject methodsFor: 'system primitives' stamp: 'md 11/24/1999 19:58'!
nextInstance
"Primitive. Answer the next instance after the receiver in the
enumeration of all instances of this class. Fails if all instances have been
enumerated. Essential. See Object documentation whatIsAPrimitive."
<primitive: 78>
^nil! !
!ProtoObject methodsFor: 'system primitives' stamp: 'md 11/24/1999 19:58'!
nextObject
"Primitive. Answer the next object after the receiver in the
enumeration of all objects. Return 0 when all objects have been
enumerated."
<primitive: 139>
self primitiveFailed.! !
!ProtoObject methodsFor: 'testing' stamp: 'md 11/24/1999 19:23'!
ifNil: nilBlock
"Return self, or evaluate the block if I'm == nil (q.v.)"
^ self! !
!ProtoObject methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/1/2010 13:29'!
ifNil: nilBlock ifNotNil: ifNotNilBlock
"Evaluate the block, unless I'm == nil (q.v.)"
^ ifNotNilBlock cull: self! !
!ProtoObject methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/1/2010 13:29'!
ifNotNil: ifNotNilBlock
"Evaluate the block, unless I'm == nil (q.v.)"
^ ifNotNilBlock cull: self! !
!ProtoObject methodsFor: 'testing' stamp: 'HenrikSperreJohansen 6/1/2010 13:30'!
ifNotNil: ifNotNilBlock ifNil: nilBlock
"If I got here, I am not nil, so evaluate the block ifNotNilBlock"
^ ifNotNilBlock cull: self! !
!ProtoObject methodsFor: 'testing' stamp: 'md 11/24/1999 19:26'!
isNil
"Coerces nil to true and everything else to false."
^false! !
!ProtoObject methodsFor: 'testing' stamp: 'AndyKellens 6/11/2010 14:14'!
pointersTo
^self pointersToExcept: #()! !
!ProtoObject methodsFor: 'testing' stamp: 'AndyKellens 6/11/2010 14:14'!
pointersToExcept: objectsToExclude
"Find all occurrences in the system of pointers to the argument anObject.
Remove objects in the exclusion list from the results."
| results anObj |
Smalltalk garbageCollect.
"big collection shouldn't grow, so it's contents array is always the same"
results := OrderedCollection new: 1000.
"allObjectsDo: is expanded inline to keep spurious
method and block contexts out of the results"
anObj := self someObject.
[0 == anObj] whileFalse: [
(anObj pointsTo: self) ifTrue: [
"exclude the results collector and contexts in call chain"
((anObj ~~ results collector) and:
[(anObj ~~ objectsToExclude) and:
[(anObj ~~ thisContext) and:
[(anObj ~~ thisContext sender) and:
[anObj ~~ thisContext sender sender]]]])
ifTrue: [ results add: anObj ].
].
anObj := anObj nextObject.
].
objectsToExclude do: [ :obj | results removeAllSuchThat: [ :el | el == obj]].
^ results asArray
! !
!ProtoObject methodsFor: 'testing' stamp: 'Mariano 4/30/2010 16:20'!
pointsTo: anObject
"This method returns true if self contains a pointer to anObject,
and returns false otherwise"
<primitive: 132>
"This is the same as the following smalltalk code:
1 to: self class instSize do:
[:i | (self instVarAt: i) == anObject ifTrue: [^ true]].
1 to: self basicSize do:
[:i | (self basicAt: i) == anObject ifTrue: [^ true]].
^ false"
! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ProtoObject class
instanceVariableNames: ''!
ProtoObject subclass: #Object
instanceVariableNames: ''
classVariableNames: 'DependentsFields'
poolDictionaries: ''
category: 'Kernel-Objects'!
!Object commentStamp: 'StephaneDucasse 1/3/2010 20:41' prior: 0!
Object is the root class for almost all of the other classes in the class hierarchy. The exceptions are ProtoObject (the superclass of Object) and its subclasses.
Class Object provides default behavior common to all normal objects, such as access, copying, comparison, error handling, message sending, and reflection. Also utility messages that all objects should respond to are defined here.
Object has no instance variables, nor should any be added. This is due to several classes of objects that inherit from Object that have special implementations (SmallInteger and UndefinedObject for example) or the VM knows about and depends on the structure and layout of certain standard classes.
Class Variables:
DependentsFields an IdentityDictionary
Provides a virtual 'dependents' field so that any object may have one
or more dependent views, synchronized by the changed:/update: protocol.
Note that class Model has a real slot for its dependents, and overrides
the associated protocol with more efficient implementations.
EventsFields an IdentityDictionary that maps each object to its dependents.
Registers a message send (consisting of a selector and a receiver object)
which should be performed when anEventSymbol is triggered by the receiver.
Part of a new event notification framework which could eventually replace
the existing changed/update mechanism. It is intended to be compatible
with Dolphin Smalltalk and VSE as much as possible.
Because Object is the root of the inheritance tree, methods are often defined in Object to give all objects special behaviors needed by certain subsystems or applications, or to respond to certain general test messages such as isMorph.
About at: index accepting float and not only integers
This behavior is also free in the sense that the failure code is only invoked when the
primitive fails and so adds nothing to the cost of successful accesses,
which are the high dynamic frequency operation. It will also show up under
profiling if one is concerned about efficiency, and so isn't a hidden cost.
It is also in keeping with Smalltalk's mixed mode/arbitrary precision
implicit coercion number system that one *can* use fractions or floats as
indices. Stripping out coercions like this will make the system more brittle. So
please do *not* remove this "hack". I think it's a feature and a useful one.
Can you give me an example that demonstrates the usefulness of this
feature?
| a r |
a := Array new: 10 withAll: 0.
r := Random new.
100 timesRepeat: [| v | v := r next * 10 + 1. a at: v put: (a at: v) + 1].
a
i.e. I didn't have to provide an explicit rounding step. That's useful. But in general anywhere
where an index is derived by some calculation not having to provide the rounding step could be
useful/helpful/more concise. e.g. (n roundTo: 0.1) * 10 vs ((n roundTo: 0.1) * 10) asInteger.
Some thought went into the original choice. It is not a hack but there by intent. The integers are
simply a subset of the reals and forcing the programmer to use them is favouring the machine
above the programmer.
But I think you should justify getting rid of it rather than my having to justify keeping it. Getting
rid of it risks breaking code. If it is there but does not harm then why get rid of it?
best Eliot Miranda
!
!Object methodsFor: '*Graphics-Display Objects' stamp: 'sw 3/26/2001 12:12'!
printDirectlyToDisplay
"For debugging: write the receiver's printString directly to the display at (0, 100); senders of this are detected by the check-for-slips mechanism."
self asString displayAt: 0@100
"StringMorph someInstance printDirectlyToDisplay"! !
!Object methodsFor: '*Morphic' stamp: 'AlainPlantec 12/19/2009 23:13'!
addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph
"The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items"
Morph cmdGesturesEnabled ifTrue: [ "build mode"
aCustomMenu add: 'inspect model' translated target: self action: #inspect.
].
^aCustomMenu
! !
!Object methodsFor: '*Morphic' stamp: 'svp 5/16/2000 18:14'!
asDraggableMorph
^(StringMorph contents: self printString)
color: Color white;
yourself! !
!Object methodsFor: '*Morphic' stamp: 'AlainPlantec 10/20/2009 10:14'!
asMorph
"Open a morph, as best one can, on the receiver"
^ self asStringMorph
"
234 asMorph.
(MenuIcons tinyMenuIcon) asMorph.
'fred' asMorph.
"
! !
!Object methodsFor: '*Morphic' stamp: 'nk 2/26/2004 13:35'!
asStringMorph
"Open a StringMorph, as best one can, on the receiver"
^ self asStringOrText asStringMorph
! !
!Object methodsFor: '*Morphic' stamp: 'nk 2/26/2004 13:35'!
asTextMorph
"Open a TextMorph, as best one can, on the receiver"
^ TextMorph new contentsAsIs: self asStringOrText
! !
!Object methodsFor: '*Morphic' stamp: 'ar 3/18/2001 00:03'!
currentEvent
"Answer the current Morphic event. This method never returns nil."
^ActiveEvent ifNil:[self currentHand lastEvent]! !
!Object methodsFor: '*Morphic' stamp: 'nk 9/1/2004 10:41'!
currentHand
"Return a usable HandMorph -- the one associated with the object's current environment. This method will always return a hand, even if it has to conjure one up as a last resort. If a particular hand is actually handling events at the moment (such as a remote hand or a ghost hand), it will be returned."
^ActiveHand ifNil: [ self currentWorld primaryHand ]! !
!Object methodsFor: '*Morphic' stamp: 'JuanVuletich 11/1/2010 15:18'!
currentWorld
"Answer a morphic world that is the current UI focus."
^UIManager default currentWorld! !
!Object methodsFor: '*Morphic' stamp: 'HenrikSperreJohansen 6/28/2010 12:24'!
externalName
"Answer an external name by which the receiver is known. Generic
implementation here is a transitional backstop. probably"
^ [(self asString copyWithout: Character cr)
truncateTo: 27]
ifError: [ ^ self class name printString] ! !
!Object methodsFor: '*Morphic' stamp: 'AlainPlantec 12/19/2009 23:13'!
hasModelYellowButtonMenuItems
^Morph cmdGesturesEnabled! !
!Object methodsFor: '*Morphic' stamp: 'dgd 9/25/2004 23:17'!
iconOrThumbnailOfSize: aNumberOrPoint
"Answer an appropiate form to represent the receiver"
^ nil! !
!Object methodsFor: '*Morphic' stamp: 'AlainPlantec 10/20/2009 10:15'!
openAsMorph
"Open a morph, as best one can, on the receiver"
^ self asMorph openInHand
"
234 openAsMorph.
(MenuIcons tinyMenuIcon) openAsMorph.
'fred' openAsMorph.
"! !
!Object methodsFor: '*Polymorph-EventEnhancements' stamp: 'gvc 10/25/2006 18:18'!
when: anEventSelector
send: aMessageSelector
to: anObject
exclusive: aValueHolder
self
when: anEventSelector
evaluate: ((ExclusiveWeakMessageSend
receiver: anObject
selector: aMessageSelector)
basicExecuting: aValueHolder)! !
!Object methodsFor: '*Polymorph-EventEnhancements' stamp: 'gvc 10/25/2006 18:17'!
when: anEventSelector
send: aMessageSelector
to: anObject
with: anArg
exclusive: aValueHolder
self
when: anEventSelector
evaluate: ((ExclusiveWeakMessageSend
receiver: anObject
selector: aMessageSelector
arguments: (Array with: anArg))
basicExecuting: aValueHolder)! !
!Object methodsFor: '*Polymorph-EventEnhancements' stamp: 'gvc 10/25/2006 18:17'!
when: anEventSelector
send: aMessageSelector
to: anObject
withArguments: anArgArray
exclusive: aValueHolder
self
when: anEventSelector
evaluate: ((ExclusiveWeakMessageSend
receiver: anObject
selector: aMessageSelector
arguments: anArgArray)
basicExecuting: aValueHolder)! !
!Object methodsFor: '*Polymorph-EventEnhancements' stamp: 'gvc 10/24/2006 11:50'!
when: anEventSelector
sendOnce: aMessageSelector
to: anObject
self
when: anEventSelector
evaluate: (NonReentrantWeakMessageSend
receiver: anObject
selector: aMessageSelector)! !
!Object methodsFor: '*Polymorph-EventEnhancements' stamp: 'gvc 10/24/2006 11:49'!
when: anEventSelector
sendOnce: aMessageSelector
to: anObject
with: anArg
self
when: anEventSelector
evaluate: (NonReentrantWeakMessageSend
receiver: anObject
selector: aMessageSelector
arguments: (Array with: anArg))! !
!Object methodsFor: '*Polymorph-EventEnhancements' stamp: 'gvc 10/24/2006 11:49'!
when: anEventSelector
sendOnce: aMessageSelector
to: anObject
withArguments: anArgArray
self
when: anEventSelector
evaluate: (NonReentrantWeakMessageSend
receiver: anObject
selector: aMessageSelector
arguments: anArgArray)! !
!Object methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/10/2007 11:41'!
okToClose
"Sent to models when a window closing.
Allows this check to be independent of okToChange."
^true! !
!Object methodsFor: '*Polymorph-Widgets'!
taskbarIcon
^ self class taskbarIcon! !
!Object methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/31/2009 15:52'!
taskbarLabel
"Answer the label string for the receiver in a task bar
or nil for the default."
^self class taskbarLabel! !
!Object methodsFor: '*Polymorph-Widgets' stamp: 'gvc 9/4/2007 12:32'!
windowActiveOnFirstClick
"Return true if my window should be active on first click."
^true! !
!Object methodsFor: '*System-Object Storage' stamp: 'tk 4/8/1999 12:46'!
comeFullyUpOnReload: smartRefStream
"Normally this read-in object is exactly what we want to store. 7/26/96 tk"
^ self! !
!Object methodsFor: '*System-Object Storage' stamp: 'RAA 1/10/2001 14:02'!
indexIfCompact
^0 "helps avoid a #respondsTo: in publishing"! !
!Object methodsFor: '*System-Object Storage' stamp: 'tk 2/24/1999 11:08'!
objectForDataStream: refStrm
"Return an object to store on an external data stream."
^ self! !
!Object methodsFor: '*System-Object Storage' stamp: 'tk 4/8/1999 12:05'!
readDataFrom: aDataStream size: varsOnDisk
"Fill in the fields of self based on the contents of aDataStream. Return self.
Read in the instance-variables written by Object>>storeDataOn:.
NOTE: This method must send beginReference: before reading any objects from aDataStream that might reference it.
Allow aDataStream to have fewer inst vars. See SmartRefStream."
| cntInstVars cntIndexedVars |
cntInstVars := self class instSize.
self class isVariable
ifTrue: [cntIndexedVars := varsOnDisk - cntInstVars.
cntIndexedVars < 0 ifTrue: [
self error: 'Class has changed too much. Define a convertxxx method']]
ifFalse: [cntIndexedVars := 0.
cntInstVars := varsOnDisk]. "OK if fewer than now"
aDataStream beginReference: self.
1 to: cntInstVars do:
[:i | self instVarAt: i put: aDataStream next].
1 to: cntIndexedVars do:
[:i | self basicAt: i put: aDataStream next].
"Total number read MUST be equal to varsOnDisk!!"
^ self "If we ever return something other than self, fix calls
on (super readDataFrom: aDataStream size: anInteger)"! !
!Object methodsFor: '*System-Object Storage' stamp: 'di 3/27/1999 12:21'!
rootStubInImageSegment: imageSegment
^ ImageSegmentRootStub new
xxSuperclass: nil
format: nil
segment: imageSegment! !
!Object methodsFor: '*System-Object Storage' stamp: 'tk 8/9/2001 15:40'!
storeDataOn: aDataStream
"Store myself on a DataStream. Answer self. This is a low-level DataStream/ReferenceStream method. See also objectToStoreOnDataStream. NOTE: This method must send 'aDataStream beginInstance:size:' and then (nextPut:/nextPutWeak:) its subobjects. readDataFrom:size: reads back what we write here."
| cntInstVars cntIndexedVars |
cntInstVars := self class instSize.
cntIndexedVars := self basicSize.
aDataStream
beginInstance: self class
size: cntInstVars + cntIndexedVars.
1 to: cntInstVars do:
[:i | aDataStream nextPut: (self instVarAt: i)].
"Write fields of a variable length object. When writing to a dummy
stream, don't bother to write the bytes"
((aDataStream byteStream class == DummyStream) and: [self class isBits]) ifFalse: [
1 to: cntIndexedVars do:
[:i | aDataStream nextPut: (self basicAt: i)]].
! !
!Object methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/24/2009 23:21'!
settingFixedDomainValueNodeFrom: aSettingNode
^ aSettingNode fixedDomainValueNodeForObject: self! !
!Object methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/19/2009 09:50'!
settingStoreOn: aStream
^ self storeOn: aStream! !
!Object methodsFor: '*System-Support'!
systemNavigation
^ SystemNavigation default! !
!Object methodsFor: '*Tools-Base' stamp: 'MarianoMartinezPeck 4/15/2011 17:12'!
defaultBackgroundColor
"Answer the color to be used as the base window color for a window whose model is an object of the receiver's class"
"I don't want to do a self theme because otherwise I will need to implement it on Object"
^ UITheme current windowColorFor: self! !
!Object methodsFor: '*Tools-Base' stamp: 'sw 1/18/2001 13:43'!
showDiffs
"Answer whether the receiver, serving as the model of a text-bearing entity, is 'showing differences' -- if it is, the editor may wish to show special feedback"
^ false! !
!Object methodsFor: '*Tools-Base' stamp: 'sw 10/19/1999 14:39'!
updateListsAndCodeIn: aWindow
self canDiscardEdits ifFalse: [^ self].
aWindow updatablePanes do: [:aPane | aPane verifyContents]! !
!Object methodsFor: '*Tools-Browser' stamp: 'mu 3/6/2004 15:13'!
browse
self systemNavigation browseClass: self class! !
!Object methodsFor: '*Tools-Browser' stamp: 'mu 3/11/2004 16:00'!
browseHierarchy
self systemNavigation browseHierarchy: self class! !
!Object methodsFor: '*Tools-Explorer' stamp: 'sma 11/12/2000 11:43'!
asExplorerString
^ self printString! !
!Object methodsFor: '*Tools-Explorer' stamp: 'yo 8/27/2008 23:16'!
customizeExplorerContents
^ false.
! !
!Object methodsFor: '*Tools-Explorer' stamp: 'IgorStasenko 4/15/2011 17:30'!
explore
^Smalltalk tools explore: self! !
!Object methodsFor: '*Tools-Explorer' stamp: 'md 8/13/2008 21:39'!
hasContentsInExplorer
^self basicSize > 0 or: [self class allInstVarNames notEmpty]
! !
!Object methodsFor: '*Tools-Inspector' stamp: 'IgorStasenko 4/15/2011 17:29'!
basicInspect
"Create and schedule an Inspector in which the user can examine the
receiver's variables. This method should not be overriden."
^Smalltalk tools basicInspect: self! !
!Object methodsFor: '*Tools-Inspector'!
defaultLabelForInspector
"Answer the default label to be used for an Inspector window on the receiver."
^ self class name! !
!Object methodsFor: '*Tools-Inspector' stamp: 'sbw 6/2/2004 08:45'!
doExpiredInspectCount
self clearHaltOnce.
self removeHaltCount.
self inspect! !
!Object methodsFor: '*Tools-Inspector' stamp: 'IgorStasenko 4/15/2011 17:31'!
inspect
"Create and schedule an Inspector in which the user can examine the receiver's variables."
Smalltalk tools inspect: self! !
!Object methodsFor: '*Tools-Inspector' stamp: 'sbw 6/2/2004 08:46'!
inspectOnCount: int
self haltOnceEnabled
ifTrue: [self hasHaltCount
ifTrue: [self decrementAndCheckHaltCount
ifTrue: [self doExpiredInspectCount]]
ifFalse: [int = 1
ifTrue: [self doExpiredInspectCount]
ifFalse: [self setHaltCountTo: int - 1]]]! !
!Object methodsFor: '*Tools-Inspector' stamp: 'igorStasenko 1/30/2010 14:04'!
inspectOnce
"Inspect unless we have already done it once."
self haltOnceEnabled
ifTrue: [self clearHaltOnce.
^ self inspect]! !
!Object methodsFor: '*Tools-Inspector' stamp: 'sbw 6/2/2004 13:20'!
inspectUntilCount: int
self haltOnceEnabled
ifTrue: [self hasHaltCount
ifTrue: [self decrementAndCheckHaltCount
ifTrue: [self doExpiredInspectCount]
ifFalse: [self inspect]]
ifFalse: [int = 1
ifTrue: [self doExpiredInspectCount]
ifFalse: [self setHaltCountTo: int - 1]]]! !
!Object methodsFor: '*Tools-Inspector' stamp: 'IgorStasenko 4/15/2011 17:30'!
inspectWithLabel: aLabel
"Create and schedule an Inspector in which the user can examine the receiver's variables."
^Smalltalk tools inspect: self label: aLabel! !
!Object methodsFor: '*Tools-Inspector' stamp: 'IgorStasenko 4/26/2011 16:58'!
inspectorClass
"Answer the class of the inspector to be used on the receiver. Called by inspect;
use basicInspect to get a normal (less useful) type of inspector."
^ Smalltalk tools inspector! !
!Object methodsFor: '*UIManager' stamp: 'rbb 3/1/2005 09:26'!
confirm: queryString
"Put up a yes/no menu with caption queryString. Answer true if the
response is yes, false if no. This is a modal question--the user must
respond yes or no."
"nil confirm: 'Are you hungry?'"
^ UIManager default confirm: queryString! !
!Object methodsFor: '*UIManager' stamp: 'rbb 3/1/2005 09:28'!
inform: aString
"Display a message for the user to read and then dismiss. 6/9/96 sw"
aString isEmptyOrNil ifFalse: [UIManager default inform: aString]! !
!Object methodsFor: '*UIManager' stamp: 'pavel.krivanek 11/21/2008 16:50'!
primitiveError: aString
"This method is called when the error handling results in a recursion in
calling on error: or halt or halt:."
UIManager default onPrimitiveError: aString.! !
!Object methodsFor: '*deprecated12' stamp: 'HenrikSperreJohansen 10/25/2010 15:37'!
inline: inlineFlag
"For translation only; noop when running in Smalltalk."
self deprecated: 'Tag with the equivalent <inline::> pragma which is understood in recent VMMakers instead'
on: '25 October 2010'
in: 'Pharo1.2'! !
!Object methodsFor: '*deprecated12' stamp: 'HenrikSperreJohansen 10/25/2010 15:37'!
var: varSymbol declareC: declString
"For translation only; noop when running in Smalltalk."
self deprecated: 'Tag with the equivalent <var:declareC:> pragma which is understood in recent VMMakers instead'
on: '25 October 2010'
in: 'Pharo1.2'! !
!Object methodsFor: '*deprecated13' stamp: 'IgorStasenko 4/15/2011 17:29'!
exploreWithLabel: label
^ Smalltalk tools objectExplorer new openExplorerFor: self withLabel:
label! !
!Object methodsFor: '*deprecated13' stamp: 'StephaneDucasse 1/29/2011 11:58'!
notifyWithLabel: aString
"Create and schedule a Notifier with aString as the window label as well as the contents of the window, in order to request confirmation before a process can proceed."
self deprecated: 'Do not use this method, instead use Warning or UIManager API' on: '28 January 2011' in: 'Pharo1.3'.
^ Warning signal: aString! !
!Object methodsFor: '*system-object storage' stamp: 'StephaneDucasse 7/23/2010 12:37'!
convertToCurrentVersion: varDict refStream: smartRefStrm
"subclasses should implement if they wish to convert old instances to modern ones"
"this method should not be removed since SmartRefStream use it"! !
!Object methodsFor: 'accessing'!
at: t1
<primitive: 60>
t1 isInteger
ifTrue: [self class isVariable
ifTrue: [self errorSubscriptBounds: t1]
ifFalse: [self errorNotIndexable]].
t1 isNumber
ifTrue: [^ self at: t1 asInteger].
self errorNonIntegerIndex! !
!Object methodsFor: 'accessing'!
at: index modify: aBlock
"Replace the element of the collection with itself transformed by the block"
^ self at: index put: (aBlock value: (self at: index))! !
!Object methodsFor: 'accessing'!
at: t1 put: t2
<primitive: 61>
t1 isInteger
ifTrue: [self class isVariable
ifTrue: [(t1 >= 1
and: [t1 <= self size])
ifTrue: [self errorImproperStore]
ifFalse: [self errorSubscriptBounds: t1]]
ifFalse: [self errorNotIndexable]].
t1 isNumber
ifTrue: [^ self at: t1 asInteger put: t2].
self errorNonIntegerIndex! !
!Object methodsFor: 'accessing'!
basicAt: index
"Primitive. Assumes receiver is indexable. Answer the value of an
indexable element in the receiver. Fail if the argument index is not an
Integer or is out of bounds. Essential. Do not override in a subclass. See
Object documentation whatIsAPrimitive."
<primitive: 60>
index isInteger ifTrue: [self errorSubscriptBounds: index].
index isNumber
ifTrue: [^self basicAt: index asInteger]
ifFalse: [self errorNonIntegerIndex]! !
!Object methodsFor: 'accessing'!
basicAt: index put: value
"Primitive. Assumes receiver is indexable. Store the second argument
value in the indexable element of the receiver indicated by index. Fail
if the index is not an Integer or is out of bounds. Or fail if the value is
not of the right type for this kind of collection. Answer the value that
was stored. Essential. Do not override in a subclass. See Object
documentation whatIsAPrimitive."
<primitive: 61>
index isInteger
ifTrue: [(index >= 1 and: [index <= self size])
ifTrue: [self errorImproperStore]
ifFalse: [self errorSubscriptBounds: index]].
index isNumber
ifTrue: [^self basicAt: index asInteger put: value]
ifFalse: [self errorNonIntegerIndex]! !
!Object methodsFor: 'accessing'!
basicSize
"Primitive. Answer the number of indexable variables in the receiver.
This value is the same as the largest legal subscript. Essential. Do not
override in any subclass. See Object documentation whatIsAPrimitive."
<primitive: 62>
"The number of indexable fields of fixed-length objects is 0"
^0 ! !
!Object methodsFor: 'accessing' stamp: 'Igor.Stasenko 11/13/2009 07:19'!
enclosedSetElement
"The receiver is included into a set as an element.
Since some objects require wrappers (see SetElement) to be able to be included into a Set,
a set sends this message to its element to make sure it getting real object,
instead of its wrapper.
Only SetElement instance or its subclasses allowed to answer something different than receiver itself"
! !
!Object methodsFor: 'accessing' stamp: 'md 10/7/2004 15:43'!
ifNil: nilBlock ifNotNilDo: aBlock
"Evaluate aBlock with the receiver as its argument."
^ aBlock value: self
! !
!Object methodsFor: 'accessing' stamp: 'di 11/8/2000 21:04'!
ifNotNilDo: aBlock
"Evaluate the given block with the receiver as its argument."
^ aBlock value: self
! !
!Object methodsFor: 'accessing' stamp: 'md 10/7/2004 15:43'!
ifNotNilDo: aBlock ifNil: nilBlock
"Evaluate aBlock with the receiver as its argument."
^ aBlock value: self
! !
!Object methodsFor: 'accessing' stamp: 'ajh 1/21/2003 12:59'!
in: aBlock
"Evaluate the given block with the receiver as its argument."
^ aBlock value: self
! !
!Object methodsFor: 'accessing' stamp: 'damiencassou 5/30/2008 10:56'!
readFromString: aString
"Create an object based on the contents of aString."
^ self readFrom: aString readStream! !
!Object methodsFor: 'accessing' stamp: 'di 3/29/1999 13:10'!
size
"Primitive. Answer the number of indexable variables in the receiver.
This value is the same as the largest legal subscript. Essential. See Object
documentation whatIsAPrimitive."
<primitive: 62>
self class isVariable ifFalse: [self errorNotIndexable].
^ 0! !
!Object methodsFor: 'accessing' stamp: 'md 5/16/2006 12:34'!
yourself
"Answer self."
^self! !
!Object methodsFor: 'associating' stamp: 'md 7/22/2005 16:03'!
-> anObject
"Answer an Association between self and anObject"
^Association basicNew key: self value: anObject! !
!Object methodsFor: 'binding'!
bindingOf: aString
^nil! !
!Object methodsFor: 'breakpoint' stamp: 'bkv 7/1/2003 12:33'!
break
"This is a simple message to use for inserting breakpoints during debugging.
The debugger is opened by sending a signal. This gives a chance to restore
invariants related to multiple processes."
BreakPoint signal.
"nil break."! !
!Object methodsFor: 'casing'!
caseOf: aBlockAssociationCollection
"The elements of aBlockAssociationCollection are associations between blocks.
Answer the evaluated value of the first association in aBlockAssociationCollection
whose evaluated key equals the receiver. If no match is found, report an error."
^ self caseOf: aBlockAssociationCollection otherwise: [self caseError]
"| z | z := {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z"
"| z | z := {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z"
"The following are compiled in-line:"
"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}"
"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}"! !
!Object methodsFor: 'casing'!
caseOf: aBlockAssociationCollection otherwise: aBlock
"The elements of aBlockAssociationCollection are associations between blocks.
Answer the evaluated value of the first association in aBlockAssociationCollection
whose evaluated key equals the receiver. If no match is found, answer the result
of evaluating aBlock."
aBlockAssociationCollection associationsDo:
[:assoc | (assoc key value = self) ifTrue: [^assoc value value]].
^ aBlock value
"| z | z := {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]"
"| z | z := {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]"
"The following are compiled in-line:"
"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]"
"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]"! !
!Object methodsFor: 'class membership'!
class
"Primitive. Answer the object which is the receiver's class. Essential. See
Object documentation whatIsAPrimitive."
<primitive: 111>
self primitiveFailed! !
!Object methodsFor: 'class membership'!
isKindOf: aClass
"Answer whether the class, aClass, is a superclass or class of the receiver."
self class == aClass
ifTrue: [^true]
ifFalse: [^self class inheritsFrom: aClass]! !
!Object methodsFor: 'class membership'!
isMemberOf: aClass
"Answer whether the receiver is an instance of the class, aClass."
^self class == aClass! !
!Object methodsFor: 'class membership'!
respondsTo: aSymbol
"Answer whether the method dictionary of the receiver's class contains
aSymbol as a message selector."
^self class canUnderstand: aSymbol! !
!Object methodsFor: 'class membership' stamp: 'tk 10/21/1998 12:38'!
xxxClass
"For subclasses of nil, such as ObjectOut"
^ self class! !
!Object methodsFor: 'comparing' stamp: 'nice 12/26/2009 18:48'!
closeTo: anObject
"Answer whether the receiver and the argument represent the same
object. If = is redefined in any subclass, consider also redefining the
message hash."
^[self = anObject] ifError: [false]! !
!Object methodsFor: 'comparing'!
hash
^ self identityHash! !
!Object methodsFor: 'comparing' stamp: 'sw 8/20/1998 12:34'!
identityHashPrintString
"'fred' identityHashPrintString"
^ '(', self identityHash printString, ')'! !
!Object methodsFor: 'comparing' stamp: 'ajh 2/2/2002 15:02'!
literalEqual: other
^ self class == other class and: [self = other]! !
!Object methodsFor: 'comparing'!
= t1
^ self == t1! !
!Object methodsFor: 'comparing'!
~= anObject
"Answer whether the receiver and the argument do not represent the
same object."
^self = anObject == false! !
!Object methodsFor: 'converting' stamp: 'nice 3/28/2006 23:29'!
adaptToFloat: rcvr andCompare: selector
"If I am involved in comparison with a Float.
Default behaviour is to process comparison as any other selectors."
^ self adaptToFloat: rcvr andSend: selector! !
!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'!
adaptToFloat: rcvr andSend: selector
"If no method has been provided for adapting an object to a Float,
then it may be adequate to simply adapt it to a number."
^ self adaptToNumber: rcvr andSend: selector! !
!Object methodsFor: 'converting' stamp: 'nice 3/28/2006 23:29'!
adaptToFraction: rcvr andCompare: selector
"If I am involved in comparison with a Fraction.
Default behaviour is to process comparison as any other selectors."
^ self adaptToFraction: rcvr andSend: selector! !
!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:14'!
adaptToFraction: rcvr andSend: selector
"If no method has been provided for adapting an object to a Fraction,
then it may be adequate to simply adapt it to a number."
^ self adaptToNumber: rcvr andSend: selector! !
!Object methodsFor: 'converting' stamp: 'nice 3/28/2006 23:29'!
adaptToInteger: rcvr andCompare: selector
"If I am involved in comparison with an Integer.
Default behaviour is to process comparison as any other selectors."
^ self adaptToInteger: rcvr andSend: selector! !
!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'!
adaptToInteger: rcvr andSend: selector
"If no method has been provided for adapting an object to a Integer,
then it may be adequate to simply adapt it to a number."
^ self adaptToNumber: rcvr andSend: selector! !
!Object methodsFor: 'converting' stamp: 'rw 4/27/2002 07:48'!
asActionSequence
^WeakActionSequence with: self! !
!Object methodsFor: 'converting' stamp: 'rw 7/20/2003 16:03'!
asActionSequenceTrappingErrors
^WeakActionSequenceTrappingErrors with: self! !
!Object methodsFor: 'converting' stamp: 'HenrikSperreJohansen 10/18/2009 15:58'!
asLink
"Answer a string that represents the receiver."
^ ValueLink value: self! !
!Object methodsFor: 'converting' stamp: 'sma 5/12/2000 17:39'!
asOrderedCollection
"Answer an OrderedCollection with the receiver as its only element."
^ OrderedCollection with: self! !
!Object methodsFor: 'converting' stamp: 'Igor.Stasenko 11/13/2009 06:03'!
asSetElement
"Answer an object, which can be put into a Set as element , wrapped
by one of SetElement instance, if necessary.
Default implementation is to answer self"
! !
!Object methodsFor: 'converting'!
asString
^ self printString! !
!Object methodsFor: 'converting' stamp: 'ajh 3/11/2003 10:27'!
asStringOrText
"Answer a string that represents the receiver."
^ self printString ! !
!Object methodsFor: 'converting'!
as: aSimilarClass
"Create an object of class aSimilarClass that has similar contents to the receiver."
^ aSimilarClass newFrom: self! !
!Object methodsFor: 'converting' stamp: 'RAA 8/2/1999 12:41'!
complexContents
^self! !
!Object methodsFor: 'converting' stamp: 'ajh 7/6/2003 20:37'!
mustBeBoolean
"Catches attempts to test truth of non-Booleans. This message is sent from the VM. The sending context is rewound to just before the jump causing this exception."
^ self mustBeBooleanIn: thisContext sender! !
!Object methodsFor: 'converting' stamp: 'ajh 7/6/2003 20:40'!
mustBeBooleanIn: context
"context is the where the non-boolean error occurred. Rewind context to before jump then raise error."
| proceedValue |
context skipBackBeforeJump.
proceedValue := NonBooleanReceiver new
object: self;
signal: 'proceed for truth.'.
^ proceedValue ~~ false! !
!Object methodsFor: 'converting' stamp: 'RAA 3/31/1999 12:13'!
withoutListWrapper
^self! !
!Object methodsFor: 'copying' stamp: 'MarcusDenker 9/27/2010 15:28'!
copy
"Answer another instance just like the receiver. Subclasses typically override postCopy; they typically do not override shallowCopy. Copy is a template method in the sense of Design Patterns. So do not override it. Override postCopy instead. Pay attention that normally you should call postCopy of your superclass too."
^self shallowCopy postCopy! !
!Object methodsFor: 'copying' stamp: 'tpr 2/14/2004 21:53'!
copyFrom: anotherObject
"Copy to myself all instance variables I have in common with anotherObject. This is dangerous because it ignores an object's control over its own inst vars. "
| mine his |
<primitive: 168>
mine := self class allInstVarNames.
his := anotherObject class allInstVarNames.
1 to: (mine size min: his size) do: [:ind |
(mine at: ind) = (his at: ind) ifTrue: [
self instVarAt: ind put: (anotherObject instVarAt: ind)]].
self class isVariable & anotherObject class isVariable ifTrue: [
1 to: (self basicSize min: anotherObject basicSize) do: [:ind |
self basicAt: ind put: (anotherObject basicAt: ind)]].! !
!Object methodsFor: 'copying' stamp: 'eem 6/11/2008 17:52'!
copySameFrom: otherObject
"Copy to myself all instance variables named the same in otherObject.
This ignores otherObject's control over its own inst vars."
| myInstVars otherInstVars |
myInstVars := self class allInstVarNames.
otherInstVars := otherObject class allInstVarNames.
myInstVars doWithIndex: [:each :index | | match |
(match := otherInstVars indexOf: each) > 0 ifTrue:
[self instVarAt: index put: (otherObject instVarAt: match)]].
1 to: (self basicSize min: otherObject basicSize) do: [:i |
self basicAt: i put: (otherObject basicAt: i)].
! !
!Object methodsFor: 'copying' stamp: 'pmm 3/13/2010 11:33'!
copyTwoLevel
"one more level than a shallowCopy"
"do not use this method we will deprecated soon"
| newObject class index |
class := self class.
newObject := self shallowCopy.
newObject == self ifTrue: [^ self].
class isVariable
ifTrue:
[index := self basicSize.
[index > 0]
whileTrue:
[newObject basicAt: index put: (self basicAt: index) shallowCopy.
index := index - 1]].
index := class instSize.
[index > 0]
whileTrue:
[newObject instVarAt: index put: (self instVarAt: index) shallowCopy.
index := index - 1].
^newObject! !
!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:40'!
deepCopy
"Answer a copy of the receiver with its own copy of each instance variable. deepCopy does a deep copy. It should never be overridden and only be used if you want to get these very specific semantics.
It doesn't handle cycles, #veryDeepCopy does. In the future we will make it handle cycles and deprecate veryDeepCopy"
| newObject class index |
class := self class.
(class == Object) ifTrue: [^self].
class isVariable
ifTrue:
[index := self basicSize.
newObject := class basicNew: index.
[index > 0]
whileTrue:
[newObject basicAt: index put: (self basicAt: index) deepCopy.
index := index - 1]]
ifFalse: [newObject := class basicNew].
index := class instSize.
[index > 0]
whileTrue:
[newObject instVarAt: index put: (self instVarAt: index) deepCopy.
index := index - 1].
^newObject! !
!Object methodsFor: 'copying'!
postCopy
^ self! !
!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:42'!
shallowCopy
"Answer a copy of the receiver which shares the receiver's instance variables. It should never be overridden. I'm invoked from the copy template method. Subclasses that need to specialize the copy should specialize the postCopy hook method."
| class newObject index |
<primitive: 148>
class := self class.
class isVariable
ifTrue:
[index := self basicSize.
newObject := class basicNew: index.
[index > 0]
whileTrue:
[newObject basicAt: index put: (self basicAt: index).
index := index - 1]]
ifFalse: [newObject := class basicNew].
index := class instSize.
[index > 0]
whileTrue:
[newObject instVarAt: index put: (self instVarAt: index).
index := index - 1].
^ newObject! !
!Object methodsFor: 'copying' stamp: 'stephane.ducasse 6/1/2009 13:49'!
veryDeepCopy
"Do a complete tree copy using a dictionary. An object in the tree twice is only copied once. All references to the object in the copy of the tree will point to the new copy."
| copier new |
copier := DeepCopier new initialize: 4096 "self initialDeepCopierSize".
new := self veryDeepCopyWith: copier.
copier references associationsDo: [:assoc |
assoc value veryDeepFixupWith: copier].
copier fixDependents.
^ new! !
!Object methodsFor: 'copying' stamp: 'nice 1/5/2010 15:59'!
veryDeepCopyUsing: copier
"Do a complete tree copy using a dictionary. An object in the tree twice is only copied once. All references to the object in the copy of the tree will point to the new copy.
Same as veryDeepCopy except copier (with dictionary) is supplied.
** do not delete this method, even if it has no callers **"
| new refs |
new := self veryDeepCopyWith: copier.
copier references associationsDo: [:assoc |
assoc value veryDeepFixupWith: copier].
"Fix dependents"
refs := copier references.
DependentsFields associationsDo: [:pair |
pair value do: [:dep | | newModel newDep |
(newDep := refs at: dep ifAbsent: [nil]) ifNotNil: [
newModel := refs at: pair key ifAbsent: [pair key].
newModel addDependent: newDep]]].
^ new! !
!Object methodsFor: 'copying' stamp: 'pmm 3/13/2010 11:33'!
veryDeepCopyWith: deepCopier
"Copy me and the entire tree of objects I point to. An object in the tree twice is copied once, and both references point to him. deepCopier holds a dictionary of objects we have seen. Some classes refuse to be copied. Some classes are picky about which fields get deep copied."
| class index sub subAss new sup has mine |
deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him"
class := self class.
class isMeta ifTrue: [^ self]. "a class"
new := self shallowCopy.
deepCopier references at: self put: new. "remember"
(class isVariable and: [class isPointers]) ifTrue:
[index := self basicSize.
[index > 0] whileTrue:
[sub := self basicAt: index.
(subAss := deepCopier references associationAt: sub ifAbsent: [nil])
ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)]
ifNotNil: [new basicAt: index put: subAss value].
index := index - 1]].
"Ask each superclass if it wants to share (weak copy) any inst vars"
new veryDeepInner: deepCopier. "does super a lot"
"other superclasses want all inst vars deep copied"
sup := class. index := class instSize.
[has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil].
has := has ifNil: [ false ] ifNotNil: [ true ].
mine := sup instVarNames.
has ifTrue: [index := index - mine size] "skip inst vars"
ifFalse: [1 to: mine size do: [:xx |
sub := self instVarAt: index.
(subAss := deepCopier references associationAt: sub ifAbsent: [nil])
"use association, not value, so nil is an exceptional value"
ifNil: [new instVarAt: index put:
(sub veryDeepCopyWith: deepCopier)]
ifNotNil: [new instVarAt: index put: subAss value].
index := index - 1]].
(sup := sup superclass) == nil] whileFalse.
new rehash. "force Sets and Dictionaries to rehash"
^ new
! !
!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:43'!
veryDeepFixupWith: deepCopier
"I have no fields and no superclass. Catch the super call."
"avoid to use me we will deprecate it in the future"! !
!Object methodsFor: 'copying' stamp: 'StephaneDucasse 2/20/2010 21:43'!
veryDeepInner: deepCopier
"No special treatment for inst vars of my superclasses. Override when some need to be weakly copied. Object>>veryDeepCopyWith: will veryDeepCopy any inst var whose class does not actually define veryDeepInner:"
"avoid to use me we will deprecate it in the future"! !
!Object methodsFor: 'debugging' stamp: 'HenrikSperreJohansen 6/28/2010 12:14'!
haltIf: condition
"This is the typical message to use for inserting breakpoints during
debugging. Param can be a block or expression, halt if true.
If the Block has one arg, the receiver is bound to that.
If the condition is a selector, we look up in the callchain. Halt if
any method's selector equals selector."
| cntxt |
condition isSymbol ifTrue:[
"only halt if a method with selector symbol is in callchain"
cntxt := thisContext.
[cntxt sender isNil] whileFalse: [
cntxt := cntxt sender.
(cntxt selector = condition) ifTrue: [Halt signal].
].
^self.
].
(condition isBlock
ifTrue: [condition cull: self]
ifFalse: [condition]
) ifTrue: [
Halt signal
].! !
!Object methodsFor: 'debugging'!
needsWork! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'lr 3/14/2010 21:13'!
checkHaltCountExpired
"returns if the halt counter has expired. "
| counter |
counter := Smalltalk globals at: #HaltCount ifAbsent: [ 0 ].
^ counter = 0! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'simon.denier 6/11/2010 14:43'!
clearHaltOnce
"Turn on the halt once flag."
Smalltalk globals at: #HaltOnce put: false! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:30'!
decrementAndCheckHaltCount
self decrementHaltCount.
^self checkHaltCountExpired! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'lr 3/14/2010 21:13'!
decrementHaltCount
| counter |
counter := Smalltalk globals at: #HaltCount ifAbsent: [ 0 ].
counter > 0
ifTrue: [
counter := counter - 1.
self setHaltCountTo: counter ]! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:42'!
doExpiredHaltCount
self clearHaltOnce.
self removeHaltCount.
self halt! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:44'!
doExpiredHaltCount: aString
self clearHaltOnce.
self removeHaltCount.
self halt: aString! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'igorStasenko 1/30/2010 14:03'!
halt: aString onCount: int
self haltOnceEnabled
ifTrue: [self hasHaltCount
ifTrue: [self decrementAndCheckHaltCount
ifTrue: [self doExpiredHaltCount: aString]]
ifFalse: [int = 1
ifTrue: [self doExpiredHaltCount: aString]
ifFalse: [self setHaltCountTo: int - 1]]]! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'igorStasenko 1/30/2010 14:08'!
haltOnCount: int
"do an halt only after a given number"
self haltOnceEnabled
ifTrue: [self hasHaltCount
ifTrue: [self decrementAndCheckHaltCount
ifTrue: [self doExpiredHaltCount]]
ifFalse: [int = 1
ifTrue: [self doExpiredHaltCount]
ifFalse: [self setHaltCountTo: int - 1]]]! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'igorStasenko 1/30/2010 14:01'!
haltOnce
"Halt unless we have already done it once."
"To enable haltOnce, use anObject setHaltOnce.
You can also use selfCountTo: to use halt:onCount: "
self haltOnceEnabled
ifTrue: [self clearHaltOnce.
^ self halt]! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'igorStasenko 1/30/2010 14:04'!
haltOnce: aString
"Halt unless we have already done it once."
self haltOnceEnabled
ifTrue: [ self clearHaltOnce.
^ self halt: aString ]! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'lr 3/14/2010 21:13'!
haltOnceEnabled
"returns whether haltOnce behavior has been enabled"
^ Smalltalk globals at: #HaltOnce ifAbsent: [ false ]! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'lr 3/14/2010 21:13'!
hasHaltCount
^ Smalltalk globals includesKey: #HaltCount! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'simon.denier 6/11/2010 14:44'!
removeHaltCount
(Smalltalk globals includesKey: #HaltCount)
ifTrue: [ Smalltalk globals removeKey: #HaltCount ]! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'simon.denier 6/11/2010 14:44'!
setHaltCountTo: int
Smalltalk globals at: #HaltCount put: int! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'simon.denier 6/11/2010 14:44'!
setHaltOnce
"Turn on the halt once flag."
Smalltalk globals at: #HaltOnce put: true! !
!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'!
toggleHaltOnce
self haltOnceEnabled
ifTrue: [self clearHaltOnce]
ifFalse: [self setHaltOnce]! !
!Object methodsFor: 'dependents access' stamp: 'ar 2/11/2001 01:55'!
addDependent: anObject
"Make the given object one of the receiver's dependents."
| dependents |
dependents := self dependents.
(dependents includes: anObject) ifFalse:
[self myDependents: (dependents copyWithDependent: anObject)].
^ anObject! !
!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:53'!
breakDependents
"Remove all of the receiver's dependents."
self myDependents: nil! !
!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:26'!
canDiscardEdits
"Answer true if none of the views on this model has unaccepted edits that matter."
self dependents
do: [:each | each canDiscardEdits ifFalse: [^ false]]
without: self.
^ true! !
!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:58'!
dependents
"Answer a collection of objects that are 'dependent' on the receiver;
that is, all objects that should be notified if the receiver changes."
^ self myDependents ifNil: [#()]! !
!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:59'!
hasUnacceptedEdits
"Answer true if any of the views on this object has unaccepted edits."
self dependents
do: [:each | each hasUnacceptedEdits ifTrue: [^ true]]
without: self.
^ false! !
!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:55'!
myDependents
"Private. Answer a list of all the receiver's dependents."
^ DependentsFields at: self ifAbsent: []! !
!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:52'!
myDependents: aCollectionOrNil
"Private. Set (or remove) the receiver's dependents list."
aCollectionOrNil
ifNil: [DependentsFields removeKey: self ifAbsent: []]
ifNotNil: [DependentsFields at: self put: aCollectionOrNil]! !
!Object methodsFor: 'dependents access'!
release
"Remove references to objects that may refer to the receiver. This message
should be overridden by subclasses with any cycles, in which case the
subclass should also include the expression super release."
self releaseActionMap! !
!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 20:23'!
removeDependent: anObject
"Remove the given object as one of the receiver's dependents."
| dependents |
dependents := self dependents reject: [:each | each == anObject].
self myDependents: (dependents isEmpty ifFalse: [dependents]).
^ anObject! !
!Object methodsFor: 'drag and drop'!
acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph
^false.! !
!Object methodsFor: 'drag and drop'!
dragPassengerFor: item inMorph: dragSource
^item! !
!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:11'!
dragTransferType
^nil! !
!Object methodsFor: 'drag and drop'!
dragTransferTypeForMorph: dragSource
^nil! !
!Object methodsFor: 'drag and drop'!
wantsDroppedMorph: aMorph event: anEvent inMorph: destinationLM
^false ! !
!Object methodsFor: 'error handling' stamp: 'jannik.laval 5/2/2010 16:34'!
assert: aBlock
"Throw an assertion error if aBlock does not evaluates to true."
aBlock value ifFalse: [AssertionFailure signal: 'Assertion failed']! !
!Object methodsFor: 'error handling' stamp: 'jannik.laval 5/2/2010 16:59'!
assert: aBlock descriptionBlock: descriptionBlock
"Throw an assertion error if aBlock does not evaluate to true."
aBlock value ifFalse: [AssertionFailure signal: descriptionBlock value asString ]! !
!Object methodsFor: 'error handling' stamp: 'jannik.laval 5/2/2010 16:58'!
assert: aBlock description: aString
"Throw an assertion error if aBlock does not evaluates to true."
aBlock value ifFalse: [AssertionFailure signal: aString ]! !
!Object methodsFor: 'error handling' stamp: 'jcg 8/10/2008 21:58'!
caseError
"Report an error from an in-line or explicit case statement."
self error: 'Case not found (', self printString, '), and no otherwise clause'! !
!Object methodsFor: 'error handling' stamp: 'rbb 3/1/2005 09:27'!
confirm: aString orCancel: cancelBlock
"Put up a yes/no/cancel menu with caption aString. Answer true if
the response is yes, false if no. If cancel is chosen, evaluate
cancelBlock. This is a modal question--the user must respond yes or no."
^ UIManager default confirm: aString orCancel: cancelBlock! !
!Object methodsFor: 'error handling' stamp: 'eem 7/3/2009 19:17'!
deprecated: anExplanationString
"Warn that the sending method has been deprecated."
(Deprecation
method: thisContext sender method
explanation: anExplanationString
on: nil
in: nil) signal! !
!Object methodsFor: 'error handling' stamp: 'AndrewBlack 9/6/2009 08:58'!
deprecated: anExplanationString on: date in: version
"Warn that the sending method has been deprecated"
(Deprecation
method: thisContext sender method
explanation: anExplanationString
on: date
in: version) signal! !
!Object methodsFor: 'error handling' stamp: 'stephane.ducasse 12/22/2008 13:53'!
doesNotUnderstand: aMessage
"Handle the fact that there was an attempt to send the given message to the receiver but the receiver does not understand this message (typically sent from the machine when a message is sent to the receiver and no method is defined for that selector)."
"Testing: (3 activeProcess)"
"fixed suggested by Eliot miranda to make sure
[Object new blah + 1]
  on: MessageNotUnderstood
  do: [:e | e resume: 1] does not loop indefinitively"
| exception resumeValue |
(exception := MessageNotUnderstood new)
message: aMessage;
receiver: self.
resumeValue := exception signal.
^exception reachedDefaultHandler
ifTrue: [aMessage sentTo: self]
ifFalse: [resumeValue]! !
!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 16:47'!
dpsTrace: reportObject
Transcript myDependents isNil ifTrue: [^self].
self dpsTrace: reportObject levels: 1 withContext: thisContext
" nil dpsTrace: 'sludder'. "! !
!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 16:49'!
dpsTrace: reportObject levels: anInt
self dpsTrace: reportObject levels: anInt withContext: thisContext
"(1 to: 3) do: [:int | nil dpsTrace: int levels: 5.]"! !
!Object methodsFor: 'error handling' stamp: 'lr 3/14/2010 21:13'!
dpsTrace: reportObject levels: anInt withContext: currentContext
| reportString context displayCount |
reportString := (reportObject respondsTo: #asString)
ifTrue: [ reportObject asString ]
ifFalse: [ reportObject printString ].
(Smalltalk globals at: #Decompiler ifAbsent: [ nil ])
ifNil: [
Transcript
cr;
show: reportString ]
ifNotNil: [
context := currentContext.
displayCount := anInt > 1.
1 to: anInt do: [ :count |
Transcript cr.
displayCount
ifTrue: [ Transcript show: count printString , ': ' ].
reportString notNil
ifTrue: [
Transcript show: context home class name , '/' , context sender selector , ' (' , reportString , ')'.
context := context sender.
reportString := nil ]
ifFalse: [
(context notNil and: [ (context := context sender) notNil ])
ifTrue: [ Transcript show: context receiver class name , '/' , context selector ] ] ] "Transcript cr" ]! !
!Object methodsFor: 'error handling' stamp: 'md 8/2/2005 22:17'!
error
"Throw a generic Error exception."
^self error: 'Error!!'.! !
!Object methodsFor: 'error handling' stamp: 'tfei 4/12/1999 12:55'!
error: aString
"Throw a generic Error exception."
^Error new signal: aString! !
!Object methodsFor: 'error handling' stamp: 'al 9/16/2005 14:12'!
explicitRequirement
self error: 'Explicitly required method'! !
!Object methodsFor: 'error handling' stamp: 'al 2/13/2006 22:20'!
halt
"This is the typical message to use for inserting breakpoints during
debugging. It behaves like halt:, but does not call on halt: in order to
avoid putting this message on the stack. Halt is especially useful when
the breakpoint message is an arbitrary one."
Halt signal! !
!Object methodsFor: 'error handling' stamp: 'tfei 4/12/1999 12:59'!
halt: aString
"This is the typical message to use for inserting breakpoints during
debugging. It creates and schedules a Notifier with the argument,
aString, as the label."
Halt new signal: aString! !
!Object methodsFor: 'error handling' stamp: 'AdrianLienhard 6/5/2010 16:51'!
haltIfShiftPressed
self haltIf: [Sensor shiftPressed]! !
!Object methodsFor: 'error handling' stamp: 'md 1/20/2006 16:24'!
handles: exception
"This method exists in case a non exception class is the first arg in an on:do: (for instance using a exception class that is not loaded). We prefer this to raising an error during error handling itself. Also, semantically it makes sense that the exception handler is not active if its exception class is not loaded"
^ false! !
!Object methodsFor: 'error handling' stamp: 'stephane.ducasse 6/1/2009 13:51'!
notify: aString
"Create and schedule a Notifier with the argument as the message in
order to request confirmation before a process can proceed."
Warning signal: aString! !
!Object methodsFor: 'error handling'!
notify: aString at: location
"Create and schedule a Notifier with the argument as the message in
order to request confirmation before a process can proceed. Subclasses can
override this and insert an error message at location within aString."
self notify: aString
"nil notify: 'confirmation message' at: 12"! !
!Object methodsFor: 'error handling' stamp: 'StephaneDucasse 12/5/2009 21:06'!
primitiveFail
"primitiveFail may be invoked by certain methods whose code is translated in C. In such a case primitiveFail and not primitiveFailed
should be invoked. The reason is that this code is translated to C by VMMaker. #primitiveFail is
implemented in Interpreter of VMMaker."
^ self primitiveFailed! !
!Object methodsFor: 'error handling' stamp: 'StephaneDucasse 3/27/2010 23:07'!
primitiveFailed
"Announce that a primitive has failed and there is no appropriate Smalltalk code to run."
self primitiveFailed: thisContext sender selector! !
!Object methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:26'!
primitiveFailed: selector
"Announce that a primitive has failed and there is no appropriate Smalltalk code to run."
PrimitiveFailed signalFor: selector! !
!Object methodsFor: 'error handling' stamp: 'al 9/16/2005 14:12'!
requirement
self error: 'Implicitly required method'! !
!Object methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:26'!
shouldBeImplemented
"Announce that this message should be implemented"
ShouldBeImplemented signalFor: thisContext sender selector! !
!Object methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:25'!
shouldNotImplement
"Announce that, although the receiver inherits this message,
it should not implement it."
ShouldNotImplement signalFor: thisContext sender selector! !
!Object methodsFor: 'error handling' stamp: 'SvenVanCaekenberghe 4/20/2011 13:25'!
subclassResponsibility
"This message sets up a framework for the behavior of the class' subclasses.
Announce that the subclass should have implemented this message."
SubclassResponsibility signalFor: thisContext sender selector! !
!Object methodsFor: 'error handling' stamp: 'al 12/16/2003 16:16'!
traitConflict
self error: 'A class or trait does not properly resolve a conflict between multiple traits it uses.'! !
!Object methodsFor: 'evaluating'!
value
^ self! !
!Object methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 15:23'!
valueWithArguments: aSequenceOfArguments
^self! !
!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'!
actionForEvent: anEventSelector
"Answer the action to be evaluated when <anEventSelector> has been triggered."
| actions |
actions := self actionMap
at: anEventSelector asSymbol
ifAbsent: [nil].
actions ifNil: [^nil].
^ actions asMinimalRepresentation! !
!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'!
actionForEvent: anEventSelector
ifAbsent: anExceptionBlock
"Answer the action to be evaluated when <anEventSelector> has been triggered."
| actions |
actions := self actionMap
at: anEventSelector asSymbol
ifAbsent: [nil].
actions ifNil: [^anExceptionBlock value].
^ actions asMinimalRepresentation! !
!Object methodsFor: 'events-accessing' stamp: 'reThink 2/18/2001 14:43'!
actionMap
^EventManager actionMapFor: self! !
!Object methodsFor: 'events-accessing' stamp: 'rw 4/27/2002 08:35'!
actionSequenceForEvent: anEventSelector
^(self actionMap
at: anEventSelector asSymbol
ifAbsent: [^WeakActionSequence new])
asActionSequence! !
!Object methodsFor: 'events-accessing' stamp: 'SqR 6/28/2001 13:19'!
actionsDo: aBlock
self actionMap do: aBlock! !
!Object methodsFor: 'events-accessing' stamp: 'rw 2/10/2002 13:05'!
createActionMap
^IdentityDictionary new! !
!Object methodsFor: 'events-accessing' stamp: 'SqR 2/19/2001 14:04'!
hasActionForEvent: anEventSelector
"Answer true if there is an action associated with anEventSelector"
^(self actionForEvent: anEventSelector) notNil! !
!Object methodsFor: 'events-accessing' stamp: 'gk 8/14/2007 23:53'!
hasActionsWithReceiver: anObject
^self actionMap keys anySatisfy:
[:eachEventSelector |
(self actionSequenceForEvent: eachEventSelector)
anySatisfy: [:anAction | anAction receiver == anObject]]! !
!Object methodsFor: 'events-accessing' stamp: 'reThink 2/18/2001 15:29'!
setActionSequence: actionSequence
forEvent: anEventSelector
| action |
action := actionSequence asMinimalRepresentation.
action == nil
ifTrue:
[self removeActionsForEvent: anEventSelector]
ifFalse:
[self updateableActionMap
at: anEventSelector asSymbol
put: action]! !
!Object methodsFor: 'events-accessing' stamp: 'reThink 2/25/2001 08:50'!
updateableActionMap
^EventManager updateableActionMapFor: self! !
!Object methodsFor: 'events-registering' stamp: 'reThink 2/18/2001 15:04'!
when: anEventSelector evaluate: anAction
| actions |
actions := self actionSequenceForEvent: anEventSelector.
(actions includes: anAction)
ifTrue: [^ self].
self
setActionSequence: (actions copyWith: anAction)
forEvent: anEventSelector! !
!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
when: anEventSelector
send: aMessageSelector
to: anObject
self
when: anEventSelector
evaluate: (WeakMessageSend
receiver: anObject
selector: aMessageSelector)! !
!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
when: anEventSelector
send: aMessageSelector
to: anObject
withArguments: anArgArray
self
when: anEventSelector
evaluate: (WeakMessageSend
receiver: anObject
selector: aMessageSelector
arguments: anArgArray)! !
!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'!
when: anEventSelector
send: aMessageSelector
to: anObject
with: anArg
self
when: anEventSelector
evaluate: (WeakMessageSend
receiver: anObject
selector: aMessageSelector
arguments: (Array with: anArg))! !
!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'!
releaseActionMap
EventManager releaseActionMapFor: self! !
!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'!
removeActionsForEvent: anEventSelector
| map |
map := self actionMap.
map removeKey: anEventSelector asSymbol ifAbsent: [].
map isEmpty
ifTrue: [self releaseActionMap]! !
!Object methodsFor: 'events-removing' stamp: 'nk 8/25/2003 21:46'!
removeActionsSatisfying: aBlock
self actionMap keys do:
[:eachEventSelector |
self
removeActionsSatisfying: aBlock
forEvent: eachEventSelector
]! !
!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'!
removeActionsSatisfying: aOneArgBlock
forEvent: anEventSelector
self
setActionSequence:
((self actionSequenceForEvent: anEventSelector)
reject: [:anAction | aOneArgBlock value: anAction])
forEvent: anEventSelector! !
!Object methodsFor: 'events-removing' stamp: 'rw 7/29/2003 17:18'!
removeActionsWithReceiver: anObject
self actionMap copy keysDo:
[:eachEventSelector |
self
removeActionsSatisfying: [:anAction | anAction receiver == anObject]
forEvent: eachEventSelector
]! !
!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:36'!
removeActionsWithReceiver: anObject
forEvent: anEventSelector
self
removeActionsSatisfying:
[:anAction |
anAction receiver == anObject]
forEvent: anEventSelector! !
!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'!
removeAction: anAction
forEvent: anEventSelector
self
removeActionsSatisfying: [:action | action = anAction]
forEvent: anEventSelector! !
!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:22'!
triggerEvent: anEventSelector
"Evaluate all actions registered for <anEventSelector>. Return the value of the last registered action."
^(self actionForEvent: anEventSelector) value! !
!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 17:09'!
triggerEvent: anEventSelector
ifNotHandled: anExceptionBlock
"Evaluate all actions registered for <anEventSelector>. Return the value of the last registered action."
^(self
actionForEvent: anEventSelector
ifAbsent: [^anExceptionBlock value]) value
! !
!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:21'!
triggerEvent: anEventSelector
withArguments: anArgumentList
^(self actionForEvent: anEventSelector)
valueWithArguments: anArgumentList! !
!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:21'!
triggerEvent: anEventSelector
withArguments: anArgumentList
ifNotHandled: anExceptionBlock
^(self
actionForEvent: anEventSelector
ifAbsent: [^anExceptionBlock value])
valueWithArguments: anArgumentList! !
!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 14:59'!
triggerEvent: anEventSelector
with: anObject
^self
triggerEvent: anEventSelector
withArguments: (Array with: anObject)! !
!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 14:59'!
triggerEvent: anEventSelector
with: anObject
ifNotHandled: anExceptionBlock
^self
triggerEvent: anEventSelector
withArguments: (Array with: anObject)
ifNotHandled: anExceptionBlock! !
!Object methodsFor: 'filter streaming'!
drawOnCanvas:aStream
self flattenOnStream:aStream.
! !
!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 01:31'!
elementSeparator
^nil.! !
!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:07'!
flattenOnStream:aStream
self writeOnFilterStream:aStream.
! !
!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:49'!
putOn:aStream
^aStream nextPut:self.
! !
!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:06'!
writeOnFilterStream:aStream
aStream writeObject:self.
! !
!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 16:26'!
actAsExecutor
"Prepare the receiver to act as executor for any resources associated with it"
self breakDependents! !
!Object methodsFor: 'finalization' stamp: 'ar 3/20/98 22:19'!
executor
"Return an object which can act as executor for finalization of the receiver"
^self shallowCopy actAsExecutor! !
!Object methodsFor: 'finalization' stamp: 'ar 5/19/2003 20:10'!
finalizationRegistry
"Answer the finalization registry associated with the receiver."
^WeakRegistry default! !
!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 16:27'!
finalize
"Finalize the resource associated with the receiver. This message should only be sent during the finalization process. There is NO garantuee that the resource associated with the receiver hasn't been free'd before so take care that you don't run into trouble - this all may happen with interrupt priority."! !
!Object methodsFor: 'finalization' stamp: 'Igor.Stasenko 5/25/2010 04:59'!
hasMultipleExecutors
"All objects, except ObjectFinalizerCollection instances should answer false to this message"
^ false! !
!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 18:38'!
retryWithGC: execBlock until: testBlock
"Retry execBlock as long as testBlock returns false. Do an incremental GC after the first try, a full GC after the second try."
| blockValue |
blockValue := execBlock value.
(testBlock value: blockValue) ifTrue:[^blockValue].
Smalltalk garbageCollectMost.
blockValue := execBlock value.
(testBlock value: blockValue) ifTrue:[^blockValue].
Smalltalk garbageCollect.
^execBlock value.! !
!Object methodsFor: 'finalization' stamp: 'StephaneDucasse 3/21/2010 15:13'!
toFinalizeSend: aSelector to: aFinalizer with: aResourceHandle
"When I am finalized (e.g., garbage collected) close the associated resource handle by sending aSelector to the appropriate finalizer (the guy who knows how to get rid of the resource).
WARNING: Neither the finalizer nor the resource handle are allowed to reference me. If they do, then I will NEVER be garbage collected. Since this cannot be validated here, it is up to the client to make sure this invariant is not broken."
self == aFinalizer ifTrue:[self error: 'I cannot finalize myself'].
self == aResourceHandle ifTrue:[self error: 'I cannot finalize myself'].
^self finalizationRegistry add: self executor:
(ObjectFinalizer new
receiver: aFinalizer
selector: aSelector
argument: aResourceHandle)! !
!Object methodsFor: 'flagging' stamp: 'sw 8/4/97 16:49'!
isThisEverCalled
^ self isThisEverCalled: thisContext sender printString! !
!Object methodsFor: 'flagging'!
isThisEverCalled: msg
"Send this message, with some useful printable argument, from methods or branches of methods which you believe are never reached. 2/5/96 sw"
self halt: 'This is indeed called: ', msg printString! !
!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:23'!
logEntry
Transcript show: 'Entered ', thisContext sender printString; cr.
! !
!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:23'!
logExecution
Transcript show: 'Executing ', thisContext sender printString; cr.
! !
!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:22'!
logExit
Transcript show: 'Exited ', thisContext sender printString; cr.
! !
!Object methodsFor: 'logging' stamp: 'StephaneDucasse 5/27/2011 19:09'!
crLog: aString
"Log the argument. Use self log: instead of Transcript cr; show: "
Transcript cr; show: aString.! !
!Object methodsFor: 'logging' stamp: 'StephaneDucasse 5/23/2011 22:09'!
log: aString
"Log the argument. Use self log: instead of Transcript show: "
Transcript show: aString.! !
!Object methodsFor: 'logging' stamp: 'StephaneDucasse 5/23/2011 22:09'!
logCr: aString
"Log the argument. Use self logCr: 'something' instead of Transcript show: 'something' ; cr "
Transcript show: aString ; cr! !
!Object methodsFor: 'logging' stamp: 'StephaneDucasse 5/27/2011 19:07'!
logCrTab: aString
"Log the argument. Use self logCr: 'something' instead of Transcript show: 'something' ; cr ; tab"
Transcript show: aString ; cr ; tab! !
!Object methodsFor: 'macpal' stamp: 'sw 1/28/1999 17:31'!
contentsChanged
self changed: #contents! !
!Object methodsFor: 'macpal' stamp: 'jm 5/6/1998 22:35'!
flash
"Do nothing."
! !
!Object methodsFor: 'macpal' stamp: 'sw 5/22/2001 18:31'!
refusesToAcceptCode
"Answer whether the receiver is a code-bearing instrument which at the moment refuses to allow its contents to be submitted"
^ false
! !
!Object methodsFor: 'memory usage' stamp: 'MarianoMartinezPeck 10/1/2010 11:10'!
sizeInMemory
"Answer the number of bytes consumed by this instance including object header."
| isCompact headerBytes contentBytes |
contentBytes := self class instSize * Smalltalk wordSize. "inst vars"
self class isVariable ifTrue:[ |bytesPerElement|
bytesPerElement := self class isBytes ifTrue: [1] ifFalse: [4].
contentBytes := contentBytes + (self basicSize * bytesPerElement)].
isCompact := self class indexIfCompact > 0.
headerBytes :=
contentBytes > 255
ifTrue: [ 3 * Smalltalk wordSize ]
ifFalse: [isCompact ifTrue: [Smalltalk wordSize] ifFalse: [2 * Smalltalk wordSize]].
^ headerBytes + contentBytes
! !
!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:52'!
perform: aSymbol
"Send the unary selector, aSymbol, to the receiver.
Fail if the number of arguments expected by the selector is not zero.
Primitive. Optional. See Object documentation whatIsAPrimitive."
<primitive: 83>
^ self perform: aSymbol withArguments: (Array new: 0)! !
!Object methodsFor: 'message handling' stamp: 'st 11/5/2004 16:19'!
perform: selector orSendTo: otherTarget
"If I wish to intercept and handle selector myself, do it; else send it to otherTarget"
^ (self respondsTo: selector) ifTrue: [self perform: selector] ifFalse: [otherTarget perform: selector]! !
!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:55'!
perform: selector withArguments: argArray
"Send the selector, aSymbol, to the receiver with arguments in argArray.
Fail if the number of arguments expected by the selector
does not match the size of argArray.
Primitive. Optional. See Object documentation whatIsAPrimitive."
<primitive: 84>
^ self perform: selector withArguments: argArray inSuperclass: self class! !
!Object methodsFor: 'message handling' stamp: 'ar 4/25/2005 13:35'!
perform: selector withArguments: argArray inSuperclass: lookupClass
"NOTE: This is just like perform:withArguments:, except that
the message lookup process begins, not with the receivers's class,
but with the supplied superclass instead. It will fail if lookupClass
cannot be found among the receiver's superclasses.
Primitive. Essential. See Object documentation whatIsAPrimitive."
<primitive: 100>
(selector isSymbol)
ifFalse: [^ self error: 'selector argument must be a Symbol'].
(selector numArgs = argArray size)
ifFalse: [^ self error: 'incorrect number of arguments'].
(self class == lookupClass or: [self class inheritsFrom: lookupClass])
ifFalse: [^ self error: 'lookupClass is not in my inheritance chain'].
self primitiveFailed! !
!Object methodsFor: 'message handling' stamp: 'nk 4/11/2002 14:13'!
perform: selector withEnoughArguments: anArray
"Send the selector, aSymbol, to the receiver with arguments in argArray.
Only use enough arguments for the arity of the selector; supply nils for missing ones."
| numArgs args |
numArgs := selector numArgs.
anArray size == numArgs
ifTrue: [ ^self perform: selector withArguments: anArray asArray ].
args := Array new: numArgs.
args replaceFrom: 1
to: (anArray size min: args size)
with: anArray
startingAt: 1.
^ self perform: selector withArguments: args! !
!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:52'!
perform: aSymbol with: anObject
"Send the selector, aSymbol, to the receiver with anObject as its argument.
Fail if the number of arguments expected by the selector is not one.
Primitive. Optional. See Object documentation whatIsAPrimitive."
<primitive: 83>
^ self perform: aSymbol withArguments: (Array with: anObject)! !
!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:52'!
perform: aSymbol with: firstObject with: secondObject
"Send the selector, aSymbol, to the receiver with the given arguments.
Fail if the number of arguments expected by the selector is not two.
Primitive. Optional. See Object documentation whatIsAPrimitive."
<primitive: 83>
^ self perform: aSymbol withArguments: (Array with: firstObject with: secondObject)! !
!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:51'!
perform: aSymbol with: firstObject with: secondObject with: thirdObject
"Send the selector, aSymbol, to the receiver with the given arguments.
Fail if the number of arguments expected by the selector is not three.
Primitive. Optional. See Object documentation whatIsAPrimitive."
<primitive: 83>
^ self perform: aSymbol
withArguments: (Array with: firstObject with: secondObject with: thirdObject)! !
!Object methodsFor: 'printing' stamp: 'di 6/20/97 08:57'!
fullPrintString
"Answer a String whose characters are a description of the receiver."
^ String streamContents: [:s | self printOn: s]! !
!Object methodsFor: 'printing'!
isLiteral
"Answer whether the receiver has a literal text form recognized by the
compiler."
^false! !
!Object methodsFor: 'printing' stamp: 'sma 6/1/2000 09:28'!
longPrintOn: aStream
"Append to the argument, aStream, the names and values of all
of the receiver's instance variables."
self class allInstVarNames doWithIndex:
[:title :index |
aStream nextPutAll: title;
nextPut: $:;
space;
tab;
print: (self instVarAt: index);
cr]! !
!Object methodsFor: 'printing' stamp: 'tk 10/19/2001 11:18'!
longPrintOn: aStream limitedTo: sizeLimit indent: indent
"Append to the argument, aStream, the names and values of all of the receiver's instance variables. Limit is the length limit for each inst var."
self class allInstVarNames doWithIndex:
[:title :index |
indent timesRepeat: [aStream tab].
aStream nextPutAll: title;
nextPut: $:;
space;
tab;
nextPutAll:
((self instVarAt: index) printStringLimitedTo: (sizeLimit -3 -title size max: 1));
cr]! !
!Object methodsFor: 'printing' stamp: 'tk 10/16/2001 19:41'!
longPrintString
"Answer a String whose characters are a description of the receiver."
| str |
str := String streamContents: [:aStream | self longPrintOn: aStream].
"Objects without inst vars should return something"
^ str isEmpty ifTrue: [self printString, String cr] ifFalse: [str]! !
!Object methodsFor: 'printing' stamp: 'BG 11/7/2004 13:39'!
longPrintStringLimitedTo: aLimitValue
"Answer a String whose characters are a description of the receiver."
| str |
str := String streamContents: [:aStream | self longPrintOn: aStream limitedTo: aLimitValue indent: 0].
"Objects without inst vars should return something"
^ str isEmpty ifTrue: [self printString, String cr] ifFalse: [str]! !
!Object methodsFor: 'printing' stamp: 'sw 3/7/2001 13:14'!
nominallyUnsent: aSelectorSymbol
"From within the body of a method which is not formally sent within the system, but which you intend to have remain in the system (for potential manual invocation, or for documentation, or perhaps because it's sent by commented-out-code that you anticipate uncommenting out someday, send this message, with the selector itself as the argument.
This will serve two purposes:
(1) The method will not be returned by searches for unsent selectors (because it, in a manner of speaking, sends itself).
(2) You can locate all such methods by browsing senders of #nominallyUnsent:"
false ifTrue: [self flag: #nominallyUnsent:] "So that this method itself will appear to be sent"
! !
!Object methodsFor: 'printing'!
printOn: t1
| t2 |
t2 := self class name.
t1
nextPutAll: (t2 first isVowel
ifTrue: ['an ']
ifFalse: ['a ']);
nextPutAll: t2! !
!Object methodsFor: 'printing' stamp: 'sma 6/1/2000 09:22'!
printString
"Answer a String whose characters are a description of the receiver.
If you want to print without a character limit, use fullPrintString."
^ self printStringLimitedTo: 50000! !
!Object methodsFor: 'printing' stamp: 'tk 5/7/1999 16:20'!
printStringLimitedTo: limit
"Answer a String whose characters are a description of the receiver.
If you want to print without a character limit, use fullPrintString."
| limitedString |
limitedString := String streamContents: [:s | self printOn: s] limitedTo: limit.
limitedString size < limit ifTrue: [^ limitedString].
^ limitedString , '...etc...'! !
!Object methodsFor: 'printing' stamp: 'eem 6/2/2008 11:47'!
printWithClosureAnalysisOn: aStream
"Append to the argument, aStream, a sequence of characters that
identifies the receiver."
| title |
title := self class name.
aStream
nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']);
nextPutAll: title! !
!Object methodsFor: 'printing'!
storeOn: aStream
"Append to the argument aStream a sequence of characters that is an
expression whose evaluation creates an object similar to the receiver."
aStream nextPut: $(.
self class isVariable
ifTrue: [aStream nextPutAll: '(', self class name, ' basicNew: ';
store: self basicSize;
nextPutAll: ') ']
ifFalse: [aStream nextPutAll: self class name, ' basicNew'].
1 to: self class instSize do:
[:i |
aStream nextPutAll: ' instVarAt: ';
store: i;
nextPutAll: ' put: ';
store: (self instVarAt: i);
nextPut: $;].
1 to: self basicSize do:
[:i |
aStream nextPutAll: ' basicAt: ';
store: i;
nextPutAll: ' put: ';
store: (self basicAt: i);
nextPut: $;].
aStream nextPutAll: ' yourself)'
! !
!Object methodsFor: 'printing' stamp: 'di 6/20/97 09:12'!
storeString
"Answer a String representation of the receiver from which the receiver
can be reconstructed."
^ String streamContents: [:s | self storeOn: s]! !
!Object methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:47'!
isSelfEvaluating
^ self isLiteral! !
!Object methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 19:58'!
appendTo: aCollection
"double dispatch for join:"
^ aCollection addLast: self! !
!Object methodsFor: 'splitjoin' stamp: 'onierstrasz 4/10/2009 22:50'!
join: aSequenceableCollection
^ (Array with: self) join: aSequenceableCollection! !
!Object methodsFor: 'splitjoin' stamp: 'onierstrasz 4/12/2009 19:58'!
joinTo: stream
"double dispatch for join:"
^ stream nextPut: self! !
!Object methodsFor: 'splitjoin' stamp: 'onierstrasz 4/10/2009 22:49'!
split: aSequenceableCollection
^ (Array with: self) split: aSequenceableCollection! !
!Object methodsFor: 'system primitives' stamp: 'di 1/9/1999 15:19'!
becomeForward: otherObject
"Primitive. All variables in the entire system that used to point
to the receiver now point to the argument.
Fails if either argument is a SmallInteger."
(Array with: self)
elementsForwardIdentityTo:
(Array with: otherObject)! !
!Object methodsFor: 'system primitives' stamp: 'zz 3/3/2004 23:53'!
becomeForward: otherObject copyHash: copyHash
"Primitive. All variables in the entire system that used to point to the receiver now point to the argument.
If copyHash is true, the argument's identity hash bits will be set to those of the receiver.
Fails if either argument is a SmallInteger."
(Array with: self)
elementsForwardIdentityTo:
(Array with: otherObject)
copyHash: copyHash! !
!Object methodsFor: 'system primitives' stamp: 'sw 10/16/2000 10:59'!
className
"Answer a string characterizing the receiver's class, for use in list views for example"
^ self class name asString! !
!Object methodsFor: 'system primitives'!
instVarAt: index
"Primitive. Answer a fixed variable in an object. The numbering of the
variables corresponds to the named instance variables. Fail if the index
is not an Integer or is not the index of a fixed variable. Essential. See
Object documentation whatIsAPrimitive."
<primitive: 73>
"Access beyond fixed variables."
^self basicAt: index - self class instSize ! !
!Object methodsFor: 'system primitives'!
instVarAt: anInteger put: anObject
"Primitive. Store a value into a fixed variable in the receiver. The
numbering of the variables corresponds to the named instance variables.
Fail if the index is not an Integer or is not the index of a fixed variable.
Answer the value stored as the result. Using this message violates the
principle that each object has sovereign control over the storing of
values into its instance variables. Essential. See Object documentation
whatIsAPrimitive."
<primitive: 74>
"Access beyond fixed fields"
^self basicAt: anInteger - self class instSize put: anObject! !
!Object methodsFor: 'system primitives' stamp: 'eem 5/14/2008 13:20'!
instVarNamed: aString
"Return the value of the instance variable in me with that name. Slow and unclean, but very useful. "
^ self instVarAt: (self class
instVarIndexFor: aString asString
ifAbsent: [self error: 'no such inst var'])
! !
!Object methodsFor: 'system primitives' stamp: 'eem 5/14/2008 13:20'!
instVarNamed: aString put: aValue
"Store into the value of the instance variable in me of that name. Slow and unclean, but very useful. "
^self
instVarAt: (self class
instVarIndexFor: aString asString
ifAbsent: [self error: 'no such inst var'])
put: aValue
! !
!Object methodsFor: 'system primitives' stamp: 'ar 3/2/2001 01:34'!
primitiveChangeClassTo: anObject
"Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have.
Note: The primitive will fail in most cases that you think might work. This is mostly because of a) the difference between compact and non-compact classes, and b) because of differences in the format. As an example, '(Array new: 3) primitiveChangeClassTo: Morph basicNew' would fail for three of the reasons mentioned above. Array is compact, Morph is not (failure #1). Array is variable and Morph is fixed (different format - failure #2). Morph is a fixed-field-only object and the array is too short (failure #3).
The facility is really provided for certain, very specific applications (mostly related to classes changing shape) and not for casual use."
<primitive: 115>
self primitiveFailed! !
!Object methodsFor: 'system primitives'!
someObject
"Primitive. Answer the first object in the enumeration of all
objects."
<primitive: 138>
self primitiveFailed.! !
!Object methodsFor: 'testing' stamp: 'sw 1/12/98 18:09'!
haltIfNil! !
!Object methodsFor: 'testing' stamp: 'md 1/20/2006 17:09'!
hasLiteralSuchThat: testBlock
"This is the end of the imbedded structure path so return false."
^ false! !
!Object methodsFor: 'testing'!
is: t1
^ false! !
!Object methodsFor: 'testing' stamp: 'eem 5/8/2008 11:13'!
isArray
^false! !
!Object methodsFor: 'testing' stamp: 'ar 7/9/1999 18:18'!
isBehavior
"Return true if the receiver is a behavior.
Note: Do not override in any class except behavior."
^false! !
!Object methodsFor: 'testing' stamp: 'ajh 1/21/2003 13:15'!
isBlock
^ false! !
!Object methodsFor: 'testing' stamp: 'yo 8/28/2002 13:41'!
isCharacter
^ false.
! !
!Object methodsFor: 'testing' stamp: 'eem 5/23/2008 13:47'!
isClosure
^false! !
!Object methodsFor: 'testing' stamp: 'ar 8/17/1999 19:43'!
isCollection
"Return true if the receiver is some sort of Collection and responds to basic collection messages such as #size and #do:"
^false! !
!Object methodsFor: 'testing'!
isColor
"Answer true if receiver is a Color. False by default."
^ false
! !
!Object methodsFor: 'testing' stamp: 'nk 4/17/2004 19:43'!
isColorForm
^false! !
!Object methodsFor: 'testing' stamp: 'md 11/21/2003 12:14'!
isCompiledMethod
^ false! !
!Object methodsFor: 'testing' stamp: 'mk 10/27/2003 17:33'!
isComplex
"Answer true if receiver is a Complex number. False by default."
^ false
! !
!Object methodsFor: 'testing' stamp: 'eem 11/26/2008 20:22'!
isContext
^false! !
!Object methodsFor: 'testing' stamp: 'md 8/11/2005 16:45'!
isDictionary
^false! !
!Object methodsFor: 'testing' stamp: 'di 11/9/1998 09:38'!
isFloat
"Overridden to return true in Float, natch"
^ false! !
!Object methodsFor: 'testing' stamp: 'ar 10/30/2000 23:22'!
isForm
^false! !
!Object methodsFor: 'testing' stamp: 'len 1/13/98 21:18'!
isFraction
"Answer true if the receiver is a Fraction."
^ false! !
!Object methodsFor: 'testing' stamp: 'rhi 8/14/2003 08:51'!
isHeap
^ false! !
!Object methodsFor: 'testing'!
isInteger
"Overridden to return true in Integer."
^ false! !
!Object methodsFor: 'testing' stamp: 'rhi 8/12/2003 09:52'!
isInterval
^ false! !
!Object methodsFor: 'testing' stamp: 'nk 4/25/2002 08:04'!
isMessageSend
^false
! !
!Object methodsFor: 'testing' stamp: 'md 2/19/2006 11:24'!
isMethodProperties
^false! !
!Object methodsFor: 'testing'!
isMorph
^ false! !
!Object methodsFor: 'testing' stamp: 'ar 9/13/2000 15:37'!
isMorphicEvent
^false! !
!Object methodsFor: 'testing' stamp: 'gm 2/22/2003 12:56'!
isMorphicModel
"Return true if the receiver is a morphic model"
^false
! !
!Object methodsFor: 'testing'!
isNumber
"Overridden to return true in Number, natch"
^ false! !
!Object methodsFor: 'testing' stamp: 'di 11/6/1998 08:04'!
isPoint
"Overridden to return true in Point."
^ false! !
!Object methodsFor: 'testing' stamp: 'ikp 9/26/97 14:45'!
isPseudoContext
^false! !
!Object methodsFor: 'testing' stamp: 'md 10/2/2005 21:52'!
isRectangle
^false! !
!Object methodsFor: 'testing' stamp: 'ar 12/23/1999 15:43'!
isStream
"Return true if the receiver responds to the stream protocol"
^false
! !
!Object methodsFor: 'testing' stamp: 'sma 6/15/2000 15:48'!
isString
"Overridden to return true in String, natch"
^ false! !
!Object methodsFor: 'testing' stamp: 'md 4/30/2003 15:30'!
isSymbol
^ false ! !
!Object methodsFor: 'testing' stamp: 'jam 3/9/2003 15:10'!
isSystemWindow
"answer whatever the receiver is a SystemWindow"
^ false! !
!Object methodsFor: 'testing'!
isText
^ false! !
!Object methodsFor: 'testing' stamp: 'adrian-lienhard 6/21/2009 23:52'!
isTrait
^false! !
!Object methodsFor: 'testing' stamp: 'ar 8/14/2001 23:19'!
isVariableBinding
"Return true if I represent a literal variable binding"
^false
! !
!Object methodsFor: 'testing'!
name
^ self printString! !
!Object methodsFor: 'testing'!
notNil
"Coerces nil to false and everything else to true."
^true! !
!Object methodsFor: 'testing' stamp: 'G.C 10/22/2008 09:59'!
refersToLiteral: literal
"Answer true if literal is identical to any literal in this array, even if imbedded in further structures. This is the end of the imbedded structure path so return false."
^ false! !
!Object methodsFor: 'testing' stamp: 'sw 10/20/1999 14:52'!
stepAt: millisecondClockValue in: aWindow
^ self stepIn: aWindow! !
!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:16'!
stepIn: aWindow
^ self step! !
!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:21'!
stepTime
^ 1000 "milliseconds -- default backstop for objects serving as models of system windows"! !
!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:22'!
stepTimeIn: aSystemWindow
^ 1000 "milliseconds -- default backstop for objects serving as models of system windows"! !
!Object methodsFor: 'testing' stamp: 'sw 11/13/2001 07:26'!
wantsDiffFeedback
"Answer whether the receiver, serving as the model of a text-bearing entity, would like for 'diffs' green pane-border feedback to be shown"
^ false! !
!Object methodsFor: 'testing' stamp: 'di 1/8/1999 15:04'!
wantsSteps
"Overridden by morphic classes whose instances want to be stepped,
or by model classes who want their morphic views to be stepped."
^ false! !
!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:26'!
wantsStepsIn: aSystemWindow
^ self wantsSteps! !
!Object methodsFor: 'updating'!
changed
"Receiver changed in a general way; inform all the dependents by
sending each dependent an update: message."
self changed: self! !
!Object methodsFor: 'updating'!
changed: aParameter
"Receiver changed. The change is denoted by the argument aParameter.
Usually the argument is a Symbol that is part of the dependent's change
protocol. Inform all of the dependents."
self dependents do: [:aDependent | aDependent update: aParameter]! !
!Object methodsFor: 'updating' stamp: 'MarcusDenker 6/11/2010 11:36'!
changed: anAspect with: anObject
"Receiver changed. The change is denoted by the argument anAspect.
Usually the argument is a Symbol that is part of the dependent's change
protocol. Inform all of the dependents. Also pass anObject for additional information."
self dependents do: [:aDependent | aDependent update: anAspect with: anObject]! !
!Object methodsFor: 'updating' stamp: 'sw 10/31/1999 00:15'!
noteSelectionIndex: anInteger for: aSymbol
"backstop"! !
!Object methodsFor: 'updating'!
okToChange
"Allows a controller to ask this of any model"
^ true! !
!Object methodsFor: 'updating'!
update: aParameter
"Receive a change notice from an object of whom the receiver is a
dependent. The default behavior is to do nothing; a subclass might want
to change itself in some way."
^ self! !
!Object methodsFor: 'updating' stamp: 'nk 2/17/2004 11:13'!
update: anAspect with: anObject
"Receive a change notice from an object of whom the receiver is a
dependent. The default behavior is to call update:,
which by default does nothing; a subclass might want
to change itself in some way."
^ self update: anAspect! !
!Object methodsFor: 'updating'!
windowIsClosing
^ self! !
!Object methodsFor: 'user interface' stamp: 'sw 10/4/1999 08:13'!
addModelItemsToWindowMenu: aMenu
"aMenu is being constructed to be presented to the user in response to the user's pressing on the menu widget in the title bar of a morphic window. Here, the model is given the opportunity to add any model-specific items to the menu, whose default target is the SystemWindow itself."! !
!Object methodsFor: 'user interface' stamp: 'sw 10/5/1998 14:39'!
addModelMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph
"The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items"
! !
!Object methodsFor: 'user interface'!
modelSleep
"A window with me as model is being exited or collapsed or closed.
Default response is no-op" ! !
!Object methodsFor: 'user interface'!
modelWakeUp
"A window with me as model is being entered or expanded. Default response is no-op" ! !
!Object methodsFor: 'user interface' stamp: 'sw 10/16/1999 22:45'!
modelWakeUpIn: aWindow
"A window with me as model is being entered or expanded. Default response is no-op"
self modelWakeUp! !
!Object methodsFor: 'user interface' stamp: 'sw 3/8/1999 15:27'!
mouseUpBalk: evt
"A button I own got a mouseDown, but the user moved out before letting up. Certain kinds of objects (so-called 'radio buttons', for example, and other structures that must always have some selection, e.g. PaintBoxMorph) wish to take special action in this case; this default does nothing."
! !
!Object methodsFor: 'user interface' stamp: 'jcg 11/1/2001 13:13'!
notYetImplemented
self inform: 'Not yet implemented (', thisContext sender printString, ')'! !
!Object methodsFor: 'user interface' stamp: 'di 6/10/1998 15:06'!
windowReqNewLabel: labelString
"My window's title has been edited.
Return true if this is OK, and override for further behavior."
^ true! !
!Object methodsFor: 'private'!
errorImproperStore
"Create an error notification that an improper store was attempted."
self error: 'Improper store into indexable object'! !
!Object methodsFor: 'private'!
errorNonIntegerIndex
"Create an error notification that an improper object was used as an index."
self error: 'only integers should be used as indices'! !
!Object methodsFor: 'private' stamp: 'yo 6/29/2004 11:37'!
errorNotIndexable
"Create an error notification that the receiver is not indexable."
self error: ('Instances of {1} are not indexable' translated format: {self class name})! !
!Object methodsFor: 'private' stamp: 'SvenVanCaekenberghe 4/21/2011 13:00'!
errorSubscriptBounds: index
"Create an error notification that an improper integer was used as an index."
SubscriptOutOfBounds signalFor: index! !
!Object methodsFor: 'private' stamp: 'eem 5/9/2008 09:04'!
species
"Answer the preferred class for reconstructing the receiver. For example,
collections create new collections whenever enumeration messages such as
collect: or select: are invoked. The new kind of collection is determined by
the species of the original collection. Species and class are not always the
same. For example, the species of Interval is Array."
<primitive: 111>
^self class! !
!Object methodsFor: 'private'!
storeAt: offset inTempFrame: aContext
"This message had to get sent to an expression already on the stack
as a Block argument being accessed by the debugger.
Just re-route it to the temp frame."
^ aContext tempAt: offset put: self! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Object class
instanceVariableNames: ''!
!Object class methodsFor: '*Compiler-Kernel'!
readFrom: t1
| t2 |
(Compiler couldEvaluate: t1)
ifFalse: [^ self error: 'expected String, Stream, or Text'].
t2 := Compiler evaluate: t1.
(t2 isKindOf: self)
ifFalse: [self error: self name , ' expected'].
^ t2! !
!Object class methodsFor: '*Polymorph-Widgets'!
taskbarIcon
"Answer the icon for an instance of the receiver in a task bar
or nil for the default."
^nil ! !
!Object class methodsFor: '*Polymorph-Widgets' stamp: 'gvc 1/31/2009 15:53'!
taskbarLabel
"Answer the label string for the receiver in a task bar
or nil for the default."
^nil! !
!Object class methodsFor: '*System-Support'!
registerToolsOn: t1
^ self! !
!Object class methodsFor: '*Tools-FileList' stamp: 'md 2/15/2006 17:20'!
services
"Backstop"
^#()! !
!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 02:00'!
flushDependents
DependentsFields keysAndValuesDo:[:key :dep|
key ifNotNil:[key removeDependent: nil].
].
DependentsFields finalizeValues.! !
!Object class methodsFor: 'class initialization' stamp: 'rw 2/10/2002 13:09'!
flushEvents
"Object flushEvents"
EventManager flushEvents. ! !
!Object class methodsFor: 'class initialization'!
initialize
DependentsFields
ifNil: [self initializeDependentsFields]! !
!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:41'!
initializeDependentsFields
"Object initialize"
DependentsFields := WeakIdentityKeyDictionary new.
! !
!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:45'!
reInitializeDependentsFields
"Object reInitializeDependentsFields"
| oldFields |
oldFields := DependentsFields.
DependentsFields := WeakIdentityKeyDictionary new.
oldFields keysAndValuesDo:[:obj :deps|
deps do:[:d| obj addDependent: d]].
! !
!Object class methodsFor: 'documentation'!
howToModifyPrimitives
"You are allowed to write methods which specify primitives, but please use
caution. If you make a subclass of a class which contains a primitive method,
the subclass inherits the primitive. The message which is implemented
primitively may be overridden in the subclass (E.g., see at:put: in String's
subclass Symbol). The primitive behavior can be invoked using super (see
Symbol string:).
A class which attempts to mimic the behavior of another class without being
its subclass may or may not be able to use the primitives of the original class.
In general, if the instance variables read or written by a primitive have the
same meanings and are in the same fields in both classes, the primitive will
work.
For certain frequently used 'special selectors', the compiler emits a
send-special-selector bytecode instead of a send-message bytecode.
Special selectors were created because they offer two advantages. Code
which sends special selectors compiles into fewer bytes than normal. For
some pairs of receiver classes and special selectors, the interpreter jumps
directly to a primitive routine without looking up the method in the class.
This is much faster than a normal message lookup.
A selector which is a special selector solely in order to save space has a
normal behavior. Methods whose selectors are special in order to
gain speed contain the comment, 'No Lookup'. When the interpreter
encounters a send-special-selector bytecode, it checks the class of the
receiver and the selector. If the class-selector pair is a no-lookup pair,
then the interpreter swiftly jumps to the routine which implements the
corresponding primitive. (A special selector whose receiver is not of the
right class to make a no-lookup pair, is looked up normally). The pairs are
listed below. No-lookup methods contain a primitive number specification,
<primitive: xx>, which is redundant. Since the method is not normally looked
up, deleting the primitive number specification cannot prevent this
primitive from running. If a no-lookup primitive fails, the method is looked
up normally, and the expressions in it are executed.
No Lookup pairs of (class, selector)
SmallInteger with any of + - * / \\ bitOr: bitShift: bitAnd: //
SmallInteger with any of = ~= > < >= <=
Any class with ==
Any class with @
Point with either of x y
ContextPart with blockCopy:
BlockContext with either of value value:
"
self error: 'comment only'! !
!Object class methodsFor: 'documentation'!
whatIsAPrimitive
"Some messages in the system are responded to primitively. A primitive
response is performed directly by the interpreter rather than by evaluating
expressions in a method. The methods for these messages indicate the
presence of a primitive response by including <primitive: xx> before the
first expression in the method.
Primitives exist for several reasons. Certain basic or 'primitive'
operations cannot be performed in any other way. Smalltalk without
primitives can move values from one variable to another, but cannot add two
SmallIntegers together. Many methods for arithmetic and comparison
between numbers are primitives. Some primitives allow Smalltalk to
communicate with I/O devices such as the disk, the display, and the keyboard.
Some primitives exist only to make the system run faster; each does the same
thing as a certain Smalltalk method, and its implementation as a primitive is
optional.
When the Smalltalk interpreter begins to execute a method which specifies a
primitive response, it tries to perform the primitive action and to return a
result. If the routine in the interpreter for this primitive is successful,
it will return a value and the expressions in the method will not be evaluated.
If the primitive routine is not successful, the primitive 'fails', and the
Smalltalk expressions in the method are executed instead. These
expressions are evaluated as though the primitive routine had not been
called.
The Smalltalk code that is evaluated when a primitive fails usually
anticipates why that primitive might fail. If the primitive is optional, the
expressions in the method do exactly what the primitive would have done (See
Number @). If the primitive only works on certain classes of arguments, the
Smalltalk code tries to coerce the argument or appeals to a superclass to find
a more general way of doing the operation (see SmallInteger +). If the
primitive is never supposed to fail, the expressions signal an error (see
SmallInteger asFloat).
Each method that specifies a primitive has a comment in it. If the primitive is
optional, the comment will say 'Optional'. An optional primitive that is not
implemented always fails, and the Smalltalk expressions do the work
instead.
If a primitive is not optional, the comment will say, 'Essential'. Some
methods will have the comment, 'No Lookup'. See Object
howToModifyPrimitives for an explanation of special selectors which are
not looked up.
For the primitives for +, -, *, and bitShift: in SmallInteger, and truncated
in Float, the primitive constructs and returns a 16-bit
LargePositiveInteger when the result warrants it. Returning 16-bit
LargePositiveIntegers from these primitives instead of failing is
optional in the same sense that the LargePositiveInteger arithmetic
primitives are optional. The comments in the SmallInteger primitives say,
'Fails if result is not a SmallInteger', even though the implementor has the
option to construct a LargePositiveInteger. For further information on
primitives, see the 'Primitive Methods' part of the chapter on the formal
specification of the interpreter in the Smalltalk book."
self error: 'comment only'! !
!Object class methodsFor: 'file list services' stamp: 'nk 6/12/2004 11:41'!
fileReaderServicesForDirectory: aFileDirectory
"Backstop"
^#()! !
!Object class methodsFor: 'file list services' stamp: 'nk 6/12/2004 11:30'!
fileReaderServicesForFile: fullName suffix: suffix
"Backstop"
^#()! !
!Object class methodsFor: 'instance creation' stamp: 'StephaneDucasse 2/20/2010 21:38'!
newFrom: aSimilarObject
"Create an object that has similar contents to aSimilarObject. If the classes have any instance varaibles with the same names, copy them across. If this is bad for a class, override this method."
^ (self isVariable
ifTrue: [self basicNew: aSimilarObject basicSize]
ifFalse: [self basicNew]) copySameFrom: aSimilarObject! !
!Object class methodsFor: 'objects from disk' stamp: 'tk 1/8/97'!
createFrom: aSmartRefStream size: varsOnDisk version: instVarList
"Create an instance of me so objects on the disk can be read in. Tricky part is computing the size if variable. Inst vars will be filled in later. "
^ self isVariable
ifFalse: [self basicNew]
ifTrue: ["instVarList is names of old class's inst vars plus a version number"
self basicNew: (varsOnDisk - (instVarList size - 1))]
! !
!Object class methodsFor: 'private' stamp: 'mir 8/22/2001 15:20'!
releaseExternalSettings
"Do nothing as a default"! !
Object subclass: #MessageSend
instanceVariableNames: 'receiver selector arguments'
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Objects'!
!MessageSend commentStamp: 'DF 5/25/2006 19:54' prior: 0!
Instances of MessageSend encapsulate message sends to objects. Arguments can be either predefined or supplied when the message send is performed.
Use #value to perform a message send with its predefined arguments and #valueWithArguments: if additonal arguments have to supplied.
Structure:
receiver Object -- object receiving the message send
selector Symbol -- message selector
arguments Array -- bound arguments!
!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
arguments
^ arguments! !
!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:40'!
arguments: anArray
arguments := anArray! !
!MessageSend methodsFor: 'accessing' stamp: 'eem 1/3/2009 10:42'!
numArgs
"Answer the number of arguments in this message"
^arguments size! !
!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
receiver
^ receiver! !
!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
receiver: anObject
receiver := anObject! !
!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
selector
^ selector! !
!MessageSend methodsFor: 'accessing' stamp: 'sma 2/29/2000 20:39'!
selector: aSymbol
selector := aSymbol! !
!MessageSend methodsFor: 'comparing' stamp: 'sma 2/29/2000 20:43'!
= anObject
^ anObject species == self species
and: [receiver == anObject receiver
and: [selector == anObject selector
and: [arguments = anObject arguments]]]! !
!MessageSend methodsFor: 'comparing' stamp: 'sma 3/11/2000 10:35'!
hash
^ receiver hash bitXor: selector hash! !
!MessageSend methodsFor: 'converting' stamp: 'nk 12/20/2002 17:54'!
asMinimalRepresentation
^self! !
!MessageSend methodsFor: 'converting' stamp: 'IgorStasenko 3/12/2011 17:49'!
asWeakMessageSend
^ WeakMessageSend
receiver: receiver
selector: selector
arguments: arguments copy! !
!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:15'!
cull: arg
^ selector numArgs = 0
ifTrue: [ self value ]
ifFalse: [ self value: arg ].
! !
!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:16'!
cull: arg1 cull: arg2
^ selector numArgs < 2
ifTrue: [ self cull: arg1]
ifFalse: [ self value: arg1 value: arg2 ]! !
!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:23'!
cull: arg1 cull: arg2 cull: arg3
^ selector numArgs < 3
ifTrue: [ self cull: arg1 cull: arg2 ]
ifFalse: [ self value: arg1 value: arg2 value: arg3 ]! !
!MessageSend methodsFor: 'evaluating' stamp: 'sw 2/20/2002 22:17'!
value
"Send the message and answer the return value"
arguments ifNil: [^ receiver perform: selector].
^ receiver
perform: selector
withArguments: (self collectArguments: arguments)! !
!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:21'!
value: anObject
^ receiver
perform: selector
with: anObject! !
!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:22'!
value: anObject1 value: anObject2
^ receiver
perform: selector
with: anObject1
with: anObject2! !
!MessageSend methodsFor: 'evaluating' stamp: 'IgorStasenko 3/12/2011 16:22'!
value: anObject1 value: anObject2 value: anObject3
^ receiver
perform: selector
with: anObject1
with: anObject2
with: anObject3! !
!MessageSend methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 16:51'!
valueWithArguments: anArray
^ receiver
perform: selector
withArguments: (self collectArguments: anArray)! !
!MessageSend methodsFor: 'evaluating' stamp: 'nk 3/11/2001 11:42'!
valueWithEnoughArguments: anArray
"call the selector with enough arguments from arguments and anArray"
| args |
args := Array new: selector numArgs.
args replaceFrom: 1
to: (arguments size min: args size)
with: arguments
startingAt: 1.
args size > arguments size ifTrue: [
args replaceFrom: arguments size + 1
to: (arguments size + anArray size min: args size)
with: anArray
startingAt: 1.
].
^ receiver perform: selector withArguments: args! !
!MessageSend methodsFor: 'printing' stamp: 'SqR 7/14/2001 11:36'!
printOn: aStream
aStream
nextPutAll: self class name;
nextPut: $(.
selector printOn: aStream.
aStream nextPutAll: ' -> '.
receiver printOn: aStream.
aStream nextPut: $)! !
!MessageSend methodsFor: 'testing' stamp: 'nk 4/25/2002 08:04'!
isMessageSend
^true
! !
!MessageSend methodsFor: 'testing' stamp: 'nk 7/21/2003 15:16'!
isValid
^true! !
!MessageSend methodsFor: 'private' stamp: 'reThink 2/18/2001 17:33'!
collectArguments: anArgArray
"Private"
| staticArgs |
staticArgs := self arguments.
^(anArgArray size = staticArgs size)
ifTrue: [anArgArray]
ifFalse:
[(staticArgs isEmpty
ifTrue: [ staticArgs := Array new: selector numArgs]
ifFalse: [staticArgs copy] )
replaceFrom: 1
to: (anArgArray size min: staticArgs size)
with: anArgArray
startingAt: 1]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MessageSend class
instanceVariableNames: ''!
!MessageSend class methodsFor: 'instance creation' stamp: 'sma 2/29/2000 20:44'!
receiver: anObject selector: aSymbol
^ self receiver: anObject selector: aSymbol arguments: #()! !
!MessageSend class methodsFor: 'instance creation' stamp: 'sma 2/29/2000 20:44'!
receiver: anObject selector: aSymbol argument: aParameter
^ self receiver: anObject selector: aSymbol arguments: (Array with: aParameter)! !
!MessageSend class methodsFor: 'instance creation' stamp: 'sma 2/29/2000 20:39'!
receiver: anObject selector: aSymbol arguments: anArray
^ self new
receiver: anObject;
selector: aSymbol;
arguments: anArray! !
Object subclass: #UndefinedObject
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Objects'!
!UndefinedObject commentStamp: '<historical>' prior: 0!
I describe the behavior of my sole instance, nil. nil represents a prior value for variables that have not been initialized, or for results which are meaningless.!
!UndefinedObject methodsFor: '*Compiler-Kernel' stamp: 'md 2/20/2006 18:47'!
parserClass
^ Compiler parserClass! !
!UndefinedObject methodsFor: 'bottom context' stamp: 'ajh 2/1/2003 01:31'!
canHandleSignal: exception
"When no more handler (on:do:) context left in sender chain this gets called"
^ false! !
!UndefinedObject methodsFor: 'bottom context' stamp: 'ajh 2/1/2003 01:31'!
handleSignal: exception
"When no more handler (on:do:) context left in sender chain this gets called. Return from signal with default action."
^ exception resumeUnchecked: exception defaultAction! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ar 7/15/1999 16:49'!
addSubclass: aClass
"Ignored -- necessary to support disjoint class hierarchies"! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'dvf 8/9/2005 16:49'!
allSuperclassesDo: aBlockContext
self shouldBeImplemented! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'sd 3/28/2003 15:16'!
environment
"Necessary to support disjoint class hierarchies."
^self class environment! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ajh 1/27/2003 17:48'!
literalScannedAs: scannedLiteral notifying: requestor
^ scannedLiteral! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'dvf 9/22/2005 20:10'!
removeObsoleteSubclass: aClass
"Ignored -- necessary to support disjoint class hierarchies"! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ikp 9/26/97 14:45'!
removeSubclass: aClass
"Ignored -- necessary to support disjoint class hierarchies"! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ar 8/29/1999 12:49'!
subclassDefinerClass
"For disjunct class hierarchies -- how should subclasses of nil be evaluated"
^Compiler! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'PeterHugossonMiller 9/3/2009 11:46'!
subclasses
"Return all the subclasses of nil"
| classList |
classList := Array new writeStream.
self subclassesDo:[:class| classList nextPut: class].
^classList contents! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'StephaneDucasse 2/13/2010 15:35'!
subclassesDo: aBlock
"Evaluate aBlock with all subclasses of nil. Others are not direct subclasses of Class."
^ Class subclassesDo: [:cl |
cl isMeta ifTrue: [aBlock value: cl soleInstance]].! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'StephaneDucasse 6/4/2011 11:48'!
subclass: nameOfClass
instanceVariableNames: instVarNames
classVariableNames: classVarNames
poolDictionaries: poolDictnames
category: category
"Calling this method is now considered an accident. If you really want to create a class with a nil superclass, then create the class and then set the superclass using #superclass:"
self logCr: ('Attempt to create ', nameOfClass, ' as a subclass of nil. Possibly a class is being loaded before its superclass.').
^ProtoObject
subclass: nameOfClass
instanceVariableNames: instVarNames
classVariableNames: classVarNames
poolDictionaries: poolDictnames
category: category
! !
!UndefinedObject methodsFor: 'class hierarchy' stamp: 'ar 7/13/1999 06:08'!
typeOfClass
"Necessary to support disjoint class hierarchies."
^#normal! !
!UndefinedObject methodsFor: 'copying'!
deepCopy
"Only one instance of UndefinedObject should ever be made, so answer
with self."! !
!UndefinedObject methodsFor: 'copying'!
shallowCopy
"Only one instance of UndefinedObject should ever be made, so answer
with self."! !
!UndefinedObject methodsFor: 'copying' stamp: 'tk 8/20/1998 16:07'!
veryDeepCopyWith: deepCopier
"Return self. I can't be copied. Do not record me."! !
!UndefinedObject methodsFor: 'dependents access'!
addDependent: ignored
"Refer to the comment in Object|dependents."
self error: 'Nil should not have dependents'! !
!UndefinedObject methodsFor: 'dependents access'!
release
"Nil release is a no-op"! !
!UndefinedObject methodsFor: 'dependents access'!
suspend
"Kills off processes that didn't terminate properly"
"Display reverse; reverse." "<-- So we can catch the suspend bug"
Processor terminateActive! !
!UndefinedObject methodsFor: 'printing'!
printOn: aStream
"Refer to the comment in Object|printOn:."
aStream nextPutAll: 'nil'! !
!UndefinedObject methodsFor: 'printing'!
storeOn: aStream
"Refer to the comment in Object|storeOn:."
aStream nextPutAll: 'nil'! !
!UndefinedObject methodsFor: 'sets support' stamp: 'Igor.Stasenko 11/13/2009 06:16'!
asSetElement
"Since nil is a singleton, we need only a single wrapper instance to represent it in set,
created in advance"
^ SetElement withNil! !
!UndefinedObject methodsFor: 'testing' stamp: 'sw 1/12/98 18:09'!
haltIfNil
self halt! !
!UndefinedObject methodsFor: 'testing'!
ifNil: aBlock
"A convenient test, in conjunction with Object ifNil:"
^ aBlock value! !
!UndefinedObject methodsFor: 'testing' stamp: 'md 10/7/2004 15:41'!
ifNil: nilBlock ifNotNilDo: ifNotNilBlock
"Evaluate the block for nil because I'm == nil"
^ nilBlock value! !
!UndefinedObject methodsFor: 'testing'!
ifNil: nilBlock ifNotNil: ifNotNilBlock
"Evaluate the block for nil because I'm == nil"
^ nilBlock value! !
!UndefinedObject methodsFor: 'testing' stamp: 'di 11/8/2000 21:22'!
ifNotNilDo: aBlock
"Override to do nothing."
^ self
! !
!UndefinedObject methodsFor: 'testing' stamp: 'md 10/7/2004 15:39'!
ifNotNilDo: ifNotNilBlock ifNil: nilBlock
"If I got here, I am nil, so evaluate the block nilBlock"
^ nilBlock value! !
!UndefinedObject methodsFor: 'testing'!
ifNotNil: aBlock
"A convenient test, in conjunction with Object ifNotNil:"
^ self! !
!UndefinedObject methodsFor: 'testing'!
ifNotNil: ifNotNilBlock ifNil: nilBlock
"If I got here, I am nil, so evaluate the block nilBlock"
^ nilBlock value! !
!UndefinedObject methodsFor: 'testing' stamp: 'sw 4/7/1999 17:44'!
isEmptyOrNil
"Answer whether the receiver contains any elements, or is nil. Useful in numerous situations where one wishes the same reaction to an empty collection or to nil"
^ true! !
!UndefinedObject methodsFor: 'testing' stamp: 'sma 6/6/2000 22:53'!
isLiteral
^ true! !
!UndefinedObject methodsFor: 'testing'!
isNil
"Refer to the comment in Object|isNil."
^true! !
!UndefinedObject methodsFor: 'testing'!
notNil
"Refer to the comment in Object|notNil."
^false! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
UndefinedObject class
instanceVariableNames: ''!
!UndefinedObject class methodsFor: 'accessing' stamp: 'nice 11/14/2009 19:22'!
allInstances
"It is well known there is a single instance"
^Array with: nil! !
!UndefinedObject class methodsFor: 'accessing' stamp: 'nice 11/14/2009 19:22'!
allInstancesDo: aBlock
"It is well known there is a single instance"
aBlock value: nil! !
!UndefinedObject class methodsFor: 'instance creation'!
new
self error: 'You may not create any more undefined objects--use nil'! !
Object subclass: #Boolean
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Objects'!
!Boolean commentStamp: '<historical>' prior: 0!
Boolean is an abstract class defining the protocol for logic testing operations and conditional control structures for the logical values represented by the instances of its subclasses True and False.
Boolean redefines #new so no instances of Boolean can be created. It also redefines several messages in the 'copying' protocol to ensure that only one instance of each of its subclasses True (the global true, logical assertion) and False (the global false, logical negation) ever exist in the system.!
!Boolean methodsFor: '*compatibility' stamp: 'StephaneDucasse 6/27/2010 18:19'!
and: block1 and: block2
"Nonevaluating conjunction without deep nesting.
The receiver is evaluated, followed by the blocks in order.
If any of these evaluates as false, then return false immediately,
without evaluating any further blocks.
If all return true, then return true."
self deprecated: 'use and:'.
self ifFalse: [^ false].
block1 value ifFalse: [^ false].
block2 value ifFalse: [^ false].
^ true! !
!Boolean methodsFor: '*compatibility' stamp: 'StephaneDucasse 4/27/2010 11:46'!
and: block1 and: block2 and: block3
"Nonevaluating conjunction without deep nesting.
The receiver is evaluated, followed by the blocks in order.
If any of these evaluates as false, then return false immediately,
without evaluating any further blocks.
If all return true, then return true."
self deprecated: 'Use and: instead'.
self ifFalse: [^ false].
block1 value ifFalse: [^ false].
block2 value ifFalse: [^ false].
block3 value ifFalse: [^ false].
^ true! !
!Boolean methodsFor: '*compatibility' stamp: 'StephaneDucasse 5/26/2010 21:35'!
and: block1 and: block2 and: block3 and: block4
"Nonevaluating conjunction without deep nesting.
The receiver is evaluated, followed by the blocks in order.
If any of these evaluates as false, then return false immediately,
without evaluating any further blocks.
If all return true, then return true."
self deprecated: 'Use and: instead'.
self ifFalse: [^ false].
block1 value ifFalse: [^ false].
block2 value ifFalse: [^ false].
block3 value ifFalse: [^ false].
block4 value ifFalse: [^ false].
^ true! !
!Boolean methodsFor: '*compatibility' stamp: 'jannik.laval 2/5/2010 21:41'!
or: block1 or: block2
"Nonevaluating alternation without deep nesting.
The receiver is evaluated, followed by the blocks in order.
If any of these evaluates as true, then return true immediately,
without evaluating any further blocks.
If all return false, then return false."
self deprecated:'use a or:[b or:[c]] instead'.
self ifTrue: [^ true].
block1 value ifTrue: [^ true].
block2 value ifTrue: [^ true].
^ false! !
!Boolean methodsFor: '*compatibility' stamp: 'jannik.laval 2/5/2010 21:42'!
or: block1 or: block2 or: block3
"Nonevaluating alternation without deep nesting.
The receiver is evaluated, followed by the blocks in order.
If any of these evaluates as true, then return true immediately,
without evaluating any further blocks.
If all return false, then return false."
self deprecated:'use a or:[b or:[c or:[d]]] instead'.
self ifTrue: [^ true].
block1 value ifTrue: [^ true].
block2 value ifTrue: [^ true].
block3 value ifTrue: [^ true].
^ false! !
!Boolean methodsFor: '*compatibility' stamp: 'jannik.laval 2/5/2010 21:42'!
or: block1 or: block2 or: block3 or: block4
"Nonevaluating alternation without deep nesting.
The receiver is evaluated, followed by the blocks in order.
If any of these evaluates as true, then return true immediately,
without evaluating any further blocks.
If all return false, then return false."
self deprecated:'use a or:[b or:[c or:[d or:[e]]]] instead'.
self ifTrue: [^ true].
block1 value ifTrue: [^ true].
block2 value ifTrue: [^ true].
block3 value ifTrue: [^ true].
block4 value ifTrue: [^ true].
^ false! !
!Boolean methodsFor: 'controlling'!
and: alternativeBlock
"Nonevaluating conjunction. If the receiver is true, answer the value of
the argument, alternativeBlock; otherwise answer false without
evaluating the argument."
self subclassResponsibility! !
!Boolean methodsFor: 'controlling'!
ifFalse: alternativeBlock
"If the receiver is true (i.e., the condition is true), then the value is the
true alternative, which is nil. Otherwise answer the result of evaluating
the argument, alternativeBlock. Create an error notification if the
receiver is nonBoolean. Execution does not actually reach here because
the expression is compiled in-line."
self subclassResponsibility! !
!Boolean methodsFor: 'controlling'!
ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock
"Same as ifTrue:ifFalse:."
self subclassResponsibility! !
!Boolean methodsFor: 'controlling'!
ifTrue: alternativeBlock
"If the receiver is false (i.e., the condition is false), then the value is the
false alternative, which is nil. Otherwise answer the result of evaluating
the argument, alternativeBlock. Create an error notification if the
receiver is nonBoolean. Execution does not actually reach here because
the expression is compiled in-line."
self subclassResponsibility! !
!Boolean methodsFor: 'controlling'!
ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
"If the receiver is true (i.e., the condition is true), then answer the value
of the argument trueAlternativeBlock. If the receiver is false, answer the
result of evaluating the argument falseAlternativeBlock. If the receiver
is a nonBoolean then create an error notification. Execution does not
actually reach here because the expression is compiled in-line."
self subclassResponsibility! !
!Boolean methodsFor: 'controlling'!
or: alternativeBlock
"Nonevaluating disjunction. If the receiver is false, answer the value of
the argument, alternativeBlock; otherwise answer true without
evaluating the argument."
self subclassResponsibility! !
!Boolean methodsFor: 'copying'!
deepCopy
"Receiver has two concrete subclasses, True and False.
Only one instance of each should be made, so return self."! !
!Boolean methodsFor: 'copying'!
shallowCopy
"Receiver has two concrete subclasses, True and False.
Only one instance of each should be made, so return self."! !
!Boolean methodsFor: 'copying' stamp: 'tk 8/20/1998 16:07'!
veryDeepCopyWith: deepCopier
"Return self. I can't be copied. Do not record me."! !
!Boolean methodsFor: 'logical operations'!
& aBoolean
"Evaluating conjunction. Evaluate the argument. Then answer true if
both the receiver and the argument are true."
self subclassResponsibility! !
!Boolean methodsFor: 'logical operations' stamp: 'stephane.ducasse 5/20/2009 21:28'!
==> aBlock
"The material conditional, also known as the material implication or truth functional conditional.
Correspond to not ... or ... and does not correspond to the English if...then... construction.
known as:
b if a
a implies b
if a then b
b is a consequence of a
a therefore b (but note: 'it is raining therefore it is cloudy' is implication; 'it is autumn therefore the leaves are falling' is equivalence).
Here is the truth table for material implication:
p | q | p ==> q
-------|-------|-------------
T | T | T
T | F | F
F | T | T
F | F | T
"
^self not or: [aBlock value]! !
!Boolean methodsFor: 'logical operations'!
eqv: aBoolean
"Answer true if the receiver is equivalent to aBoolean."
^self == aBoolean! !
!Boolean methodsFor: 'logical operations'!
not
"Negation. Answer true if the receiver is false, answer false if the
receiver is true."
self subclassResponsibility! !
!Boolean methodsFor: 'logical operations'!
| aBoolean
"Evaluating disjunction (OR). Evaluate the argument. Then answer true
if either the receiver or the argument is true."
self subclassResponsibility! !
!Boolean methodsFor: 'printing' stamp: 'apb 4/21/2006 09:22'!
isLiteral
^ true! !
!Boolean methodsFor: 'printing'!
storeOn: aStream
"Refer to the comment in Object|storeOn:."
self printOn: aStream! !
!Boolean methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:45'!
isSelfEvaluating
^ true! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Boolean class
instanceVariableNames: ''!
!Boolean class methodsFor: '*System-Settings-Browser' stamp: 'alain.plantec 3/18/2009 14:48'!
settingInputWidgetForNode: aSettingNode
^ aSettingNode inputWidgetForBoolean! !
!Boolean class methodsFor: 'instance creation'!
new
self error: 'You may not create any more Booleans - this is two-valued logic'! !
Boolean subclass: #False
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Objects'!
!False commentStamp: '<historical>' prior: 0!
False defines the behavior of its single instance, false -- logical negation. Notice how the truth-value checks become direct message sends, without the need for explicit testing.
Be aware however that most of these methods are not sent as real messages in normal use. Most are inline coded by the compiler as test and jump bytecodes - avoiding the overhead of the full message sends. So simply redefining these methods here will have no effect.!
!False methodsFor: 'controlling'!
and: alternativeBlock
"Nonevaluating conjunction -- answer with false since the receiver is false."
^self! !
!False methodsFor: 'controlling'!
ifFalse: alternativeBlock
"Answer the value of alternativeBlock. Execution does not actually
reach here because the expression is compiled in-line."
^alternativeBlock value! !
!False methodsFor: 'controlling'!
ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock
"Answer the value of falseAlternativeBlock. Execution does not
actually reach here because the expression is compiled in-line."
^falseAlternativeBlock value! !
!False methodsFor: 'controlling'!
ifTrue: alternativeBlock
"Since the condition is false, answer the value of the false alternative,
which is nil. Execution does not actually reach here because the
expression is compiled in-line."
^nil! !
!False methodsFor: 'controlling'!
ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
"Answer the value of falseAlternativeBlock. Execution does not
actually reach here because the expression is compiled in-line."
^falseAlternativeBlock value! !
!False methodsFor: 'controlling'!
or: alternativeBlock
"Nonevaluating disjunction -- answer value of alternativeBlock."
^alternativeBlock value! !
!False methodsFor: 'logical operations' stamp: 'md 7/30/2005 18:05'!
& aBoolean
"Evaluating conjunction -- answer false since receiver is false."
^self! !
!False methodsFor: 'logical operations'!
not
"Negation -- answer true since the receiver is false."
^true! !
!False methodsFor: 'logical operations' stamp: 'Md 11/18/2010 18:40'!
xor: aBoolean
"Posted by Eliot Miranda to squeak-dev on 3/24/2009"
^aBoolean value! !
!False methodsFor: 'logical operations'!
| aBoolean
"Evaluating disjunction (OR) -- answer with the argument, aBoolean."
^aBoolean! !
!False methodsFor: 'printing' stamp: 'ajh 7/1/2004 10:36'!
asBit
^ 0! !
!False methodsFor: 'printing'!
printOn: aStream
aStream nextPutAll: 'false'! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
False class
instanceVariableNames: ''!
Boolean subclass: #True
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Objects'!
!True commentStamp: '<historical>' prior: 0!
True defines the behavior of its single instance, true -- logical assertion. Notice how the truth-value checks become direct message sends, without the need for explicit testing.
Be aware however that most of these methods are not sent as real messages in normal use. Most are inline coded by the compiler as test and jump bytecodes - avoiding the overhead of the full message sends. So simply redefining these methods here will have no effect.!
!True methodsFor: 'controlling'!
and: alternativeBlock
"Nonevaluating conjunction -- answer the value of alternativeBlock since
the receiver is true."
^alternativeBlock value! !
!True methodsFor: 'controlling'!
ifFalse: alternativeBlock
"Since the condition is true, the value is the true alternative, which is nil.
Execution does not actually reach here because the expression is compiled
in-line."
^nil! !