'10/3/99 3:17:13 am'!

'#
# This file is encoded in (so called) SHIFT-JIS,
# line delimitor is CR.
#

Browser Menu Enhancements More
Goodies for VisualWorks 2.5, VisualWorks Non-Commercial 3.0a
Copyleft 1999 NISHIHARA Satoshi

Broken English description

Summary:

This goodies add some items for CategoryMenu, ClassMenu, ProtocolMenu 
and SelectorMenu of a Browser.

CategoryMenu
ClassMenu
ProtocolMenu
	browse
		browse full
		browse class hierarchy
		browse class
		spawn inheritance
	references
		class refs (local)
		used classes
		needed classes
	utilities
		copy name ([category | class | protocol] name)
		check subclass responsibility
		inspect instances
		inspect subinstances

SelectorMenu
	browse
		browse full
		browse class hierarchy
		browse class
		spawn inheritance
	references
		inst var refs...
		class var refs...
		class variables
		class refs
	search
		senders of...
		implementors of...
	utilities
		copy name (selector name)
		check subclass responsibility
		inspect instances
		inspect subinstances


How to install:

FileIn this goodies and makes a class "MoreBrowserMenuEnhancements" in a 
category "Goodies-Misc". 
No addition or Modifying in any system classes.

When you want to restore your image, please remove this class 
"MoreBrowserMenuEnhancements" from your system, simply.
Removing this goodies makes to restore CategoryMenu, ClassMenu, 
ProtocolMenu  and SelectorMenu. Not initialize these Menus.
If you wanna initialize them, evaluate below;

	"Browser flushMenus."


How to use:

When you install this goodies, it adds some menu items to Browser.

----------------------------------------------------------
�������m (NISHIHARA Satoshi)
e-mail: mailto:nishis@zephyr.dti.ne.jp
URL:    http://www.zephyr.dti.ne.jp/~nishis/
----------------------------------------------------------
'!

Object subclass: #MoreBrowserMenuEnhancements
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Goodies-Misc'!


Object subclass: #MoreBrowserMenuEnhancements
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Goodies-Misc'!
MoreBrowserMenuEnhancements comment:
'#
# This file is encoded in (so called) SHIFT-JIS,
# line delimitor is CR.
#

Browser Menu Enhancements More
Goodies for VisualWorks 2.5, VisualWorks Non-Commercial 3.0a
Copyleft 1999 NISHIHARA Satoshi

Broken English description

Summary:

This goodies add some items for CategoryMenu, ClassMenu, ProtocolMenu 
and SelectorMenu of a Browser.

CategoryMenu
ClassMenu
ProtocolMenu
	browse
		browse full
		browse class hierarchy
		browse class
		spawn inheritance
	references
		class refs (local)
		used classes
		needed classes
	utilities
		copy name ([category | class | protocol] name)
		check subclass responsibility
		inspect instances
		inspect subinstances

SelectorMenu
	browse
		browse full
		browse class hierarchy
		browse class
		spawn inheritance
	references
		inst var refs...
		class var refs...
		class variables
		class refs
	search
		senders of...
		implementors of...
	utilities
		copy name (selector name)
		check subclass responsibility
		inspect instances
		inspect subinstances


How to install:

FileIn this goodies and makes a class "MoreBrowserMenuEnhancements" in a 
category "Goodies-Misc". 
No addition or Modifying in any system classes.

When you want to restore your image, please remove this class 
"MoreBrowserMenuEnhancements" from your system, simply.
Removing this goodies makes to restore CategoryMenu, ClassMenu, 
ProtocolMenu  and SelectorMenu. Not initialize these Menus.
If you wanna initialize them, evaluate below;

	"Browser flushMenus."


How to use:

When you install this goodies, it adds some menu items to Browser.

----------------------------------------------------------
�������m (NISHIHARA Satoshi)
e-mail: mailto:nishis@zephyr.dti.ne.jp
URL:    http://www.zephyr.dti.ne.jp/~nishis/
----------------------------------------------------------
'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

MoreBrowserMenuEnhancements class
	instanceVariableNames: 'categoryMenu classMenu protocolMenu messageMenu '!


!MoreBrowserMenuEnhancements class methodsFor: 'copyright'!

copyright
	^'Copyleft 1999 NISHIHARA Satoshi.'!

system
	^'Goodies'!

version
	^'001'! !

!MoreBrowserMenuEnhancements class methodsFor: 'class initialization'!

induct
	"MoreBrowserMenuEnhancements induct."
	"Browser flushMenus."

	| aMenu |
	categoryMenu isNil 
		ifTrue: 
			[aMenu := Browser classPool at: #CategoryMenu ifAbsent: [nil].
			aMenu isNil ifTrue: [^self].
			categoryMenu := aMenu copy.
			self enhanceCategoryMenu].
	classMenu isNil 
		ifTrue: 
			[aMenu := Browser classPool at: #ClassMenu ifAbsent: [nil].
			aMenu isNil ifTrue: [^self].
			classMenu := aMenu copy.
			self enhanceClassMenu].
	protocolMenu isNil 
		ifTrue: 
			[aMenu := Browser classPool at: #ProtocolMenu ifAbsent: [nil].
			aMenu isNil ifTrue: [^self].
			protocolMenu := aMenu copy.
			self enhanceProtocolMenu].
	messageMenu isNil 
		ifTrue: 
			[aMenu := Browser classPool at: #MessageMenu ifAbsent: [nil].
			aMenu isNil ifTrue: [^self].
			messageMenu := aMenu copy.
			self enhanceSelectorMenu]!

initialize
	"MoreBrowserMenuEnhancements initialize."

	"self induct"!

install
	"MoreBrowserMenuEnhancements install."

	| default done process count |
	Cursor normal show.
	default := false.
	done := false.
	process := 
			[default := Dialog confirm: 'Do you want to enhance more the browser menu?' initialAnswer: default.
			default ifTrue: [self induct].
			done := true] newProcess.
	process priority: Processor activeProcess priority + 0.
	process resume.
	count := 0.
	[done not and: [count < 10]]
		whileTrue: 
			[count := count + 1.
			(Delay forSeconds: 1) wait].
	process terminate.
	done ifFalse: [default ifTrue: [self induct]]!

obsolete
	self uninduct.
	super obsolete!

uninduct
	"MoreBrowserMenuEnhancements uninduct."
	"Browser flushMenus."

	| menu |
	categoryMenu notNil 
		ifTrue: 
			[menu := Browser classPool at: #CategoryMenu ifAbsent: [nil].
			menu notNil ifTrue: [Browser classPool at: #CategoryMenu put: categoryMenu copy]].
	classMenu notNil 
		ifTrue: 
			[menu := Browser classPool at: #ClassMenu ifAbsent: [nil].
			menu notNil ifTrue: [Browser classPool at: #ClassMenu put: classMenu copy]].
	protocolMenu notNil 
		ifTrue: 
			[menu := Browser classPool at: #ProtocolMenu ifAbsent: [nil].
			menu notNil ifTrue: [Browser classPool at: #ProtocolMenu put: protocolMenu copy]].
	messageMenu notNil 
		ifTrue: 
			[menu := Browser classPool at: #MessageMenu ifAbsent: [nil].
			menu notNil ifTrue: [Browser classPool at: #MessageMenu put: messageMenu copy]].
	categoryMenu := nil.
	classMenu := nil.
	protocolMenu := nil.
	messageMenu := nil!

uninstall
	"MoreBrowserMenuEnhancements uninstall."

	self uninduct! !

!MoreBrowserMenuEnhancements class methodsFor: 'menu enhancements'!

enhanceCategoryMenu
	"MoreBrowserMenuEnhancements enhanceCategoryMenu."

	| menu menuItemGroup |
	menu := Browser classPool at: #CategoryMenu ifAbsent: [nil].
	menu isNil
		ifTrue: 
			[Object messageNotUnderstoodSignal
				handle: 
					[:exception | 
					| browser |
					browser := Browser new.
					browser category: #'Kernel-Objects'.
					browser className: #Object.
					browser meta: false.
					browser protocol: #accessing.
					browser selector: #at:.
					menu := browser categoryMenu]
				do: [menu := Browser messagePopUpMenu].
			Browser classPool at: #CategoryMenu put: menu].
	(menu menuItemLabeled: 'references' ifNone: [nil]) notNil ifTrue: [^menu].
	menuItemGroup := OrderedCollection new 
		add: ((MenuItem labeled: 'browse') submenu: self browseMenu);
		add: ((MenuItem labeled: 'references') submenu: self classReferenceMenu);
		add: ((MenuItem labeled: 'utilities') submenu: self utilitiesMenu);
		asArray.
	menu addItemGroup: menuItemGroup.
	^menu!

enhanceClassMenu
	"MoreBrowserMenuEnhancements enhanceClassMenu."

	| menu menuItemGroup |
	menu := Browser classPool at: #ClassMenu ifAbsent: [nil].
	menu isNil
		ifTrue: 
			[Object messageNotUnderstoodSignal
				handle: 
					[:exception | 
					| browser |
					browser := Browser new.
					browser category: #'Kernel-Objects'.
					browser className: #Object.
					browser meta: false.
					browser protocol: #accessing.
					browser selector: #at:.
					menu := browser classMenu]
				do: [menu := Browser messagePopUpMenu].
			Browser classPool at: #ClassMenu put: menu].
	(menu menuItemLabeled: 'references' ifNone: [nil]) notNil ifTrue: [^menu].
	menuItemGroup := OrderedCollection new 
		add: ((MenuItem labeled: 'browse') submenu: self browseMenu);
		add: ((MenuItem labeled: 'references') submenu: self classReferenceMenu);
		add: ((MenuItem labeled: 'utilities') submenu: self utilitiesMenu);
		asArray.
	menu addItemGroup: menuItemGroup.
	^menu!

enhanceProtocolMenu
	"MoreBrowserMenuEnhancements enhanceProtocolMenu."

	| menu menuItemGroup |
	menu := Browser classPool at: #ProtocolMenu ifAbsent: [nil].
	menu isNil
		ifTrue: 
			[Object messageNotUnderstoodSignal
				handle: 
					[:exception | 
					| browser |
					browser := Browser new.
					browser category: #'Kernel-Objects'.
					browser className: #Object.
					browser meta: false.
					browser protocol: #accessing.
					browser selector: #at:.
					menu := browser protocolMenu]
				do: [menu := Browser messagePopUpMenu].
			Browser classPool at: #ProtocolMenu put: menu].
	(menu menuItemLabeled: 'references' ifNone: [nil]) notNil ifTrue: [^menu].
	menuItemGroup := OrderedCollection new 
		add: ((MenuItem labeled: 'browse') submenu: self browseMenu);
		add: ((MenuItem labeled: 'references') submenu: self classReferenceMenu);
		add: ((MenuItem labeled: 'utilities') submenu: self utilitiesMenu);
		asArray.
	menu addItemGroup: menuItemGroup.
	^menu!

enhanceSelectorMenu
	"MoreBrowserMenuEnhancements enhanceClassMenu."

	| menu menuItemGroup |
	menu := Browser classPool at: #MessageMenu ifAbsent: [nil].
	menu isNil
		ifTrue: 
			[Object messageNotUnderstoodSignal
				handle: 
					[:exception | 
					| browser |
					browser := Browser new.
					browser category: #'Kernel-Objects'.
					browser className: #Object.
					browser meta: false.
					browser protocol: #accessing.
					browser selector: #at:.
					menu := browser selectorMenu]
				do: [menu := Browser messagePopUpMenu].
			Browser classPool at: #MessageMenu put: menu].
	(menu menuItemLabeled: 'references' ifNone: [nil]) notNil ifTrue: [^menu].
	menuItemGroup := OrderedCollection new 
		add: ((MenuItem labeled: 'browse') submenu: self browseMenu);
		add: ((MenuItem labeled: 'references') submenu: self referenceMenu);
		add: ((MenuItem labeled: 'search') submenu: self sendersAndImplementorsMenu);
		add: ((MenuItem labeled: 'utilities') submenu: self utilitiesMenu);
		asArray.
	menu addItemGroup: menuItemGroup.
	^menu! !

!MoreBrowserMenuEnhancements class methodsFor: 'menu messages'!

browseClassHierarchy: aController 
	| aBrowser hierarchyBrowser |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^self].
	(self classFromController: aController) isNil ifTrue: [^self].
	"aBrowser spawnHierarchy."
	hierarchyBrowser := aBrowser class spawnedHierarchyBrowserClass new onClass: aBrowser nonMetaClass.
	hierarchyBrowser class openCategoryBrowserOn: hierarchyBrowser withTextState: nil.
	hierarchyBrowser setLabel.
	hierarchyBrowser classList selection: hierarchyBrowser classList selection.
	hierarchyBrowser protocolList selection: aBrowser protocol copy.
	hierarchyBrowser selectorList selection: aBrowser selector copy!

browseClassReferencesLocal: aController
	| aClass |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	self browseReferencesOf: aClass name for: aClass!

browseClassRefs: aController 
	| aBrowser |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^self].
	aBrowser browseClassReferences!

browseClassVariables: aController 
	| aClass classVariables |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	classVariables := aClass classPool.
	classVariables isEmpty 
		ifTrue: [^Dialog warn: 'No Class Variables.']
		ifFalse: [classVariables inspect]!

browseClassVarRefs: aController 
	| aBrowser |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^self].
	aBrowser browseClassVariables!

browseFull: aController 
	| aBrowser newBrowser category |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^Browser new open].
	newBrowser := Browser new.
	newBrowser meta: aBrowser meta copy.
	newBrowser open.
	category := aBrowser category.
	(category isNil or: [category isEmpty]) ifTrue: [category := (Smalltalk at: aBrowser className) category].
	newBrowser categoryList selection: category.
	newBrowser classList selection: aBrowser className copy.
	newBrowser protocolList selection: aBrowser protocol copy.
	newBrowser selectorList selection: aBrowser selector copy!

browseImplementorsOf: aController 
	| aBrowser messages message |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^self].
	aBrowser selector notNil ifFalse: [^self].
	messages := OrderedCollection new.
	messages add: aBrowser selector.
	messages addAll: (aBrowser classForSelectedMethod compiledMethodAt: aBrowser selector) allSymbolLiterals asSortedCollection.
	messages isEmpty ifTrue: [^Dialog warn: 'No messages.'].
	message := Dialog
				choose: 'implementors of...'
				fromList: (messages collect: [:sel | sel contractTo: 40])
				values: messages
				lines: 20
				cancel: [nil].
	message == nil ifFalse: [aBrowser class browseAllImplementorsOf: message]!

browseInstVarRefs: aController 
	| aBrowser |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^self].
	aBrowser browseFieldReferences!

browseNeededClasses: aController 
	| neededClassNames aClass target |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	neededClassNames := self neededClassNamesOf: aClass name.
	neededClassNames isEmpty 
		ifTrue: 
			[Dialog warn: 'Nobody need: ' , aClass name.
			^nil].
	target := Dialog
				choose: 'Which of these classes do you browse?\needed classes: ' withCRs , aClass name
				fromList: neededClassNames
				values: neededClassNames
				lines: 10
				cancel: [nil].
	target isNil ifTrue: [^self].
	self browseClass: target!

browseSendersOf: aController 
	| aBrowser messages message |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^self].
	aBrowser selector notNil ifFalse: [^self].
	messages := OrderedCollection new.
	messages add: aBrowser selector.
	messages addAll: (aBrowser classForSelectedMethod compiledMethodAt: aBrowser selector) allSymbolLiterals asSortedCollection.
	messages isEmpty ifTrue: [^Dialog warn: 'No messages.'].
	message := Dialog
				choose: 'senders of...'
				fromList: (messages collect: [:sel | sel contractTo: 40])
				values: messages
				lines: 20
				cancel: [nil].
	message == nil ifFalse: [aBrowser class browseAllSendersOf: message]!

browseThisClass: aController 
	| aClass |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	(aClass browse) inspect!

browseUsedClasses: aController 
	| aClass usedClassNames target |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	usedClassNames := self usedClassNamesOf: aClass name.
	usedClassNames isEmpty
		ifTrue: 
			[Dialog warn: 'Nobody used: ' , aClass name.
			^nil].
	target := Dialog
				choose: 'Which of these classes do you browse?\used classes: ' withCRs , aClass name
				fromList: usedClassNames
				values: usedClassNames
				lines: 10
				cancel: [nil].
	target isNil ifTrue: [^self].
	self browseClass: target!

checkSubclassResponsibility: aController 
	| methodList checkBlock checkClass |
	(checkClass := self classFromController: aController) isNil ifTrue: [^self].
	checkClass name isNil ifTrue: [^nil].
	methodList := OrderedCollection new.
	checkBlock := 
			[:theClass | 
			| collection method messages boolean |
			collection := SortedCollection new.
			theClass allSuperclasses do: [:aClass | aClass selectors do: 
					[:symbol | 
					method := aClass compiledMethodAt: symbol.
					messages := method messages.
					(messages includes: #subclassResponsibility)
						ifTrue: [collection add: symbol -> aClass]]].
			collection do: 
				[:assoc | 
				messages := Set new.
				boolean := true.
				theClass withAllSuperclasses do: 
					[:aClass | 
					assoc value = aClass ifTrue: [boolean := false].
					boolean ifTrue: [messages addAll: aClass selectors]].
				(messages includes: assoc key)
					ifFalse: [methodList add: assoc value printString , ' ' , assoc key]]].
	Cursor wait
		showWhile: 
			[checkBlock value: checkClass.
			checkBlock value: checkClass class].
	methodList isEmpty
		ifTrue: [Transcript cr; show: 'Okay']
		ifFalse: [Browser listBrowserClass
				openListBrowserOn: methodList
				label: 'Check #subclassResponsibility'
				initialSelection: nil]!

copyName: aController 
	| aClass menuHolderSymbol menuHolderSymbols |

	menuHolderSymbols := IdentityDictionary new.
	menuHolderSymbols add: #categoryMenuHolder -> #copyCategoryName:;
			add: #classMenuHolder -> #copyClassName:; 
			add: #protocolMenuHolder -> #copyProtocolName:; 
			add:#selectorMenuHolder -> #copySelectorName:.
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	aClass name isNil ifTrue: [^nil].
	menuHolderSymbol := aController menuHolder method homeMethod who at:2.
	(menuHolderSymbols keys includes: menuHolderSymbol) 
		ifFalse: [^self].
	self perform: (menuHolderSymbols at: menuHolderSymbol) with: aController performer.
	self debug: ParagraphEditor currentSelection!

inspectInstances: aController 
	| aClass allInstances |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	Cursor wait showWhile: 
		[allInstances := aClass allInstances].
	self allInstances isEmpty ifTrue: [^Dialog warn: 'There are no instances of ', aClass name].
	allInstances asArray inspect!

inspectSubinstances: aController 
	| aClass allInstances |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	allInstances := OrderedCollection new.
	Cursor wait showWhile: 
		[aClass withAllSubclasses 
			do: 
				[:subClass | 
				subClass allInstances 
					do: [:instance | allInstances add: instance]]].
	allInstances isEmpty ifTrue: [^Dialog warn: 'There are no instances of ', aClass name].
	allInstances asArray inspect!

spawnInheritance: aController 
	| aClass anInheritanceBrowserClass |
	(aClass := self classFromController: aController) isNil ifTrue: [^self].
	anInheritanceBrowserClass := Smalltalk at: #TreeBrowser ifAbsent: [HierarchyBrowser].
	^anInheritanceBrowserClass newOnClass: aClass! !

!MoreBrowserMenuEnhancements class methodsFor: 'saving'!

save
	"MoreBrowserMenuEnhancements save."

	| encodingName fileName classCollection aStream |
	encodingName := #default.
	fileName := 'BrMenEn2.st'.
	classCollection := self saveClasses.
	aStream := (fileName asFilename withEncoding: encodingName) writeStream.
	[Cursor write
		showWhile: 
			[| timeStamp |
			timeStamp := Date today shortPrintString , ' ' , Time now shortPrintString.
			aStream cr.
			aStream nextChunkPut: timeStamp printString.
			aStream cr; cr.
			(self comment isNil or: [self comment isEmpty])
				ifFalse: 
					[aStream nextChunkPut: self comment printString.
					aStream cr; cr].
			classCollection
				do: 
					[:aClass | 
					aStream nextChunkPut: aClass definition.
					aStream cr; cr].
			classCollection
				do: 
					[:aClass | 
					| sourceCodeStream |
					aStream nextPut: Character newPage.
					aStream cr.
					sourceCodeStream := SourceCodeStream on: aStream.
					aClass fileOutSourceOn: sourceCodeStream.
					aStream cr]]]
		valueNowOrOnUnwindDo: [aStream close].
	^classCollection!

saveClasses
	"MoreBrowserMenuEnhancements saveClasses."

	| patternCollection classCollection |
	patternCollection := #('*MoreBrowserMenuEnhancements*').
	classCollection := Smalltalk organization superclassOrder: self category.
	classCollection := classCollection
				select: 
					[:aClass | 
					| string something |
					string := aClass name asString.
					something := patternCollection detect: [:it | it match: string]
								ifNone: [nil].
					something notNil].
	^classCollection! !

!MoreBrowserMenuEnhancements class methodsFor: 'private menu'!

browseMenu
	| menu labels values |
	menu := Menu new.
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: 'browse full'.
	values add: [:controller | self browseFull: controller].
	labels add: 'browse class hierarchy'.
	values add: [:controller | self browseClassHierarchy: controller].
	labels add: 'browse class'.
	values add: [:controller | self browseThisClass: controller].
	labels add: 'spawn inheritance'.
	values add: [:controller | self spawnInheritance: controller].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu!

classReferenceMenu
	| menu labels values |
	menu := Menu new.
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: 'class refs (local)'.
	values add: [:controller | self browseClassReferencesLocal: controller].
	labels add: 'used classes'.
	values add: [:controller | self browseUsedClasses: controller].
	labels add: 'needed classes'.
	values add: [:controller | self browseNeededClasses: controller].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu!

referenceMenu
	| menu labels values |
	menu := Menu new.
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: 'inst var refs...'.
	values add: [:controller | self browseInstVarRefs: controller].
	labels add: 'class var refs...'.
	values add: [:controller | self browseClassVarRefs: controller].
	labels add: 'class variables'.
	values add: [:controller | self browseClassVariables: controller].
	labels add: 'class refs'.
	values add: [:controller | self browseClassRefs: controller].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu!

sendersAndImplementorsMenu
	| menu labels values |
	menu := Menu new.
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: 'senders of...'.
	values add: [:controller | self browseSendersOf: controller].
	labels add: 'implementors of...'.
	values add: [:controller | self browseImplementorsOf: controller].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu!

utilitiesMenu
	| menu labels values |
	menu := Menu new.
	labels := OrderedCollection new.
	values := OrderedCollection new.
	labels add: 'copy name'.
	values add: [:controller | self copyName: controller].
	labels add: 'check subclass responsibility'.
	values add: [:controller | self checkSubclassResponsibility: controller].
	labels add: 'inspect instances'.
	values add: [:controller | self inspectInstances: controller].
	labels add: 'inspect subinstances'.
	values add: [:controller | self inspectSubinstances: controller].
	menu addItemGroupLabels: labels asArray values: values asArray.
	^menu! !

!MoreBrowserMenuEnhancements class methodsFor: 'private'!

browseClass: argument 
	| target browser |
	argument isBehavior
		ifTrue: [argument isMeta
				ifTrue: [target := argument soleInstance]
				ifFalse: [target := argument]]
		ifFalse: 
			[target := Smalltalk at: argument asSymbol ifAbsent: [nil].
			target isNil ifTrue: [^nil]].
	browser := Browser new onClass: target.
	HierarchyBrowser openHierarchyBrowserFrom: browser.
	^target!

browseReferencesOf: globalSymbol for: aClass 
	| collection classes rootClass |
	aClass isMeta
		ifTrue: [rootClass := aClass soleInstance]
		ifFalse: [rootClass := aClass].
	collection := Set new.
	Cursor execute
		showWhile: 
			[classes := rootClass withAllSuperclasses reverse , rootClass allSubclasses.
			classes do: [:theClass | (theClass whichSelectorsReferTo: (Smalltalk associationAt: globalSymbol))
					do: [:selector | (selector = #DoIt or: [selector = #DoItIn:])
							ifFalse: [collection add: theClass name asString , ' ' , selector asString]]].
			classes := rootClass class withAllSuperclasses reverse , rootClass class allSubclasses.
			classes do: [:theClass | (theClass whichSelectorsReferTo: (Smalltalk associationAt: globalSymbol))
					do: [:selector | (selector = #DoIt or: [selector = #DoItIn:])
							ifFalse: [collection add: theClass name asString , ' ' , selector asString]]]].
	Browser listBrowserClass
		openListBrowserOn: collection
		label: 'Users of ' , globalSymbol asString , ' (local)'
		initialSelection: globalSymbol asString!

browserFromController: aController 
	| aBrowser |
	"aBrowser := aController view topComponent model."
	aBrowser := aController performer.
	(aBrowser isKindOf: Browser)
		ifFalse: [^nil].
	^aBrowser!

classFromController: aController 
	| aBrowser aClass |
	(aBrowser := self browserFromController: aController) isNil ifTrue: [^nil].
	aClass := Smalltalk at: aBrowser className ifAbsent: [nil].
	aClass isNil ifTrue: [^nil].
	aClass isMeta ifTrue: [aClass := aClass class].
	^aClass!

classReferences: classNames 
	"MoreBrowserMenuEnhancements classReferences: #(#Browser)."
	"MoreBrowserMenuEnhancements classReferences: #(#Inspector #Array)."

	| dictionary theClass references addBlock referenceBlock collection |
	dictionary := Dictionary new.
	classNames
		do: 
			[:className | 
			theClass := Smalltalk at: className ifAbsent: [nil].
			((theClass notNil and: [theClass isBehavior])
				and: [theClass isMeta not])
				ifTrue: 
					[references := Set new.
					referenceBlock := [:aClass | aClass selectors
								do: 
									[:selector | 
									addBlock := [:literals | literals do: [:literal | literal isVariableBinding
													ifTrue: [(((literal key isKindOf: Symbol)
															and: [literal value isBehavior and: [literal value isMeta not]])
															and: [literal key = literal value name & className ~= literal key])
															ifTrue: [references add: literal key]]
													ifFalse: 
														[(literal isKindOf: CompiledCode)
															ifTrue: [addBlock value: literal literals].
														(literal isKindOf: BlockClosure)
															ifTrue: [addBlock value: literal method literals]]]].
									addBlock value: (aClass compiledMethodAt: selector) literals]].
					referenceBlock value: theClass.
					referenceBlock value: theClass class.
					dictionary at: className put: references asArray]].
	collection := SortedCollection new.
	dictionary associationsDo: [:assoc | collection add: assoc].
	^collection asArray!

copyCategoryName: aBrowser
	ParagraphEditor copySelection: aBrowser category asString asText!

copyClassName: aBrowser
	ParagraphEditor copySelection: aBrowser className asString asText!

copyProtocolName: aBrowser
	ParagraphEditor copySelection: aBrowser protocol asString asText!

copySelectorName: aBrowser
	ParagraphEditor copySelection: aBrowser selector asString asText!

debug: anObject
	"Transcript cr; show: anObject printString"!

neededClassesOf: className scope: scopeClassNames into: neededClassNames 
	"MoreBrowserMenuEnhancements 
	neededClassesOf: #MoreBrowserMenuEnhancements 
	scope: MeiSystem meiSystemClassNames 
	into: Set new."

	| references |
	references := (self classReferences: (Array with: className)) first value asOrderedCollection.
	references addAll: ((Smalltalk at: className) allSuperclasses collect: [:each | each name]).
	references := references select: [:each | scopeClassNames includes: each].
	references := references select: [:each | (neededClassNames includes: each) not].
	references do: [:each | neededClassNames add: each].
	references do: [:each | self
			neededClassesOf: each
			scope: scopeClassNames
			into: neededClassNames].
	^neededClassNames!

neededClassNamesOf: className 
	"MoreBrowserMenuEnhancements neededClassNamesOf: #Class."
	"MoreBrowserMenuEnhancements neededClassNamesOf: #MoreBrowserMenuEnhancements."
	"MoreBrowserMenuEnhancements neededClassNamesOf: #Object."

	| references scopeClassNames neededClassNames |
	scopeClassNames := OrderedCollection new.
	neededClassNames := Set new.
	Smalltalk allBehaviorsDo: [:each | each isMeta not ifTrue: [scopeClassNames add: each name]].
	Cursor wait showWhile: [references := self neededClassesOf: className scope: scopeClassNames asSet into: neededClassNames].
	^references asSortedCollection asArray!

usedClassNamesOf: className 
	"MoreBrowserMenuEnhancements usedClassNamesOf: #Class."

	| usedClassNames |
	Cursor wait showWhile: [usedClassNames := (self classReferences: (Array with: className asSymbol)) first value].
	^usedClassNames asSortedCollection asArray! !

MoreBrowserMenuEnhancements initialize!