Class and Descendants References

It often happens to me that I need to browse the references to a whole
hierarchy instead of to a single Class.
I hacked a little simple package that does just that.  Since it is
very small and I don't have a web page to publish this goodie on, I
copy the source here in case someone wants to use it.

Needs Ian Bartholomew's IDB IDE Extension.pac.  Is not that difficult
to avoid this dependency but I hadn't time to do it, (it was just a
couple of hours of work after all, so please be gentle ;o)

After installing, open a NEW Class Brower, select a class, on the
Class|Browser menu choose 'References to Class or Descendants'

Best regards,
Daniel

| package |
package := Package name: 'IdeExtensions'.
package paxVersion: 0;
        basicComment: ''.


package classNames
        add: #IdeClassAndDescendantsExtension;
        yourself.

package methodNames
        add: #ClassBrowserAbstract -> #classesPresenter;
        add: #ClassSelector -> #browseClassOrDescendantsReferences;
        add: #SmalltalkSystem -> #browseClassOrDescendantsReferences:;
        add: #SmalltalkSystem -> #browseReferencesToClassOrDescendants:;
        add: #SmalltalkSystem -> #referenceFilterForClassOrDescendants:;
        yourself.

package binaryGlobalNames: (Set new
        yourself).

package globalAliases: (Set new
        yourself).

package allResourceNames: (Set new
        yourself).

package setPrerequisites: (IdentitySet new
        add: 'Object Arts\Dolphin\IDE\Base\Development System';
        add: 'Object Arts\Dolphin\Base\Dolphin';
        add: 'Object Arts\Dolphin\MVP\Base\Dolphin MVP Base';
        add: 'Ian Bartholomew\IDE Extensions\IDB IDE Extension';
        yourself).

package!

"Class Definitions"!

IdeExtensionAbstract subclass: #IdeClassAndDescendantsExtension
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        classInstanceVariableNames: ''!

"Global Aliases"!


"Loose Methods"!

!ClassBrowserAbstract methodsFor!

classesPresenter

        ^ classesPresenter! !
!ClassBrowserAbstract categoriesFor: #classesPresenter!accessing!idb
goodies!public! !

!ClassSelector methodsFor!

browseClassOrDescendantsReferences
        "Browse all the methods which refer to the class selected in
        the receiver or its descendants."

        self systemModel browseClassOrDescendantsReferences: self selection!
!
!ClassSelector categoriesFor:
#browseClassOrDescendantsReferences!commands!public! !

!SmalltalkSystem methodsFor!

browseClassOrDescendantsReferences: aClass
        "Opens a new Method Browser on all the methods which refer to aClass
or its descendants"

        (self
                browseMethods: (self referenceFilterForClassOrDescendants: aClass)
                caption: 'References to ', aClass name, ' or its descendants'
                sourceString: aClass name) isEmpty ifTrue: [
                        MessageBox notify: aClass name, ' has no references']!

browseReferencesToClassOrDescendants: aString
        | className suggestion |
        suggestion := aString isEmpty
                                ifTrue: [Clipboard current getTextOrEmpty]
                                ifFalse: [aString].
        className := (Prompter
                                createOn: suggestion
                                prompt: 'Enter the name of a class:'
                                caption: 'Browse References to Class or its descentants...')
                                validationBlock: [:value | (Smalltalk at: value ifAbsent: [ nil ])
isBehavior ];
                                showModal.
        className notNil
                ifTrue: [self browseClassOrDescendantsReferences: (Smalltalk at:
className)]!

referenceFilterForClassOrDescendants: aClass
        "Private - Answer a <monadicValuable> which can be used to filter
methods
        that reference aClass or its descendants"

        | cookie |
        cookie := Object new.
        ^[:m | (m literalsDetect: [:l | l isVariableBinding and: [ l value
isBehavior and: [ l value includesBehavior: aClass ] ] ] ifNone:
[cookie]) ~~ cookie]! !
!SmalltalkSystem categoriesFor:
#browseClassOrDescendantsReferences:!browsing!public! !
!SmalltalkSystem categoriesFor:
#browseReferencesToClassOrDescendants:!browsing!public! !
!SmalltalkSystem categoriesFor:
#referenceFilterForClassOrDescendants:!helpers!private! !

"End of package definition"!

"Source Globals"!

"Classes"!

IdeClassAndDescendantsExtension guid: (GUID fromString:
'{115078A5-C307-4290-B1FE-74C6205D29A6}')!
IdeClassAndDescendantsExtension comment: ''!
!IdeClassAndDescendantsExtension categoriesForClass!IDB Goodies! !
!IdeClassAndDescendantsExtension class methodsFor!

extendedClasses
        ^(Set new)
                add: ClassBrowserShell;
                add: (Smalltalk at: 'SystemBrowserShell' ifAbsent: []);
                yourself!

extendMenuIn: aBrowser
        | menu |

        menu := (aBrowser view menuBar find: 'Class') find: 'Browse'.
        menu
                insertItem: (CommandMenuItem commandDescription:
(ClosedCommandDescription
                                                command: #browseClassOrDescendantsReferences
                                                description: 'References to Class or Descendants'
                                                queryBlock:
                                                        [:query |
                                                        query isEnabled: aBrowser hasClassSelected.
                                                        true]
                                                receiver: aBrowser classesPresenter))
                after: #browseClassReferences.!

onBrowserOpened: aBrowser
        super onBrowserOpened: aBrowser.
        self extendMenuIn: aBrowser

        ! !
!IdeClassAndDescendantsExtension class categoriesFor:
#extendedClasses!accessing!public! !
!IdeClassAndDescendantsExtension class categoriesFor:
#extendMenuIn:!helpers!public! !
!IdeClassAndDescendantsExtension class categoriesFor:
#onBrowserOpened:!event handling!public! !

"Binary Globals"!

"Resources"!