'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 4 November 2008 at 12:29:51 pm'!
!classDefinition: #ProtocolCatcher category: #'Tools-UsedProtocol'!
ProtoObject subclass: #ProtocolCatcher
	instanceVariableNames: 'realObject'
	classVariableNames: 'Protocols Started'
	poolDictionaries: ''
	category: 'Tools-UsedProtocol'!

!ProtocolCatcher commentStamp: '<historical>' prior: 0!
Protocol catchers use #doesNotUnderstand: to detect the protocol actually used for classes under study. The subject of study is classes, not particular objects. And all instances of ProtocolCatcher work as a team. The captured protocols are stored in a class variable. In this way, you can do the following, anytime, without worrying of keeping track of each instance of ProtocolCatcher:

"Standard way to change existing instances to catchers: As ivar realObject is initialized with self, after the #become: it points to the observed object, and it is the solely reference to it (at that moment!!)"
| objects catchers |
ProtocolCatcher clear.
objects _ ParagraphEditor allSubInstances asArray.
catchers _ Array new: objects size.
1 to: catchers size do: [ :i |
	catchers at: i put: ProtocolCatcher new ].
objects elementsExchangeIdentityWith: catchers

The other way to use it is to replace 'ObservedClass new' to 'ProtocolCatcher on: ObservedClass new'. In this pattern, as there is no #become:, we must set the observed object explicitly.

After that you can use:

ProtocolCatcher clear
ProtocolCatcher start
ProtocolCatcher stop
ProtocolCatcher observedClasses
ProtocolCatcher protocolFor: ParagraphEditor

Finally, this class also serves as an example on how to do a ProtocolCatcher. Sometimes, when replacing an existing class in the system, it is useful to know the actually used protocol. But it can also be useful to keep the forwarding mechanism available after the new class has been installed. This way it is easier to add behavior that is still missing.!
]style[(308 79 233 22 11 15 145 29 290 433)cblack;,f4cblack;,cblack;,f4,cblack;,f4,cblack;,f4,f4cblack;,f4!

!classDefinition: #ProtocolCatcher2 category: #'Tools-UsedProtocol'!
Object subclass: #ProtocolCatcher2
	instanceVariableNames: 'realObject'
	classVariableNames: 'Protocols Started'
	poolDictionaries: ''
	category: 'Tools-UsedProtocol'!

!ProtocolCatcher2 commentStamp: 'jmv 11/3/2008 14:49' prior: 0!
See class comment in ProtocolCatcher.

The only difference between ProtocolCatcher and ProtocolCatcher2 is that this is subclass of Object. This means it will not catch protocol inherited from Object. This is not usually a problem, and inspectors are more comfortable to use if the catcher is not that transparent.!


!ProtocolCatcher methodsFor: 'accessing' stamp: 'jmv 11/3/2008 13:04'!
realObject
	realObject == self ifTrue: [^self halt].
	^realObject class == ProtocolCatcher
		ifTrue: [ realObject realObject ]
		ifFalse: [ realObject ]! !

!ProtocolCatcher methodsFor: 'catching' stamp: 'jmv 11/3/2008 13:03'!
doesNotUnderstand: aMessage

	| protocol object answer |
	Started ifTrue: [
		protocol _ Protocols at: realObject class ifAbsentPut: Set new.
		protocol add: aMessage selector ].
	realObject == self ifTrue: [
		self halt.
		^nil].
	object _ self realObject.
	answer _ aMessage sendTo: object.
	^answer == object 
		ifTrue: [ self ]
		ifFalse: [ answer ]! !

!ProtocolCatcher methodsFor: 'services' stamp: 'jmv 11/3/2008 12:40'!
initialize
	realObject _ self! !


!ProtocolCatcher class methodsFor: 'instance creation' stamp: 'jmv 11/3/2008 14:50'!
on: anObject
	| catcher |
	catcher _ self new.
	catcher instVarNamed: 'realObject' put: anObject! !

!ProtocolCatcher class methodsFor: 'services' stamp: 'jmv 11/3/2008 11:28'!
clear
	Protocols _ Dictionary new.
	Started _ false! !

!ProtocolCatcher class methodsFor: 'services' stamp: 'jmv 11/3/2008 11:10'!
observedClasses

	^Protocols keys! !

!ProtocolCatcher class methodsFor: 'services' stamp: 'jmv 11/3/2008 11:11'!
protocolFor: aClass

	^Protocols at: aClass! !

!ProtocolCatcher class methodsFor: 'services' stamp: 'jmv 11/3/2008 11:28'!
start
	Started _ true! !

!ProtocolCatcher class methodsFor: 'services' stamp: 'jmv 11/3/2008 11:28'!
stop
	Started _ false! !


!ProtocolCatcher2 methodsFor: 'accessing' stamp: 'jmv 11/3/2008 14:55'!
realObject
	realObject == self ifTrue: [^self halt].
	^realObject class == ProtocolCatcher2
		ifTrue: [ realObject realObject ]
		ifFalse: [ realObject ]! !

!ProtocolCatcher2 methodsFor: 'catching' stamp: 'jmv 11/3/2008 13:03'!
doesNotUnderstand: aMessage

	| protocol object answer |
	Started ifTrue: [
		protocol _ Protocols at: realObject class ifAbsentPut: Set new.
		protocol add: aMessage selector ].
	realObject == self ifTrue: [
		self halt.
		^nil].
	object _ self realObject.
	answer _ aMessage sendTo: object.
	^answer == object 
		ifTrue: [ self ]
		ifFalse: [ answer ]! !

!ProtocolCatcher2 methodsFor: 'services' stamp: 'jmv 11/3/2008 13:00'!
initialize
	realObject _ self! !


!ProtocolCatcher2 class methodsFor: 'instance creation' stamp: 'jmv 11/3/2008 14:51'!
on: anObject
	| catcher |
	catcher _ self new.
	catcher instVarNamed: 'realObject' put: anObject! !

!ProtocolCatcher2 class methodsFor: 'services' stamp: 'jmv 11/3/2008 12:51'!
clear
	Protocols _ Dictionary new.
	Started _ false! !

!ProtocolCatcher2 class methodsFor: 'services' stamp: 'jmv 11/3/2008 12:51'!
observedClasses

	^Protocols keys! !

!ProtocolCatcher2 class methodsFor: 'services' stamp: 'jmv 11/3/2008 12:51'!
protocolFor: aClass

	^Protocols at: aClass! !

!ProtocolCatcher2 class methodsFor: 'services' stamp: 'jmv 11/3/2008 12:51'!
start
	Started _ true! !

!ProtocolCatcher2 class methodsFor: 'services' stamp: 'jmv 11/3/2008 12:51'!
stop
	Started _ false! !

