[Pkg] Squeak3.11 Contributions: Kernel-Tracer-kph.1.mcz

[squeak-dev-noreply at lists.squeakfoundation.org]

A new version of Kernel-Tracer was added to project Squeak3.11 Contributions:
http://www.squeaksource.com/311/Kernel-Tracer-kph.1.mcz

==================== Summary ====================

Name: Kernel-Tracer-kph.1
Author: kph
Time: 8 December 2008, 12:30:24 am
UUID: 12eef5b0-ecd9-42a9-9adf-83003c80bf34
Ancestors: 

Separated out from Kernel-Objects
Available here for reloading

==================== Snapshot ====================

SystemOrganization addCategory: #'Kernel-Tracer'!

nil subclass: #ObjectTracer
	instanceVariableNames: 'tracedObject recursionFlag'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Kernel-Tracer'!

!ObjectTracer commentStamp: '<historical>' prior: 0!
An ObjectTracer can be wrapped around another object, and then give you a chance to inspect it whenever it receives messages from the outside.  For instance...
	(ObjectTracer on: Display) flash: (50 at 50 extent: 50 at 50)
will give control to a debugger just before the message flash is sent.
Obviously this facility can be embellished in many useful ways.
See also the even more perverse subclass, ObjectViewer, and its example.
!

----- Method: ObjectTracer class>>on: (in category 'instance creation') -----
on: anObject
	^ self new xxxViewedObject: anObject!

----- Method: ObjectTracer>>doesNotUnderstand: (in category 'very few messages') -----
doesNotUnderstand: aMessage 
	"All external messages (those not caused by the re-send) get trapped here"
	"Present a dubugger before proceeding to re-send the message"

	ToolSet debugContext: thisContext
				label: 'About to perform: ', aMessage selector
				contents: nil.
	^ aMessage sentTo: tracedObject.
!

----- Method: ObjectTracer>>xxxUnTrace (in category 'very few messages') -----
xxxUnTrace

	tracedObject become: self!

----- Method: ObjectTracer>>xxxViewedObject (in category 'very few messages') -----
xxxViewedObject
	"This message name must not clash with any other (natch)."
	^ tracedObject!

----- Method: ObjectTracer>>xxxViewedObject: (in category 'very few messages') -----
xxxViewedObject: anObject
	"This message name must not clash with any other (natch)."
	tracedObject _ anObject!

ObjectTracer subclass: #ObjectViewer
	instanceVariableNames: 'valueBlock lastValue changeBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Kernel-Tracer'!

!ObjectViewer commentStamp: '<historical>' prior: 0!
ObjectViewers offers the same kind of interception of messages (via doesnotUnderstand:) as ObjectTracers, but instead of just being wrappers, they actually replace the object being viewed.  This makes them a lot more dangerous to use, but one can do amazing things.  For instance, the example below actually intercepts the InputSensor object, and prints the mouse coordinates asynchronously, every time they change:
	Sensor evaluate: [Sensor cursorPoint printString displayAt: 0 at 0]
		wheneverChangeIn: [Sensor cursorPoint].
To exit from this example, execute:
	Sensor xxxUnTrace
!

----- Method: ObjectViewer class>>on:evaluate:wheneverChangeIn: (in category 'instance creation') -----
on: viewedObject evaluate: block1 wheneverChangeIn: block2
	^ self new xxxViewedObject: viewedObject evaluate: block1 wheneverChangeIn: block2!

----- Method: ObjectViewer>>doesNotUnderstand: (in category 'very few messages') -----
doesNotUnderstand: aMessage 
	"Check for change after sending aMessage"
	| returnValue newValue |
	recursionFlag ifTrue: [^ aMessage sentTo: tracedObject].
	recursionFlag _ true.
	returnValue _ aMessage sentTo: tracedObject.
	newValue _ valueBlock value.
	newValue = lastValue ifFalse:
		[changeBlock value.
		lastValue _ newValue].
	recursionFlag _ false.
	^ returnValue!

----- Method: ObjectViewer>>xxxViewedObject:evaluate:wheneverChangeIn: (in category 'very few messages') -----
xxxViewedObject: viewedObject evaluate: block1 wheneverChangeIn: block2
	"This message name must not clash with any other (natch)."
	tracedObject _ viewedObject.
	valueBlock _ block2.
	changeBlock _ block1.
	recursionFlag _ false!

----- Method: Object>>evaluate:wheneverChangeIn: (in category '*kernel-tracer') -----
evaluate: actionBlock wheneverChangeIn: aspectBlock
	| viewerThenObject objectThenViewer |
	objectThenViewer _ self.
	viewerThenObject _ ObjectViewer on: objectThenViewer.
	objectThenViewer become: viewerThenObject.
	"--- Then ---"
	objectThenViewer xxxViewedObject: viewerThenObject
			evaluate: actionBlock
			wheneverChangeIn: aspectBlock!