diff --git a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowLocalImplementorsCommand.class.st b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowLocalImplementorsCommand.class.st index 87373b41523..55a008b9988 100644 --- a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowLocalImplementorsCommand.class.st +++ b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowLocalImplementorsCommand.class.st @@ -48,17 +48,6 @@ ClyShowLocalImplementorsCommand >> createQueryScope [ ^scope ] -{ #category : 'execution' } -ClyShowLocalImplementorsCommand >> execute [ - - | selectors query | - selectors := methods collect: [ :each | each selector]. - - query := ClyMessageImplementorsQuery ofAny: selectors from: self createQueryScope. - browser spawnQueryBrowserOn: query withState: [:queryBrowser | - self selectMethodsIn: queryBrowser ] -] - { #category : 'execution' } ClyShowLocalImplementorsCommand >> prepareFullExecutionInContext: aToolContext [ super prepareFullExecutionInContext: aToolContext. diff --git a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowMethodInheritanceCommand.class.st b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowMethodInheritanceCommand.class.st index 47ce0caec1b..012aaa1a684 100644 --- a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowMethodInheritanceCommand.class.st +++ b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowMethodInheritanceCommand.class.st @@ -43,6 +43,15 @@ ClyShowMethodInheritanceCommand >> description [ ^ 'Show all method implementors in full hierarchy of selected method classes.' ] +{ #category : 'execution' } +ClyShowMethodInheritanceCommand >> execute [ + + (Smalltalk tools toolNamed: #messageList) + browseOverridenAndOverridingMethodsFrom: methods first + inScope: browser defaultNavigationScope asRBEnvironment + +] + { #category : 'execution' } ClyShowMethodInheritanceCommand >> selectMethodsIn: aQueryBrowser [ diff --git a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverriddenMethodsCommand.class.st b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverriddenMethodsCommand.class.st index aab8fd3efde..bee1965c9a6 100644 --- a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverriddenMethodsCommand.class.st +++ b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverriddenMethodsCommand.class.st @@ -26,6 +26,15 @@ ClyShowOverriddenMethodsCommand >> defaultMenuItemName [ ^'Overridden methods' ] +{ #category : 'execution' } +ClyShowOverriddenMethodsCommand >> execute [ + + (Smalltalk tools toolNamed: #messageList) + browseOverridenMethodsFrom: methods first + inScope: browser defaultNavigationScope asRBEnvironment + +] + { #category : 'execution' } ClyShowOverriddenMethodsCommand >> selectMethodsIn: aQueryBrowser [ diff --git a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverridingMethodsCommand.class.st b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverridingMethodsCommand.class.st index f530f5f86e4..b44dd228000 100644 --- a/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverridingMethodsCommand.class.st +++ b/src/Calypso-SystemPlugins-InheritanceAnalysis-Browser/ClyShowOverridingMethodsCommand.class.st @@ -25,3 +25,12 @@ ClyShowOverridingMethodsCommand >> defaultMenuIconName [ ClyShowOverridingMethodsCommand >> defaultMenuItemName [ ^'Overriding methods' ] + +{ #category : 'execution' } +ClyShowOverridingMethodsCommand >> execute [ + + (Smalltalk tools toolNamed: #messageList) + browseOverridingMethodsFrom: methods first + inScope: browser defaultNavigationScope asRBEnvironment + +] diff --git a/src/Calypso-SystemTools-OldToolCompatibillity/ClyOldMessageBrowserAdapter.class.st b/src/Calypso-SystemTools-OldToolCompatibillity/ClyOldMessageBrowserAdapter.class.st index ace8a0ccc2c..e08fac625d5 100644 --- a/src/Calypso-SystemTools-OldToolCompatibillity/ClyOldMessageBrowserAdapter.class.st +++ b/src/Calypso-SystemTools-OldToolCompatibillity/ClyOldMessageBrowserAdapter.class.st @@ -93,7 +93,7 @@ ClyOldMessageBrowserAdapter class >> on: aNavigationEnvironment systemScope: aSy { #category : 'tools registration' } ClyOldMessageBrowserAdapter class >> registerToolsOn: registry [ - registry register: self as: #messageList + "registry register: self as: #messageList" ] { #category : 'accessing' } diff --git a/src/Calypso-SystemTools-QueryBrowser/ClyBrowserMorph.extension.st b/src/Calypso-SystemTools-QueryBrowser/ClyBrowserMorph.extension.st index c9549567389..1aacbb91a07 100644 --- a/src/Calypso-SystemTools-QueryBrowser/ClyBrowserMorph.extension.st +++ b/src/Calypso-SystemTools-QueryBrowser/ClyBrowserMorph.extension.st @@ -18,7 +18,9 @@ ClyBrowserMorph >> browseImplementorsOf: aSymbol inNameResolver: aNameResolver [ browser selectClass: classToBrowse]. ^ #NormalBrowseClass ] ] ]. - self spawnQueryBrowserOn: (ClyMessageImplementorsQuery of: aSymbol). + ((Smalltalk tools toolNamed: #messageList) + browseImplementorsOf: aSymbol + inScope: self defaultNavigationScope asRBEnvironment ). ^ #NormalImplementorBrowse ] @@ -41,9 +43,15 @@ ClyBrowserMorph >> browseReferencesTo: aSymbol [ ClyBrowserMorph >> browseReferencesTo: aSymbol inNameResolver: anEnvironment [ aSymbol isSymbol and: [ - ^ aSymbol first isUppercase - ifTrue: [ self browseUppercasedReferencesTo: aSymbol inNameRespolver: anEnvironment ] - ifFalse: [ self browseLowercasedReferencesTo: aSymbol inNameResolver: anEnvironment ] ] + ^ aSymbol first isUppercase + ifTrue: [ + self + browseUppercasedReferencesTo: aSymbol + inNameRespolver: anEnvironment ] + ifFalse: [ + (Smalltalk tools toolNamed: #messageList) + browseSendersOf: aSymbol + inScope: self defaultNavigationScope asRBEnvironment ] ] ] { #category : '*Calypso-SystemTools-QueryBrowser' } @@ -55,31 +63,18 @@ ClyBrowserMorph >> browseSendersOf: aSymbol [ { #category : '*Calypso-SystemTools-QueryBrowser' } ClyBrowserMorph >> browseUppercasedReferencesTo: aSymbol inNameRespolver: anEnvironment [ - anEnvironment - ifNil: [ - ^ { - (self spawnQueryBrowserOn: (ClyClassReferencesQuery of: (self class environment at: aSymbol))) . - #SendersWithouEnvironment - } ]. - - (anEnvironment bindingOf: aSymbol) - ifNotNil: [ : envBinding | - ^ (envBinding value isClass and: [envBinding value isPool]) - ifTrue: [ - { - (self spawnQueryBrowserOn: (ClySharedPoolReferencesQuery of: envBinding)) . - #SendersWithEnvironment - } ] - ifFalse: [ - { - (self spawnQueryBrowserOn: (ClyClassReferencesQuery of: envBinding)). - #SendersWithEnvironment - } ] ]. + | aClassOrTrait returnedSymbol | + + aClassOrTrait := anEnvironment + ifNil: [ returnedSymbol := #SendersWithouEnvironment. self class environment at: aSymbol ] + ifNotNil: [ returnedSymbol := #SendersWithEnvironment. (anEnvironment bindingOf: aSymbol) value ]. + + ^ { SystemNavigation default browseAllUsersOfClassOrTrait: aClassOrTrait. returnedSymbol } ] { #category : '*Calypso-SystemTools-QueryBrowser' } ClyBrowserMorph >> spawnQueryBrowserOn: aQuery [ - + self spawnQueryBrowserOn: aQuery withState: [] ] diff --git a/src/Refactoring-Environment/RBClassHierarchyEnvironment.class.st b/src/Refactoring-Environment/RBClassHierarchyEnvironment.class.st index c373543330c..31f150bd5c4 100644 --- a/src/Refactoring-Environment/RBClassHierarchyEnvironment.class.st +++ b/src/Refactoring-Environment/RBClassHierarchyEnvironment.class.st @@ -81,6 +81,17 @@ RBClassHierarchyEnvironment >> includesClass: aClass [ [ aClass inheritsFrom: class ] ]) and: [super includesClass: aClass] ] +{ #category : 'printing' } +RBClassHierarchyEnvironment >> printOn: aStream [ + + aStream + nextPutAll: self class name; + nextPutAll: ' for: '; + print: class; + nextPutAll: ' in: '; + print: environment +] + { #category : 'printing' } RBClassHierarchyEnvironment >> storeOn: aStream [ aStream nextPut: $(. diff --git a/src/Tool-Base/SystemNavigation.extension.st b/src/Tool-Base/SystemNavigation.extension.st index 31de7870f3f..096e35c6ebc 100644 --- a/src/Tool-Base/SystemNavigation.extension.st +++ b/src/Tool-Base/SystemNavigation.extension.st @@ -264,7 +264,7 @@ SystemNavigation >> browseMessageList: messageList name: labelString autoSelect: ^ (self tools toolNamed: #messageList) new messages: methods; title: labelString; - autoSelect: autoSelectString; + highlight: autoSelectString; refreshingBlock: aBlock; open ]