'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 16 October 2008 at 9:01:15 am'!
"Change Set:		PointerExplorer
Date:			29 September 2004
Author:			avi

md: repackaged as a changeset.

A variant on the ObjectExlorer that works 'backwards': like the ObjectExplorer, it shows a tree of objects, but expanding a node won't show the objects which that node references, but rather the objects that reference that node.  Its main use is to track down memory leaks: if you want to know why a particular object is still alive, open a PointerExplorer on it and drill down until you find the root object that's referencing it.  For example, find all the references to the symbol #zot with:

PointerExplorer new openExplorerFor: #zot

For the 'name' of the object, the PointerExplorer shows each object's identityHash, to allow the user to identify when two similar objects are identical and notice cycles."!

!classDefinition: #PointerExplorer category: #'Tools-PointerExplorer'!
ObjectExplorer subclass: #PointerExplorer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-PointerExplorer'!

!PointerExplorer commentStamp: 'avi 8/21/2004 20:01' prior: 0!
A variant on the ObjectExlorer that works "backwards": like the ObjectExplorer, it shows a tree of objects, but expanding a node won't show the objects which that node references, but rather the objects that reference that node.  Its main use is to track down memory leaks: if you want to know why a particular object is still alive, open a PointerExplorer on it and drill down until you find the root object that's referencing it.  For example, find all the references to the symbol #zot with:

PointerExplorer new openExplorerFor: #zot

For the "name" of the object, the PointerExplorer shows each object's identityHash, to allow the user to identify when two similar objects are identical and notice cycles.!

!classDefinition: #PointerExplorerWrapper category: #'Tools-PointerExplorer'!
ObjectExplorerWrapper subclass: #PointerExplorerWrapper
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-PointerExplorer'!

!PointerExplorerWrapper commentStamp: 'avi 8/21/2004 19:58' prior: 0!
A subclass of ObjectExplorerWrapper for use with PointerExplorer.  #contents is overridden to work backwards: it returns wrappers for the objects pointing to item rather than for the objects that item points to.!


!Inspector methodsFor: 'menu commands' stamp: 'avi 2/18/2004 01:31'!
explorePointers
	PointerExplorer new openExplorerFor: self selection! !

!Inspector methodsFor: 'menu commands' stamp: 'jmv 10/15/2008 23:03'!
fieldListMenu: aMenu
	"Arm the supplied menu with items for the field-list of the receiver"

	aMenu addStayUpItemSpecial.

	aMenu addList: #(
		('inspect (i)'						inspectSelection)
		('explore (I)'					exploreSelection)).

	self addCollectionItemsTo: aMenu.

	aMenu addList: #(
		-
		('method refs to this inst var'		referencesToSelection)
		('methods storing into this inst var'	defsOfSelection)
		('objects pointing to this value'		objectReferencesToSelection)
		('chase pointers'						chasePointers)
		('explore pointers'					explorePointers)
		-
		('browse full (b)'						browseMethodFull)
		('browse class'						browseClass)
		('browse hierarchy (h)'				classHierarchy)
		('browse protocol (p)'				browseFullProtocol)
		-
		('inst var refs...'						browseInstVarRefs)
		('inst var defs...'						browseInstVarDefs)
		('class var refs...'					classVarRefs)
		('class variables'						browseClassVariables)
		('class refs (N)'						browseClassRefs)
		-
		('copy name (c)'						copyName)		
		('basic inspect'						inspectBasic)).

	^ aMenu

! !


!ObjectExplorer methodsFor: 'menus' stamp: 'jmv 10/16/2008 08:58'!
explorePointers
	PointerExplorer new openExplorerFor: self object! !

!ObjectExplorer methodsFor: 'menus' stamp: 'jmv 10/16/2008 08:59'!
genericMenu: aMenu 
	"Borrow a menu from my inspector"
	| insideObject menu parentObject |
	currentSelection
		ifNil: [menu _ aMenu.
			menu
				add: '*nothing selected*'
				target: self
				selector: #yourself]
		ifNotNil: [insideObject _ self object.
			parentObject _ self parentObject.
			inspector
				ifNil: [inspector _ Inspector new].
			inspector inspect: parentObject;
				 object: insideObject.
			aMenu defaultTarget: inspector.
			inspector fieldListMenu: aMenu.
			aMenu items
				do: [:i | (#(#inspectSelection #exploreSelection #referencesToSelection #defsOfSelection #objectReferencesToSelection #chasePointers #explorePointers) includes: i selector)
						ifTrue: [i target: self]].
			aMenu addLine;
				add: 'monitor changes'
				target: self
				selector: #monitor:
				argument: currentSelection].
	monitorList isEmptyOrNil
		ifFalse: [aMenu addLine;
				add: 'stop monitoring all'
				target: self
				selector: #stopMonitoring].
	^ aMenu! !


!PointerExplorer methodsFor: 'accessing' stamp: 'ab 8/22/2003 18:51'!
getList
	^Array with: (PointerExplorerWrapper with: rootObject name: rootObject identityHash asString model: self)
! !

!PointerExplorer methodsFor: 'accessing' stamp: 'jmv 10/15/2008 23:06'!
label
	^'References to ', super label! !


!PointerExplorerWrapper methodsFor: 'testing' stamp: 'ab 8/22/2003 18:39'!
hasContents
	^true! !

!PointerExplorerWrapper methodsFor: 'accessing' stamp: 'jmv 10/15/2008 23:01'!
contents
	| objects |
	objects _ Smalltalk pointersTo: item except: (Array with: self with: model).	
	^(objects reject: [:ea | ea class = self class])
		collect: [:ea| self class with: ea name: ea identityHash asString model: item]! !

