[WIP] Message Browser

src/BaselineOfNewTools/BaselineOfNewTools.class.st

@@ -209,8 +209,7 @@ BaselineOfNewTools >> baseline: spec [
 
 			group: 'SystemReporter' with: #( 'Core' 'NewTools-SystemReporter' );
 
-			group: 'Methods' with: #( 'Core' 'NewTools-SpTextPresenterDecorators' 'NewTools-MethodBrowsers' );
-			"Not in the image for the moment, we need a pass on them"
+			group: 'Methods' with: #( 'Core' 'NewTools-SpTextPresenterDecorators' 'NewTools-MethodBrowsers' 'NewTools-MethodBrowsers-Tests');
 
 			group: 'CritiqueBrowser' with: #( 'NewTools-CodeCritiques' 'NewTools-CodeCritiques-Tests' );
 

src/NewTools-MethodBrowsers-Tests/StMBTestClass.class.st

@@ -0,0 +1,15 @@
+"
+I am a test class, to use in the StMessageBrowserTests
+"
+Class {
+	#name : 'StMBTestClass',
+	#superclass : 'Object',
+	#category : 'NewTools-MethodBrowsers-Tests',
+	#package : 'NewTools-MethodBrowsers-Tests'
+}
+
+{ #category : 'test method' }
+StMBTestClass >> aSelectorWithASingleMethodImplementation [
+
+	^ self
+]

src/NewTools-MethodBrowsers-Tests/StMBTestClass2.class.st

@@ -0,0 +1,6 @@
+Class {
+	#name : 'StMBTestClass2',
+	#superclass : 'Object',
+	#category : 'NewTools-MethodBrowsers-Tests',
+	#package : 'NewTools-MethodBrowsers-Tests'
+}

src/NewTools-MethodBrowsers-Tests/StMessageBrowserTest.class.st

@@ -0,0 +1,278 @@
+Class {
+	#name : 'StMessageBrowserTest',
+	#superclass : 'TestCase',
+	#instVars : [
+		'messageBrowser',
+		'secondMessageWindow',
+		'backendForTest'
+	],
+	#category : 'NewTools-MethodBrowsers-Tests',
+	#package : 'NewTools-MethodBrowsers-Tests'
+}
+
+{ #category : 'running' }
+StMessageBrowserTest >> setUp [
+
+	super setUp.
+	backendForTest := SpMorphicBackendForTest new
+]
+
+{ #category : 'running' }
+StMessageBrowserTest >> tearDown [
+
+	StMBTestClass2 removeSelector: #aSelectorWithASingleMethodImplementation.
+	StMBTestClass compile: 'aSelectorWithASingleMethodImplementation
+
+	^ self'.
+
+	messageBrowser ifNotNil: [ messageBrowser close ].
+	secondMessageWindow ifNotNil: [ secondMessageWindow close ].
+	super tearDown
+]
+
+{ #category : 'tests - updates' }
+StMessageBrowserTest >> testAddingASecondMethodDoesNotChangeSelection [
+
+	| oldSelection |
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+
+	oldSelection := messageBrowser presenter messageList selectedItem.
+
+	StMBTestClass2 compile: 'aSelectorWithASingleMethodImplementation ^ 42'.
+	backendForTest waitUntilUIRedrawed.
+
+	self assert: messageBrowser presenter messageList selectedItem equals: oldSelection.
+
+]
+
+{ #category : 'tests - updates' }
+StMessageBrowserTest >> testAddingASecondMethodHasCorrectTitle [
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+
+	self assert: messageBrowser presenter windowTitle equals: 'Implementors of #aSelectorWithASingleMethodImplementation [1]'.
+
+	StMBTestClass2 compile: 'aSelectorWithASingleMethodImplementation ^ 42'.
+	backendForTest waitUntilUIRedrawed.
+
+	self assert: messageBrowser presenter messageList numberOfElements equals: 2.
+	self assert: messageBrowser presenter windowTitle equals: 'Implementors of #aSelectorWithASingleMethodImplementation [2]'.
+
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testAskingImplementorsOfASelectorShouldRespectSelectedScope [
+
+	| presenter secondPresenter |
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+
+	presenter toolbarPresenter scopeList selectIndex: 2.
+	secondMessageWindow := presenter messageList doBrowseImplementors.
+	secondPresenter := secondMessageWindow presenter.
+
+	self 
+		assert: secondPresenter messageList selectedScope	
+		equals: presenter messageList selectedScope
+
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testAskingReferencesOfAClassShouldRespectSelectedScope [
+
+	| presenter secondPresenter |
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+
+	presenter toolbarPresenter scopeList selectIndex: 2.
+	secondMessageWindow := presenter messageList doBrowseUsers.
+	secondPresenter := secondMessageWindow presenter.
+
+	self 
+		assert: secondPresenter messageList selectedScope	
+		equals: presenter messageList selectedScope
+
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testAskingSendersOfASelectorShouldRespectSelectedScope [
+
+	| presenter secondPresenter |
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+
+	presenter toolbarPresenter scopeList selectIndex: 2.
+	presenter messageList selectIndex: 1.
+
+	secondMessageWindow := presenter messageList doBrowseSenders.
+	secondPresenter := secondMessageWindow presenter.
+
+	self 
+		assert: presenter messageList selectedScope
+		equals: secondPresenter messageList selectedScope	
+
+]
+
+{ #category : 'tests - compiling' }
+StMessageBrowserTest >> testCompilingMethodElseWhereChangeTheText [
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+
+	self assert: messageBrowser presenter textPresenter text equals: (StMBTestClass >> #aSelectorWithASingleMethodImplementation) sourceCode.
+
+	StMBTestClass compile: 'aSelectorWithASingleMethodImplementation ^ 42'.
+	backendForTest waitUntilUIRedrawed.
+
+	self assert: messageBrowser presenter textPresenter text equals: (StMBTestClass >> #aSelectorWithASingleMethodImplementation) sourceCode.
+
+
+]
+
+{ #category : 'tests - compiling' }
+StMessageBrowserTest >> testCompilingMethodElseWhereOnAChangedTextDoesNotChangeTheText [
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+
+	self assert: messageBrowser presenter textPresenter text equals: (StMBTestClass >> #aSelectorWithASingleMethodImplementation) sourceCode.
+	backendForTest waitUntilUIRedrawed.
+
+	backendForTest setUnacceptedTextOn: messageBrowser presenter textPresenter to: 'asbc'.
+
+	StMBTestClass compile: 'aSelectorWithASingleMethodImplementation ^ 42'.
+	backendForTest waitUntilUIRedrawed.
+
+	self assert: messageBrowser presenter textPresenter text equals: 'asbc'
+
+]
+
+{ #category : 'tests - title' }
+StMessageBrowserTest >> testOpeningAMessageBrowserOnASingleMethodHasCorrectTitle [
+
+	messageBrowser := StMessageBrowser browse: { StMBTestClass >> #aSelectorWithASingleMethodImplementation }.
+
+	self assert: messageBrowser title equals: 'Message Browser [1]'
+]
+
+{ #category : 'tests - title' }
+StMessageBrowserTest >> testOpeningImplementorsAndChangingScopeShowsCorrectTitle [
+
+	| presenter |
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+
+	presenter toolbarPresenter scopeList selectIndex: 2.
+
+	self assert: messageBrowser title equals: 'Implementors of #aSelectorWithASingleMethodImplementation [1]'
+]
+
+{ #category : 'tests - title' }
+StMessageBrowserTest >> testOpeningImplementorsShowsCorrectTitle [
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+
+	self assert: messageBrowser title equals: 'Implementors of #aSelectorWithASingleMethodImplementation [1]'
+]
+
+{ #category : 'tests' }
+StMessageBrowserTest >> testOpeningImplementorsWithASingleImplementationHasOneAndSelectsIt [
+
+	| presenter |
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+
+	self assert: presenter messageList listPresenter model size equals: 1.
+
+	self
+		assert: (presenter messageList listPresenter model at: 1)
+		equals: StMBTestClass >> #aSelectorWithASingleMethodImplementation.
+
+	self 
+		assert: (presenter textPresenter text) equals: (StMBTestClass >> #aSelectorWithASingleMethodImplementation) sourceCode
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testOpeningWithASpecificScopeActivatesIt [
+
+	| presenter anotherScope |
+	anotherScope := RBClassEnvironment classes: {self class. StMBTestClass}.
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation inScope: anotherScope.
+	presenter := messageBrowser presenter.
+
+	self assert: presenter messageList selectedScope equals: anotherScope
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testOpeningWithASpecificScopeIncludesItInTheList [
+
+	| presenter anotherScope |
+	anotherScope := RBClassEnvironment classes: {self class. StMBTestClass}.
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation inScope: anotherScope.
+	presenter := messageBrowser presenter.
+
+	self assert: (presenter toolbarPresenter scopeList items includes:anotherScope)
+]
+
+{ #category : 'tests' }
+StMessageBrowserTest >> testRemovingAMethodCallsTheRefactoring [
+
+	| presenter mockSelectDialog |
+
+	messageBrowser := StMessageBrowser browseImplementorsOf:
+		                  #aSelectorWithASingleMethodImplementation.
+
+	presenter := messageBrowser presenter.
+
+	mockSelectDialog := MockObject new.
+	mockSelectDialog
+		on: #title: with: MockObject any;
+		on: #label: with: 'Select a strategy';
+		on: #items: with: MockObject any;
+		on: #display: with: MockObject any;
+		on: #displayIcon: with: MockObject any;
+		on: #openModal respond: nil "When cancelling the dialog, nil is returned".
+
+	ReInteractionDriver useSelectDialog: mockSelectDialog during: [presenter messageList doRemoveMethod].
+
+	mockSelectDialog verifyIn: self.
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testScopeListHasCorrectNumberOfElements [
+
+	| presenter |
+
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+	self assert: presenter toolbarPresenter scopeList items size equals: 4 "Current Image, Package and Class, hierarchy"
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testScopeListHasCorrectOrder [
+
+	| presenter |
+	messageBrowser := StMessageBrowser browseImplementorsOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+
+
+	self
+		assertCollection: (presenter toolbarPresenter scopeList items collect: #description)
+		hasSameElements: { 'Current image'. 'Packages: NewTools-MethodBrowsers-Tests'. 'Hier: StMBTestClass'. 'Classes: StMBTestClass' }
+]
+
+{ #category : 'tests - scopes' }
+StMessageBrowserTest >> testSelectingElementsDoesNotDuplicateScopes [
+
+	| presenter |
+
+	messageBrowser := StMessageBrowser browseSendersOf: #aSelectorWithASingleMethodImplementation.
+	presenter := messageBrowser presenter.
+	self assert: presenter toolbarPresenter scopeList items size equals: 4.
+
+	presenter messageList selectIndex: 2.
+
+	self assert: presenter toolbarPresenter scopeList items size equals: 4.
+
+]

src/NewTools-MethodBrowsers/RBBrowserEnvironment.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : 'RBBrowserEnvironment' }
 
+{ #category : '*NewTools-MethodBrowsers' }
+RBBrowserEnvironment >> scopeListOrder [
+
+	^ 1
+]
+
 { #category : '*NewTools-MethodBrowsers' }
 RBBrowserEnvironment >> selectMessagesFrom: aCollectionOfCompiledMethod [ 
 	"Since the receiver is a system environment, answer all messages in aCollection"	

src/NewTools-MethodBrowsers/RBClassEnvironment.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : 'RBClassEnvironment' }
 
+{ #category : '*NewTools-MethodBrowsers' }
+RBClassEnvironment >> scopeListOrder [
+
+	^ 4
+]
+
 { #category : '*NewTools-MethodBrowsers' }
 RBClassEnvironment >> selectMessagesFrom: aCollectionOfCompiledMethod [ 
 	"Filter methods in aCollectionOfCompiledMethod for which their method class is present in the receiver's classes

src/NewTools-MethodBrowsers/RBClassHierarchyEnvironment.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : 'RBClassHierarchyEnvironment' }
 
+{ #category : '*NewTools-MethodBrowsers' }
+RBClassHierarchyEnvironment >> scopeListOrder [
+
+	^ 3
+]
+
 { #category : '*NewTools-MethodBrowsers' }
 RBClassHierarchyEnvironment >> selectMessagesFrom: aCollectionOfCompiledMethod [ 
 	"Since the receiver is a system environment, answer all messages in aCollection"	

src/NewTools-MethodBrowsers/RBPackageEnvironment.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : 'RBPackageEnvironment' }
 
+{ #category : '*NewTools-MethodBrowsers' }
+RBPackageEnvironment >> scopeListOrder [
+
+	^ 2
+]
+
 { #category : '*NewTools-MethodBrowsers' }
 RBPackageEnvironment >> selectMessagesFrom: aCollectionOfCompiledMethod [ 
 	"Answer a <Collection> of <CompiledMethod> present in the receiver"

src/NewTools-MethodBrowsers/RGCommentDefinition.extension.st

@@ -0,0 +1,13 @@
+Extension { #name : 'RGCommentDefinition' }
+
+{ #category : '*NewTools-MethodBrowsers' }
+RGCommentDefinition >> isDoIt [
+
+	^ false
+]
+
+{ #category : '*NewTools-MethodBrowsers' }
+RGCommentDefinition >> protocolName [
+
+	^ nil
+]

src/NewTools-MethodBrowsers/StComposedMessageBrowser.class.st

@@ -1,9 +1,9 @@
 Class {
 	#name : 'StComposedMessageBrowser',
 	#superclass : 'StMessageBrowser',
-	#category : 'NewTools-MethodBrowsers-Senders',
+	#category : 'NewTools-MethodBrowsers-Messages',
 	#package : 'NewTools-MethodBrowsers',
-	#tag : 'Senders'
+	#tag : 'Messages'
 }
 
 { #category : 'initialization' }