[WIP] Introducing new Message Browser

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.

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 [
 

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 [
 

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 
+
+]

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' }

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: []
 ]
 

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: $(.

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
 ]