diff --git a/src/BaselineOfNewTools/BaselineOfNewTools.class.st b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
index fcee78ce0..2758bff08 100644
--- a/src/BaselineOfNewTools/BaselineOfNewTools.class.st
+++ b/src/BaselineOfNewTools/BaselineOfNewTools.class.st
@@ -82,15 +82,15 @@ BaselineOfNewTools >> baseline: spec [
 			package: 'NewTools-RewriterTools' with: [ spec requires: #('NewTools-RewriterTools-Backend') ];
 			package: 'NewTools-RewriterTools-Backend-Tests' with: [ spec requires: #('NewTools-RewriterTools-Backend') ];
 			package: 'NewTools-RewriterTools-Tests' with: [ spec requires: #('NewTools-RewriterTools') ];
+			"Profiler"
+			package: 'NewTools-ProfilerUI';
 			"Scopes Editor"
 			package: 'NewTools-Scopes';
 			package: 'NewTools-Scopes-Editor' with: [ spec requires: #('NewTools-Scopes') ];
 			package: 'NewTools-Scopes-Tests';
 			package: 'NewTools-Scopes-Resources-A-Tests';
 			package: 'NewTools-Scopes-Resources-B-Tests';
-			package: 'NewTools-Scopes-Resources-C-Tests';
-			"ProfilerUI"
-			package: 'NewTools-ProfilerUI'.
+			package: 'NewTools-Scopes-Resources-C-Tests'.
 
 		spec
 			group: 'Core' with: #( 'NewTools-Core' 'NewTools-Morphic' );
@@ -134,12 +134,11 @@ BaselineOfNewTools >> baseline: spec [
 			group: #FileBrowser with: #( 
 						'NewTools-FileBrowser' 
 						'NewTools-FileBrowser-Tests' );
-   		group: #RewriterTools with: #(
-			   		'NewTools-RewriterTools-Backend'
-			   		'NewTools-RewriterTools'
-			   		'NewTools-RewriterTools-Backend-Tests'
-			   		'NewTools-RewriterTools-Tests' );
-			group: #ProfilerUI with: #( 'NewTools-ProfilerUI' );
+      			group: #RewriterTools with: #(
+				    		'NewTools-RewriterTools-Backend'
+				    		'NewTools-RewriterTools'
+				    		'NewTools-RewriterTools-Backend-Tests'
+				    		'NewTools-RewriterTools-Tests' );
 			"ScopesEditor"
 			group: #ScopesEditor with: #(
 						'NewTools-Scopes' 
@@ -153,13 +152,12 @@ BaselineOfNewTools >> baseline: spec [
 						'Inspector' 
 						'CritiqueBrowser' 
 						'Debugger'
-						'SystemReporter' 
+				   		'SystemReporter' 
 						'FontChooser' 
 						'Methods'
-						'Spotter'
-						'RewriterTools'
-						'ScopesEditor'
-						'ProfilerUI') ]
+				   		'Spotter'
+            					'RewriterTools'
+						'ScopesEditor') ]
 ]
 
 { #category : 'external projects' }
diff --git a/src/NewTools-FontChooser/StFontChooserPresenter.class.st b/src/NewTools-FontChooser/StFontChooserPresenter.class.st
index 22ef78ec8..270af02b0 100644
--- a/src/NewTools-FontChooser/StFontChooserPresenter.class.st
+++ b/src/NewTools-FontChooser/StFontChooserPresenter.class.st
@@ -167,9 +167,8 @@ StFontChooserPresenter >> initializeDialogWindow: aDialogWindowPresenter [
 	super initializeDialogWindow: aDialogWindowPresenter.
 
 	aDialogWindowPresenter
-		addButton: 'Apply' do: [ :presenter | self applyChanges ];
 		addButton: 'Update' do: [ :presenter | self updateFonts ];
-		okAction: [ self applyChanges ].
+		addDefaultButton: 'Apply' do: [ :presenter | self applyChanges ]
 
 ]
 
diff --git a/src/NewTools-Gtk/StGtkDebugSession.class.st b/src/NewTools-Gtk/StGtkDebugSession.class.st
index 9b26997e3..902db28c4 100644
--- a/src/NewTools-Gtk/StGtkDebugSession.class.st
+++ b/src/NewTools-Gtk/StGtkDebugSession.class.st
@@ -20,7 +20,7 @@ StGtkDebugSession >> application: anApplication [
 	application := anApplication
 ]
 
-{ #category : 'private' }
+{ #category : 'initialization' }
 StGtkDebugSession >> initialize [
 
 	super initialize. 
diff --git a/src/NewTools-Gtk/StPharoGtkConfiguration.class.st b/src/NewTools-Gtk/StPharoGtkConfiguration.class.st
index 3cd92a06e..76ca67204 100644
--- a/src/NewTools-Gtk/StPharoGtkConfiguration.class.st
+++ b/src/NewTools-Gtk/StPharoGtkConfiguration.class.st
@@ -15,14 +15,14 @@ StPharoGtkConfiguration >> commonStyle [
 
 	^ '
 /* compact toolbar */
-toolbar.stToolbar { font-size: 0.7em }
-toolbar.stToolbar toolbutton > button { padding: 2px; margin: 2px }
+toolbar.stToolbar { font-size: 0.7em; }
+toolbar.stToolbar toolbutton > button { padding: 2px; margin: 2px; }
 
-.dim { color: LightSlateGrey }
+.dim { color: LightSlateGrey; }
 .codePopover, .codePopover text { 
 	background-color: transparent;
 }
-.scrollbarPopoverLarge { min-height: 350px }
+.scrollbarPopoverLarge { min-height: 350px; }
 '
 ]
 
@@ -41,7 +41,7 @@ StPharoGtkConfiguration >> configureOSX: anApplication [
 
 	self installTheme: self macThemeName.
 	self addCSSProviderFromString: '
-.code { font: 12pt "Monaco" }
+.code { font: 12pt "Monaco"; }
 '
 ]
 
@@ -50,7 +50,7 @@ StPharoGtkConfiguration >> configureUnix: anApplication [
 
 	self unixThemeName ifNotNil: [ :aName | self installTheme: aName ].
 	self addCSSProviderFromString: '
-.code { /* font: 10pt "Source Code Pro" */ }
+/* .code { font: 10pt "Source Code Pro" } */
 '
 ]
 
@@ -59,7 +59,7 @@ StPharoGtkConfiguration >> configureWindows: anApplication [
 
 	self installTheme: self windowsThemeName.
 	self addCSSProviderFromString: '
-.code { font: 10pt "Microsoft Sans Serif" }
+.code { font: 10pt "Microsoft Sans Serif"; }
 '
 ]
 
diff --git a/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st b/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st
index 512771d9e..519697dc1 100644
--- a/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st
+++ b/src/NewTools-Gtk/StPharoGtkDarkConfiguration.class.st
@@ -9,6 +9,12 @@ Class {
 	#package : 'NewTools-Gtk'
 }
 
+{ #category : 'testing' }
+StPharoGtkDarkConfiguration >> isDarkTheme [
+
+	^ true
+]
+
 { #category : 'accessing' }
 StPharoGtkDarkConfiguration >> macThemeName [
 		
diff --git a/src/NewTools-Inspector/StInspector.class.st b/src/NewTools-Inspector/StInspector.class.st
index 3b270f243..df5bfa480 100644
--- a/src/NewTools-Inspector/StInspector.class.st
+++ b/src/NewTools-Inspector/StInspector.class.st
@@ -1,3 +1,16 @@
+"
+I am an inspector of objects. 
+I offer multiple views using a miller list as a navigation. 
+One particular feature is that you can use the evaluator tab to enter code, and evaluating it results in opening another pane to the right.
+
+The object finder asks dynamically the object for the actual presentations that are displayed in each pane.
+
+Example:
+self openOn: Smalltalk.
+
+Register it as a replacement for inspector:
+self registerToolsOn: Smalltalk tools.
+"
 Class {
 	#name : 'StInspector',
 	#superclass : 'StInspectorPresenter',
diff --git a/src/NewTools-MethodBrowsers/AbstractMessageCentricBrowser.class.st b/src/NewTools-MethodBrowsers/AbstractMessageCentricBrowser.class.st
index 9fd5ac6ff..4a788cbaa 100644
--- a/src/NewTools-MethodBrowsers/AbstractMessageCentricBrowser.class.st
+++ b/src/NewTools-MethodBrowsers/AbstractMessageCentricBrowser.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'AbstractMessageCentricBrowser',
-	#superclass : 'AbstractMessageCentricBrowserPresenter',
+	#superclass : 'StAbstractMessageCentricBrowserPresenter',
 	#category : 'NewTools-MethodBrowsers-Deprecated',
 	#package : 'NewTools-MethodBrowsers',
 	#tag : 'Deprecated'
diff --git a/src/NewTools-MethodBrowsers/MessageBrowser.class.st b/src/NewTools-MethodBrowsers/MessageBrowser.class.st
index 1795069d4..a2d852f64 100644
--- a/src/NewTools-MethodBrowsers/MessageBrowser.class.st
+++ b/src/NewTools-MethodBrowsers/MessageBrowser.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'MessageBrowser',
-	#superclass : 'StMessageBrowserPresenter',
+	#superclass : 'StMessageBrowser',
 	#category : 'NewTools-MethodBrowsers-Deprecated',
 	#package : 'NewTools-MethodBrowsers',
 	#tag : 'Deprecated'
diff --git a/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st b/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st
index 2c1afce3f..8f4dcb2c2 100644
--- a/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st
+++ b/src/NewTools-MethodBrowsers/MessageBrowserPresenter.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'MessageBrowserPresenter',
-	#superclass : 'StMessageBrowserPresenter',
+	#superclass : 'StMessageBrowser',
 	#category : 'NewTools-MethodBrowsers-Deprecated',
 	#package : 'NewTools-MethodBrowsers',
 	#tag : 'Deprecated'
diff --git a/src/NewTools-MethodBrowsers/MessageList.class.st b/src/NewTools-MethodBrowsers/MessageList.class.st
index 3a502ebbf..a6b6beb96 100644
--- a/src/NewTools-MethodBrowsers/MessageList.class.st
+++ b/src/NewTools-MethodBrowsers/MessageList.class.st
@@ -1,6 +1,6 @@
 Class {
 	#name : 'MessageList',
-	#superclass : 'MessageListPresenter',
+	#superclass : 'StMessageListPresenter',
 	#category : 'NewTools-MethodBrowsers-Deprecated',
 	#package : 'NewTools-MethodBrowsers',
 	#tag : 'Deprecated'
diff --git a/src/NewTools-MethodBrowsers/MessageListPresenter.class.st b/src/NewTools-MethodBrowsers/MessageListPresenter.class.st
deleted file mode 100644
index b7869789e..000000000
--- a/src/NewTools-MethodBrowsers/MessageListPresenter.class.st
+++ /dev/null
@@ -1,416 +0,0 @@
-"
-I am a presenter listing messages. 
-
-I am used by more complexe browsers such as MessageBrowser or VersionBrowser.
-	
- 
-Internal Representation and Key Implementation Points.
---------------------
-
-    Instance Variables
-	cachedHierarchy:		<aDictionary>	 	A cache keeping info about the level of a class in the list.
-	listModel:				<aListPresenter>	A list presenter to show all the messages.
-	model:						<aTool>				A model grouping generic methods for managing packages/classes/groups/methods from a browser
-	topologySort:			<aBoolean>		 	A boolean to know if we should use a topology sort or not.
-
-"
-Class {
-	#name : 'MessageListPresenter',
-	#superclass : 'SpPresenter',
-	#instVars : [
-		'cachedHierarchy',
-		'topologySort',
-		'method',
-		'listPresenter'
-	],
-	#category : 'NewTools-MethodBrowsers-Base',
-	#package : 'NewTools-MethodBrowsers',
-	#tag : 'Base'
-}
-
-{ #category : 'layout' }
-MessageListPresenter class >> defaultLayout [
-
-	^ SpBoxLayout newTopToBottom
-		add: #listPresenter;
-		yourself
-]
-
-{ #category : 'private' }
-MessageListPresenter >> authorOf: anItem [
-	^ anItem author
-]
-
-{ #category : 'actions' }
-MessageListPresenter >> browseClassRefs [
-
-	self currentMethod ifNotNil: [ :aMethod | 
-		self systemNavigation browseAllUsersOfClassOrTrait: aMethod methodClass ]
-]
-
-{ #category : 'actions' }
-MessageListPresenter >> browseMessages [
-
-	self currentMethod ifNotNil: [ :aMethod |
-		SystemNavigation new browseImplementorsOf: aMethod selector ]
-]
-
-{ #category : 'actions' }
-MessageListPresenter >> browseMethod [
-
-	self currentMethod ifNotNil: [ :aMethod | self systemNavigation browse: aMethod ]
-]
-
-{ #category : 'actions' }
-MessageListPresenter >> browseSendersOfMessage [
-
-	self currentMethod ifNotNil: [ :aMethod |
-		self systemNavigation browseAllSendersOf: aMethod selector ]
-]
-
-{ #category : 'actions' }
-MessageListPresenter >> browseVersions [
-
-	self currentMethod ifNotNil: [ :aMethod |
-		self application tools versionBrowser  browseVersionsForMethod: aMethod compiledMethod ]
-]
-
-{ #category : 'testing' }
-MessageListPresenter >> buildHierarchyForMessages: messages [
-	| result classes |
-	self topologicSort ifFalse: [ 
-		result := IdentityDictionary new.
-		messages do: [:m | result at: m put: {} ].
-		^ result ].
-	
-	result := Dictionary new.	
-	classes := (messages collect: [ :each | each methodClass ]) asSet.
-	messages do: [:message || level class |
-		class := message methodClass.
-		level := OrderedCollection new.
-		class allSuperclassesDo: [:superClass |
-			(classes includes: superClass)
-				ifTrue: [ level addFirst: superClass ]].
-		level addLast: class.
-		level addLast: message selector.
-		result at: message put: level ].
-	^ result
-]
-
-{ #category : 'testing' }
-MessageListPresenter >> cacheHierarchyForClasses: aCollection [
-	cachedHierarchy := self buildHierarchyForMessages: aCollection.
-]
-
-{ #category : 'api' }
-MessageListPresenter >> contextMenu: aMenuPresenter [
-	listPresenter contextMenu: aMenuPresenter
-]
-
-{ #category : 'private' }
-MessageListPresenter >> currentMethod [
-
-	^ method
-]
-
-{ #category : 'transmission' }
-MessageListPresenter >> defaultOutputPort [
-
-	^ self outputSelectionPort
-]
-
-{ #category : 'private - actions' }
-MessageListPresenter >> doBrowseImplementors [
-		
-	self systemNavigation browseAllImplementorsOf: self selectedMethod selector
-]
-
-{ #category : 'private - actions' }
-MessageListPresenter >> doBrowseMethod [
-		
-	self systemNavigation browse: self selectedMethod
-]
-
-{ #category : 'private - actions' }
-MessageListPresenter >> doBrowseSenders [
-
-	self systemNavigation browseAllSendersOf: self selectedMethod selector
-]
-
-{ #category : 'private - actions' }
-MessageListPresenter >> doBrowseUsers [
-		
-	self systemNavigation browseAllUsersOfClassOrTrait: self selectedMethod methodClass
-]
-
-{ #category : 'private - actions' }
-MessageListPresenter >> doBrowseVersions [
-	
-	self systemNavigation browseVersionsOf: self selectedMethod
-]
-
-{ #category : 'private - actions' }
-MessageListPresenter >> doInspectMethod [
-	
-	self systemNavigation inspect: self selectedMethod
-]
-
-{ #category : 'private - actions' }
-MessageListPresenter >> doRemoveMethod [
-		
-	self selectedMethod removeFromSystem
-]
-
-{ #category : 'private - focus' }
-MessageListPresenter >> ensureKeyBindingsFor: aWidget [
-	aWidget bindKeyCombination: PharoShortcuts current browseShortcut toAction: [ self browseMethod ].
-	aWidget bindKeyCombination: PharoShortcuts current inspectItShortcut toAction: [ self inspectMethod ].
-	aWidget bindKeyCombination: PharoShortcuts current browseImplementorsShortcut toAction: [ self browseMessages ].
-	aWidget bindKeyCombination: PharoShortcuts current browseSendersShortcut toAction: [ self browseSendersOfMessage ].
-	aWidget bindKeyCombination: PharoShortcuts current browseReferencesShortcut toAction: [ self browseClassRefs ].
-	aWidget bindKeyCombination: PharoShortcuts current browseVersionsShortcut toAction: [ self browseVersions ].
-	aWidget bindKeyCombination: PharoShortcuts current removeShortcut toAction: [ self removeMethods ]
-]
-
-{ #category : 'initialization' }
-MessageListPresenter >> initialize [
-	super initialize.
-	topologySort := true
-
-]
-
-{ #category : 'initialization' }
-MessageListPresenter >> initializePresenters [
-	listPresenter := self newTable.
-
-	listPresenter
-		sortingBlock: [ :a :b | self sortClassesInCachedHierarchy: a b: b ];
-		addColumn: (SpStringTableColumn title: 'Location' evaluated: [ :item | self locationOf: item ]);
-		addColumn: (SpStringTableColumn title: 'Selector' evaluated: [ :item | self selectorOf: item ]);
-		addColumn: (SpStringTableColumn title: 'Package' evaluated: [ :item | self packageOf: item ]);
-		addColumn: (SpStringTableColumn title: 'Time' evaluated: [ :item | self timeStampOf: item ]);
-		addColumn: (SpStringTableColumn title: 'Author' evaluated: [ :item | self authorOf: item ]);
-		beResizable.
-		
-	listPresenter outputActivationPort transmitDo: [ :aMethod | self doBrowseMethod ].
-		
-	self contextMenu: self messageListMenu
-]
-
-{ #category : 'actions' }
-MessageListPresenter >> inspectMethod [
-
-	self currentMethod ifNotNil: [ :aMethod | aMethod inspect ]
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> listPresenter [
-
-	^ listPresenter
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> locationOf: anItem [
-	^ String
-		streamContents: [ :aStream | 
-			3 to: (cachedHierarchy at: anItem) size do: [ :i | aStream << '    ' ].
-			aStream << (self methodClassNameForItem: anItem) << ' ('.
-			anItem isFromTrait
-				ifTrue: [ aStream
-						<< anItem compiledMethod origin name;
-						space ].
-			aStream << (self protocolNameForItem: anItem) << ')' ]
-]
-
-{ #category : 'private' }
-MessageListPresenter >> messageListMenu [
-
-	^ self newMenu
-		addGroup: [ :group | group
-			addItem: [ :item | item 
-				name: 'Browse full'; 
-				shortcut: $b meta; 
-				action: [ self doBrowseMethod ] ];
-			addItem: [ :item | item 
-				name: 'Inspect method'; 
-				shortcut: $i meta; 
-				action: [ self doInspectMethod ] ] ];
-		addGroup: [ :group | group
-			addItem: [ :item | item 
-				name: 'Remove method'; 
-				shortcut: $x meta; 
-				action: [ self doRemoveMethod ] ];
-			addItem: [ :item | item 
-				name: 'Senders'; 
-				shortcut: $n meta; 
-				action: [ self doBrowseSenders ] ];
-			addItem: [ :item | item 
-				name: 'Implementors'; 
-				shortcut: $m meta; 
-				action: [ self doBrowseImplementors ] ] ];
-		addItem: [ :items | items 
-			name: 'Users'; 
-			shortcut: $N meta; 
-			action: [ self doBrowseUsers ] ];
-		addItem: [ :item | item 
-			name: 'Versions'; 
-			shortcut: $v meta; 
-			action: [ self doBrowseVersions ] ];
-		yourself
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> messages [
-	^ listPresenter items
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> messages: aCollection [
-	self cacheHierarchyForClasses: aCollection.
-	listPresenter items: cachedHierarchy keys asOrderedCollection.
-	listPresenter listSize > 0 ifTrue: [ listPresenter selectIndex: 1 ]
-]
-
-{ #category : 'private' }
-MessageListPresenter >> methodClassNameForItem: anItem [
-	^ anItem methodClass ifNotNil: [ :class | class name ] ifNil: [ '' ]
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> numberOfElements [
-	^ listPresenter listSize
-]
-
-{ #category : 'transmission' }
-MessageListPresenter >> outputActivationPort [
-
-	^ (SpActivationPort newPresenter: self)
-		delegateTo: [ listPresenter ];
-		yourself
-]
-
-{ #category : 'transmission' }
-MessageListPresenter >> outputSelectionPort [
-
-	^ (SpSelectionPort newPresenter: self)
-		delegateTo: [ listPresenter ];
-		yourself
-]
-
-{ #category : 'private' }
-MessageListPresenter >> packageNameForItem: anItem [
-	^ anItem package ifNil: [ '' ] ifNotNil: [ :package | package name ]
-]
-
-{ #category : 'private' }
-MessageListPresenter >> packageOf: anItem [
-	^ '[' , (self packageNameForItem: anItem) , ']'
-]
-
-{ #category : 'private' }
-MessageListPresenter >> protocolNameForItem: anItem [
-
-	^ anItem protocolName ifNil: [ '' ]
-]
-
-{ #category : 'actions' }
-MessageListPresenter >> removeMethods [
-
-	self currentMethod ifNotNil: [ :aMethod |
-		SystemNavigation new removeMethod: aMethod inClass: aMethod methodClass ]
-]
-
-{ #category : 'selecting' }
-MessageListPresenter >> selectIndex: anInteger [
-
-	listPresenter selectIndex: anInteger
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> selectMessage: aMessage [
-	listPresenter selectItem: aMessage
-]
-
-{ #category : 'selecting' }
-MessageListPresenter >> selectedIndex [
-	^ listPresenter selection selectedIndex
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> selectedMessage [
-	^ listPresenter selection selectedItem
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> selectedMethod [
-	self selectedMessage ifNil: [ ^ nil ].
-
-	^ self selectedMessage compiledMethod
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> selectorOf: anItem [
-	^ anItem selector
-]
-
-{ #category : 'initialization' }
-MessageListPresenter >> setModelBeforeInitialization: aMethod [ 
-
-	method := aMethod
-]
-
-{ #category : 'sorting' }
-MessageListPresenter >> sortClassesInCachedHierarchy: aMethodDefinition b: otherMethodDefinition [
-	"This method checks wether the cached inheritance hierarchy of a method should be before than the one of another method.
-	It compares alphabetically the hierarchy using #compare:
-	If both are alphabetically equals, it uses the size the hierarchy.
-	We do not know why this is done like this."
-	| aMethodHierarchy otherMethodHierarchy minSize|
-	aMethodHierarchy := cachedHierarchy at: aMethodDefinition.
-	otherMethodHierarchy := cachedHierarchy at: otherMethodDefinition.
-	
-	minSize := aMethodHierarchy size min: otherMethodHierarchy size.
-	
-	1 to: minSize do: [ :i | |compare|
-		compare := (aMethodHierarchy at: i) printString compare: (otherMethodHierarchy at: i) printString.
-		compare ~~ 2
-			ifTrue: [  ^ compare == 1 ]].
-	^  aMethodHierarchy size < otherMethodHierarchy size
-]
-
-{ #category : 'api' }
-MessageListPresenter >> sortingBlock: aBlock [
-	listPresenter sortingBlock: aBlock
-]
-
-{ #category : 'private' }
-MessageListPresenter >> timeStampOf: anItem [
-	^ anItem timeStamp
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> topologicSort [
-	^ topologySort
-]
-
-{ #category : 'accessing' }
-MessageListPresenter >> topologicSort: anObject [
-	topologySort := anObject
-]
-
-{ #category : 'api - events' }
-MessageListPresenter >> whenModelChangedDo: aBlock [
-	listPresenter whenModelChangedDo: aBlock
-]
-
-{ #category : 'api - events' }
-MessageListPresenter >> whenSelectedDo: aBlock [
-
-	listPresenter whenSelectedDo: aBlock
-]
-
-{ #category : 'api - events' }
-MessageListPresenter >> whenSelectionChangedDo: aBlock [
-
-	listPresenter whenSelectionChangedDo: aBlock
-]
diff --git a/src/NewTools-MethodBrowsers/SpMethodToolbarPresenter.class.st b/src/NewTools-MethodBrowsers/SpMethodToolbarPresenter.class.st
deleted file mode 100644
index 361955fc4..000000000
--- a/src/NewTools-MethodBrowsers/SpMethodToolbarPresenter.class.st
+++ /dev/null
@@ -1,164 +0,0 @@
-"
-A MethodToolbar is xxxxxxxxx.
-
-self example
-"
-Class {
-	#name : 'SpMethodToolbarPresenter',
-	#superclass : 'SpPresenter',
-	#instVars : [
-		'method',
-		'browseButton',
-		'usersButton',
-		'sendersButton',
-		'implementorsButton',
-		'versionButton',
-		'dropList'
-	],
-	#category : 'NewTools-MethodBrowsers-Base',
-	#package : 'NewTools-MethodBrowsers',
-	#tag : 'Base'
-}
-
-{ #category : 'examples' }
-SpMethodToolbarPresenter class >> example [
-
-	<sampleInstance>
-	| example |
-	
-	example := self new.
-	example
-		method: SpButtonPresenter >> #state:;
-		method: nil;
-		extent: 550 @ 100;
-		open.
-	^ example
-]
-
-{ #category : 'specs' }
-SpMethodToolbarPresenter class >> title [
-
-	^ 'Toolbar'
-]
-
-{ #category : 'api' }
-SpMethodToolbarPresenter >> addItemLabeled: aString do: aBlock [
-
-	dropList 
-		addItemLabeled: aString 
-		do: aBlock
-]
-
-{ #category : 'private' }
-SpMethodToolbarPresenter >> browseMethod [
-
-	self method ifNil: [ ^ self ].
-
-	self systemNavigation browse: self method
-]
-
-{ #category : 'layout' }
-SpMethodToolbarPresenter >> defaultLayout [
-
-	^ SpBoxLayout newLeftToRight
-		spacing: 3;
-		borderWidth: 3;
-		add: browseButton;
-		add: usersButton;
-		add: sendersButton;
-		add: implementorsButton;
-		add: versionButton;
-		add: dropList;
-		yourself
-]
-
-{ #category : 'api' }
-SpMethodToolbarPresenter >> emptyDropList [
-	
-	dropList emptyList
-]
-
-{ #category : 'private' }
-SpMethodToolbarPresenter >> implementorsMethod [
-
-	self method ifNil: [ ^ self ].
-	
-	self systemNavigation browseAllImplementorsOf: self method selector
-]
-
-{ #category : 'initialization' }
-SpMethodToolbarPresenter >> initializePresenters [
-
-	(browseButton := self newButton) 
-		label: 'Browse'; 
-		action: [ self browseMethod ].
-	(usersButton := self newButton) 
-		label: 'Users'; 
-		action: [ self usersMethod ].
-	(sendersButton := self newButton) 
-		label: 'Senders'; 
-		action: [ self sendersMethod ].
-	(implementorsButton := self newButton) 
-		label: 'Implementors'; 
-		action: [ self implementorsMethod ].
-	(versionButton := self newButton) 
-		label: 'Version'; 
-		action: [ self versionMethod ].
-	dropList := self newDropList
-]
-
-{ #category : 'accessing' }
-SpMethodToolbarPresenter >> method [
-	^ method
-]
-
-{ #category : 'accessing' }
-SpMethodToolbarPresenter >> method: aMethod [
-
-	method := aMethod
-]
-
-{ #category : 'accessing' }
-SpMethodToolbarPresenter >> replaceVersionWithLabel: aString action: aBlock [
-
-	versionButton 
-		label: aString;
-		action: aBlock
-]
-
-{ #category : 'api' }
-SpMethodToolbarPresenter >> selectFirst [
-
-	dropList selectIndex: 1
-]
-
-{ #category : 'private' }
-SpMethodToolbarPresenter >> sendersMethod [
-
-	self method ifNil: [ ^ self ].
-	
-	self systemNavigation browseAllSendersOf:  self method selector
-]
-
-{ #category : 'initialization' }
-SpMethodToolbarPresenter >> setModelBeforeInitialization: aMethod [
-
-	self method: aMethod
-]
-
-{ #category : 'private' }
-SpMethodToolbarPresenter >> usersMethod [
-
-	self method ifNil: [ ^ self ].
-	self method methodClass ifNil: [ ^ self ].
-	
-	self systemNavigation browseAllUsersOfClassOrTrait: self method methodClass
-]
-
-{ #category : 'private' }
-SpMethodToolbarPresenter >> versionMethod [
-
-	self method ifNil: [ ^ self ].
-	  
-	self systemNavigation browseVersionsOf: self method
-]
diff --git a/src/NewTools-MethodBrowsers/AbstractMessageCentricBrowserPresenter.class.st b/src/NewTools-MethodBrowsers/StAbstractMessageCentricBrowserPresenter.class.st
similarity index 52%
rename from src/NewTools-MethodBrowsers/AbstractMessageCentricBrowserPresenter.class.st
rename to src/NewTools-MethodBrowsers/StAbstractMessageCentricBrowserPresenter.class.st
index 432e92131..2dea66307 100644
--- a/src/NewTools-MethodBrowsers/AbstractMessageCentricBrowserPresenter.class.st
+++ b/src/NewTools-MethodBrowsers/StAbstractMessageCentricBrowserPresenter.class.st
@@ -2,7 +2,7 @@
 I am an abstract class for browsers centered around messages such as class `MessageBrowser` or class `VersionBrowser`.
 "
 Class {
-	#name : 'AbstractMessageCentricBrowserPresenter',
+	#name : 'StAbstractMessageCentricBrowserPresenter',
 	#superclass : 'StPresenter',
 	#instVars : [
 		'messageList',
@@ -15,12 +15,12 @@ Class {
 }
 
 { #category : 'testing' }
-AbstractMessageCentricBrowserPresenter class >> isAbstract [ 
-	 ^self name = #AbstractMessageCentricBrowserPresenter
+StAbstractMessageCentricBrowserPresenter class >> isAbstract [ 
+	 ^self name = #StAbstractMessageCentricBrowserPresenter
 ]
 
 { #category : 'initialization' }
-AbstractMessageCentricBrowserPresenter >> initialize [
+StAbstractMessageCentricBrowserPresenter >> initialize [
 
 	textConverter := self newTextConverter.
 	super initialize
@@ -28,22 +28,22 @@ AbstractMessageCentricBrowserPresenter >> initialize [
 ]
 
 { #category : 'initialization' }
-AbstractMessageCentricBrowserPresenter >> initializePresenters [
+StAbstractMessageCentricBrowserPresenter >> initializePresenters [
 
-	messageList := self instantiate: MessageListPresenter.
-	toolbarPresenter := self instantiate: SpMethodToolbarPresenter
+	messageList := self newMessageList.
+	toolbarPresenter := self newMessageToolbar
+		messageList: messageList;
+		yourself
 ]
 
 { #category : 'initialization' }
-AbstractMessageCentricBrowserPresenter >> initializeWindow: aWindowPresenter [
-	| winExtent |
-	
-	winExtent := RealEstateAgent standardWindowExtent.
-	aWindowPresenter initialExtent: (900 min: winExtent x) @ (550 min: winExtent y)
+StAbstractMessageCentricBrowserPresenter >> initializeWindow: aWindowPresenter [
+
+	aWindowPresenter initialExtent: 900@600
 ]
 
 { #category : 'private - testing' }
-AbstractMessageCentricBrowserPresenter >> isMethodDefinition: anItem [
+StAbstractMessageCentricBrowserPresenter >> isMethodDefinition: anItem [
 	"an item can be nil, a compiled method, or a ring object. Whereas a ring object can be a ring method or comment definition.
 	 Some operations are only valid for compiled methods or ring object that are a method definitions"
 
@@ -54,23 +54,35 @@ AbstractMessageCentricBrowserPresenter >> isMethodDefinition: anItem [
 		or: [  anItem isCompiledMethod ]
 ]
 
+{ #category : 'initialization' }
+StAbstractMessageCentricBrowserPresenter >> newMessageList [
+	
+	^ self instantiate: StMessageListPresenter
+]
+
+{ #category : 'initialization' }
+StAbstractMessageCentricBrowserPresenter >> newMessageToolbar [
+
+	^ self instantiate: StMethodToolbarPresenter
+]
+
 { #category : 'private - factory' }
-AbstractMessageCentricBrowserPresenter >> newTextConverter [
+StAbstractMessageCentricBrowserPresenter >> newTextConverter [
 
 	^ DiffSourceMethodConverter new
 ]
 
 { #category : 'api' }
-AbstractMessageCentricBrowserPresenter >> selectedMessage [
+StAbstractMessageCentricBrowserPresenter >> selectedMessage [
 	^ messageList selectedMessage
 ]
 
 { #category : 'accessing' }
-AbstractMessageCentricBrowserPresenter >> textConverter [
+StAbstractMessageCentricBrowserPresenter >> textConverter [
 	^ textConverter
 ]
 
 { #category : 'accessing' }
-AbstractMessageCentricBrowserPresenter >> textConverter: aTextConverter [
+StAbstractMessageCentricBrowserPresenter >> textConverter: aTextConverter [
 	textConverter := aTextConverter method: self textConverter method
 ]
diff --git a/src/NewTools-MethodBrowsers/StClyMessageListPresenter.class.st b/src/NewTools-MethodBrowsers/StClyMessageListPresenter.class.st
new file mode 100644
index 000000000..0f2c3c08d
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StClyMessageListPresenter.class.st
@@ -0,0 +1,131 @@
+Class {
+	#name : 'StClyMessageListPresenter',
+	#superclass : 'StMessageListPresenter',
+	#instVars : [
+		'scopes',
+		'query',
+		'navigationEnvironment'
+	],
+	#category : 'NewTools-MethodBrowsers-Senders',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Senders'
+}
+
+{ #category : 'private' }
+StClyMessageListPresenter >> allNavigationScopes [
+	| extraScopes |
+	
+	scopes ifNil: [ scopes := #() ].
+	extraScopes := self extraScopesOfSelectedItems reject: #isBasedOnEmptyBasis.
+	^ scopes, (extraScopes copyWithoutAll: scopes)
+]
+
+{ #category : 'private' }
+StClyMessageListPresenter >> classScopeOfSelectedItems [
+	| classes |
+	
+	classes := { self selectedMessageOrFirst methodClass }.
+	^ ClyBothMetaLevelClassScope ofAll: classes in: navigationEnvironment
+]
+
+{ #category : 'initialization' }
+StClyMessageListPresenter >> connectPresenters [
+
+	listPresenter whenSelectedItemChangedDo: [ :item | self updateScopeList ] 
+]
+
+{ #category : 'private - actions' }
+StClyMessageListPresenter >> doRemoveMethod [
+
+	(RBRemoveMethodDriver new
+		scopes: self scopes
+		methods: { self selectedMethod }) 
+		runRefactoring	
+]
+
+{ #category : 'private' }
+StClyMessageListPresenter >> extraScopesOfSelectedItems [
+	| classScope |
+	
+	classScope := self classScopeOfSelectedItems.
+	^{
+		self packageScopeOfSelectedItems.
+		classScope asFullHierarchyScope.
+		classScope
+	}, RefactoringSettings availableScopes
+]
+
+{ #category : 'accessing' }
+StClyMessageListPresenter >> navigationEnvironment [
+
+	^ navigationEnvironment
+]
+
+{ #category : 'accessing' }
+StClyMessageListPresenter >> navigationEnvironment: anEnvironment [
+
+	navigationEnvironment := anEnvironment
+]
+
+{ #category : 'private' }
+StClyMessageListPresenter >> packageScopeOfSelectedItems [
+	| packages |
+	
+	packages := { self selectedMessageOrFirst package }.
+	^ ClyPackageScope ofAll: packages in: navigationEnvironment
+]
+
+{ #category : 'accessing' }
+StClyMessageListPresenter >> query [
+
+	^ query
+]
+
+{ #category : 'accessing' }
+StClyMessageListPresenter >> query: aQuery [
+
+	query := aQuery
+]
+
+{ #category : 'accessing' }
+StClyMessageListPresenter >> scopes [
+
+	^ scopes
+]
+
+{ #category : 'accessing' }
+StClyMessageListPresenter >> scopes: aCollectionOfScopes [
+
+	scopes := aCollectionOfScopes
+]
+
+{ #category : 'private' }
+StClyMessageListPresenter >> selectedMessageOrFirst [
+
+	^ listPresenter selection selectedItem 
+		ifNil: [ 
+			listPresenter items 
+				ifNotEmpty: [ :items | items first ]
+				ifEmpty: [ nil ] ]
+]
+
+{ #category : 'updating' }
+StClyMessageListPresenter >> switchScopeTo: aScope [
+
+	query ifNil: [ ^ self ].
+	query := query withScope: aScope.
+	self updateMessages
+]
+
+{ #category : 'updating' }
+StClyMessageListPresenter >> updateMessages [
+
+	self messages: (self query execute items collect: [ :each | each actualObject ])
+]
+
+{ #category : 'updating' }
+StClyMessageListPresenter >> updateScopeList [
+
+	self selectedMessageOrFirst ifNil: [ ^ self ].
+	self scopes: self allNavigationScopes
+]
diff --git a/src/NewTools-MethodBrowsers/StClyOldMessageBrowserAdapter.class.st b/src/NewTools-MethodBrowsers/StClyOldMessageBrowserAdapter.class.st
new file mode 100644
index 000000000..2771c7270
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StClyOldMessageBrowserAdapter.class.st
@@ -0,0 +1,168 @@
+Class {
+	#name : 'StClyOldMessageBrowserAdapter',
+	#superclass : 'Object',
+	#instVars : [
+		'messages',
+		'title',
+		'autoSelect',
+		'refreshingBlock',
+		'openedBrowser'
+	],
+	#category : 'NewTools-MethodBrowsers-Senders',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Senders'
+}
+
+{ #category : 'tools registration' }
+StClyOldMessageBrowserAdapter class >> beDefaultBrowser [
+	<script>
+	
+	self registerToolsOn: Smalltalk tools
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter class >> browse: methods [
+	
+	^ self new
+		messages: methods;
+		open
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter class >> browse: methods title: aString [
+
+	^ self new
+		messages: methods;
+		title: aString;
+		open
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter class >> browse: methods title: aString highlight: aSelectString [
+
+	^ self new
+		messages: methods;
+		title: aString;
+		autoSelect: aSelectString;
+		open
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter class >> browseClasses: classes [
+
+	^ StClyQueryBrowser openOn: (ClyConstantQuery returning: classes)
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter class >> browseImplementorsOf: aSymbol inNameResolver: methodContext [
+
+	^ StClyQueryBrowser openOn: (ClyMessageImplementorsQuery of: aSymbol)
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter class >> browseSendersOf: aSymbol [
+
+	^ StClyQueryBrowser openOn: (ClyMessageSendersQuery of: aSymbol)
+]
+
+{ #category : 'instance creation' }
+StClyOldMessageBrowserAdapter class >> on: aNavigationEnvironment systemScope: aScope [ 
+	
+	^ StClyQueryBrowser on: aNavigationEnvironment systemScope: aScope
+]
+
+{ #category : 'tools registration' }
+StClyOldMessageBrowserAdapter class >> registerToolsOn: registry [
+	"Add ourselves to registry. See [Smalltalk tools]"
+
+	registry register: self as: #messageList
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> autoSelect [
+
+	^ autoSelect
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> autoSelect: anObject [
+
+	autoSelect := anObject
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter >> close [
+
+	openedBrowser ifNil: [ ^ self ].
+	openedBrowser close
+]
+
+{ #category : 'highlighting' }
+StClyOldMessageBrowserAdapter >> highlight [ 
+	
+	^ self autoSelect
+]
+
+{ #category : 'highlighting' }
+StClyOldMessageBrowserAdapter >> highlight: aString [ 
+	
+	self autoSelect: aString
+]
+
+{ #category : 'initialization' }
+StClyOldMessageBrowserAdapter >> initialize [
+
+	super initialize.
+	title := 'MessageBrowser'
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> messages [
+
+	^ messages
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> messages: anObject [
+	messages := anObject
+]
+
+{ #category : 'opening' }
+StClyOldMessageBrowserAdapter >> open [
+	| query methods comments |
+
+	methods := messages
+		select: [:each | (each isRingObject and: [ each isMethod ]) or: [ each isCompiledMethod  ] ]
+		thenCollect: [ :each | each compiledMethod ].
+	comments := messages
+		select: [:each | each isRingObject and: [ each isComment  ]]
+		thenCollect: [ :each | ClyClassComment of: each realParent ].
+	query := StClyOldMessageBrowserQuery named: title with: methods asOrderedCollection, comments.
+	query
+		criteriaString: autoSelect;
+		criteriaBlock: refreshingBlock.
+
+	openedBrowser := StClyQueryBrowser openOn: query.
+	
+	^ openedBrowser
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> refreshingBlock [
+	^ refreshingBlock
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> refreshingBlock: anObject [
+	refreshingBlock := anObject
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> title [
+	^ title
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserAdapter >> title: anObject [
+	title := anObject
+]
diff --git a/src/NewTools-MethodBrowsers/StClyOldMessageBrowserQuery.class.st b/src/NewTools-MethodBrowsers/StClyOldMessageBrowserQuery.class.st
new file mode 100644
index 000000000..ddd23e98e
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StClyOldMessageBrowserQuery.class.st
@@ -0,0 +1,76 @@
+Class {
+	#name : 'StClyOldMessageBrowserQuery',
+	#superclass : 'ClyConstantMethodQuery',
+	#instVars : [
+		'extraMethods',
+		'criteriaString',
+		'criteriaBlock'
+	],
+	#category : 'NewTools-MethodBrowsers-Senders',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Senders'
+}
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserQuery >> criteriaBlock [
+	^ criteriaBlock
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserQuery >> criteriaBlock: anObject [
+	criteriaBlock := anObject
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserQuery >> criteriaString [
+	^ criteriaString
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserQuery >> criteriaString: anObject [
+	criteriaString := anObject asString
+]
+
+{ #category : 'tools decoration' }
+StClyOldMessageBrowserQuery >> decorateResultMethodEditor: aMethodEditor [
+
+	criteriaString ifNil: [ ^self ].
+
+	aMethodEditor selectStringAsInMessageBrowser: criteriaString
+]
+
+{ #category : 'initialization' }
+StClyOldMessageBrowserQuery >> initialize [
+	super initialize.
+	extraMethods := IdentitySet new
+]
+
+{ #category : 'execution' }
+StClyOldMessageBrowserQuery >> installedMethods [
+
+	| onlyMethods actualMethods |
+	onlyMethods := methods select: [ :each | each isCompiledMethod ].
+
+	actualMethods := self filterInstalledMethods: onlyMethods, extraMethods.
+	^actualMethods, (methods reject: [ :each | each isCompiledMethod ])
+]
+
+{ #category : 'accessing' }
+StClyOldMessageBrowserQuery >> queryElement [
+	
+	^ self criteriaString
+]
+
+{ #category : 'testing' }
+StClyOldMessageBrowserQuery >> selectsMethod: aMethod [
+	| result |
+	(super selectsMethod: aMethod) ifTrue: [ ^true ].
+	criteriaBlock ifNil: [ ^false ].
+
+	extraMethods removeAllSuchThat: [ :each |
+		each calypsoEnvironmentType checkCalypsoItem: each isEqualTo: aMethod].
+
+	result := criteriaBlock value: aMethod.
+	result ifTrue: [ extraMethods add: aMethod ].
+	^result
+]
diff --git a/src/NewTools-MethodBrowsers/StClyQueryBrowser.class.st b/src/NewTools-MethodBrowsers/StClyQueryBrowser.class.st
new file mode 100644
index 000000000..d16ffed1f
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StClyQueryBrowser.class.st
@@ -0,0 +1,265 @@
+"
+A spec based query browser.
+Show in one table result of a system query.
+
+To show query use following method: 
+
+	StClyQueryBrowser openOn: (ClyMessageSenders of: #do:)
+
+I implement more simple API on class side: 
+
+	StClyQueryBrowser browseSendersOf: #do:.
+	StClyQueryBrowser browseImplementorsOf: #do:.
+	StClyQueryBrowser browseMethods: {Point>>#x. Point>>#y}.
+
+Last method is suitable to show given list of methods. But normally users should use first class queries.
+
+I provide scoping mechanizm: user can filter query result using scopes from the compobox in toolbar.
+
+When I spawned from the browser I receive all its navigation scopes.
+For full browser I receive current selection package and class scopes.
+For query browser I inherit all scopes which it has.
+Also I add extra scopes to my scope list which is based on my current selection.
+For example selected method will bring extra class and package scopes of this method.  
+"
+Class {
+	#name : 'StClyQueryBrowser',
+	#superclass : 'StMessageBrowser',
+	#instVars : [
+		'navigationHistory',
+		'navigationEnvironment',
+		'systemScope',
+		'queryScopes',
+		'systemQuery',
+		'activeScope'
+	],
+	#classVars : [
+		'DefaultQueryResult'
+	],
+	#category : 'NewTools-MethodBrowsers-Senders',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Senders'
+}
+
+{ #category : 'tools registration' }
+StClyQueryBrowser class >> beDefaultBrowser [
+	<script>
+
+	^ StClyOldMessageBrowserAdapter beDefaultBrowser
+]
+
+{ #category : 'instance creation' }
+StClyQueryBrowser class >> browseImplementorsOf: aSymbol inNameResolver: methodContext [
+
+	^ self openOn: (ClyMessageImplementorsQuery of: aSymbol)
+]
+
+{ #category : 'instance creation' }
+StClyQueryBrowser class >> browseMethods: methods [
+
+	^ self openOn: (ClyConstantMethodQuery with: methods)
+]
+
+{ #category : 'instance creation' }
+StClyQueryBrowser class >> browseSendersOf: aSymbol [
+
+	^ self openOn: (ClyMessageSendersQuery of: aSymbol)
+]
+
+{ #category : 'default' }
+StClyQueryBrowser class >> defaultQueryResult [
+
+	^ DefaultQueryResult ifNil: [
+		DefaultQueryResult := ClyHierarchicalSystemItemsResult new ]
+]
+
+{ #category : 'instance creation' }
+StClyQueryBrowser class >> on: navigationEnvironment [
+
+	^ self basicNew
+		application: self currentApplication;
+		navigationEnvironment: navigationEnvironment;
+		initialize;
+		yourself
+]
+
+{ #category : 'instance creation' }
+StClyQueryBrowser class >> on: aNavigationEnvironment scopes: scopes [
+
+	^(self on: aNavigationEnvironment) queryScopes: scopes
+]
+
+{ #category : 'instance creation' }
+StClyQueryBrowser class >> on: navigationEnvironment systemScope: systemScope [
+
+	^ (self on: navigationEnvironment)
+		systemScope: systemScope;
+		initialize;
+		yourself
+]
+
+{ #category : 'instance creation' }
+StClyQueryBrowser class >> openOn: aQuery [
+	| browser |
+	
+	browser := self on: ClyNavigationEnvironment currentImage.
+	browser showResultOf: aQuery.
+	^ browser open
+]
+
+{ #category : 'icons' }
+StClyQueryBrowser class >> taskbarIconName [
+	"Answer the icon for an instance of the receiver in a task bar"
+
+	^ #references
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> changeStateBy: aBlock [
+	
+	aBlock value.
+	self updateWindowTitle
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> disablePluginsWhichAreNotIn: aClyFullBrowser [
+	"do nothing for now"
+]
+
+{ #category : 'initialization' }
+StClyQueryBrowser >> initialize [
+
+	queryScopes := OrderedCollection new.
+	navigationHistory := ClyNavigationHistory new.
+	super initialize
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> navigationEnvironment [
+
+	^ navigationEnvironment
+]
+
+{ #category : 'initialization' }
+StClyQueryBrowser >> navigationEnvironment: aNavigationEnvironment [
+
+	navigationEnvironment := aNavigationEnvironment
+]
+
+{ #category : 'initialization' }
+StClyQueryBrowser >> newMessageList [
+
+	^ (self instantiate: StClyMessageListPresenter)
+		navigationEnvironment: self navigationEnvironment;
+		yourself
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> prepareInitialStateBy: aBlock [
+	
+	navigationHistory ignoreNavigationDuring: [  
+		aBlock valueWithPossibleArgument: self ]
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> queryScopes: aCollection [
+
+	queryScopes := (aCollection
+		reject: [ :each | each isBasedOnEmptyBasis ])
+		as: OrderedCollection.
+		
+	messageList scopes: queryScopes.
+	
+	self updatePresenter
+]
+
+{ #category : 'navigation' }
+StClyQueryBrowser >> recordNavigationState: aBrowserNavigationState [
+
+	navigationHistory recordState: aBrowserNavigationState
+]
+
+{ #category : 'execution' }
+StClyQueryBrowser >> requiredQueryResult [
+
+	^systemQuery
+		ifNil: [ self class defaultQueryResult ]
+		ifNotNil: [ systemQuery requiredResult ]
+]
+
+{ #category : 'selection' }
+StClyQueryBrowser >> selectLastItem [
+	
+	messageList listPresenter selectIndex: messageList listPresenter items size
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> setUpActiveScope [
+
+	systemQuery isBoundToEnvironment 
+		ifFalse: [ systemQuery := systemQuery withScope: self systemScope ].
+	(queryScopes includes: systemQuery scope) 
+		ifFalse: [ queryScopes add: systemQuery scope ].
+	activeScope := systemQuery scope
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> showQueryResult [
+	"self showsFlatResult ifTrue: [
+		""Browser keeps flat query result in variable
+		to be able switch back to it later from hierarchy mode""
+		expectedFlatQueryResult := systemQuery requiredResult ]."
+
+	self setUpActiveScope.
+	highlight := systemQuery queryElement.
+	messageList 
+		query: systemQuery;
+		scopes: { systemScope };
+		updateMessages.
+	toolbarPresenter updatePresenter
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> showResultOf: aQuery [
+	"If given query has specific result then browser will show it as requested.
+	Otherwise it will force query to build currently configured required result
+	(when given query has no explicitly specified result which means it has only default value)"
+
+	self changeStateBy: [
+		systemQuery := aQuery buildsDefaultResult
+			ifTrue: [ aQuery withResult: self requiredQueryResult ]
+			ifFalse: [ aQuery ].
+		self showQueryResult ]
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> systemScope [
+	
+	^ systemScope ifNil: [ systemScope := navigationEnvironment systemScope ]
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> systemScope: aSystemScope [
+
+	systemScope := aSystemScope
+]
+
+{ #category : 'initialization' }
+StClyQueryBrowser >> updatePresenter [
+
+	super updatePresenter.
+	messageList updatePresenter.
+	toolbarPresenter updatePresenter
+]
+
+{ #category : 'activation' }
+StClyQueryBrowser >> updateWindowTitle [
+	
+	self title: systemQuery description
+]
+
+{ #category : 'accessing' }
+StClyQueryBrowser >> wasSpawnedFrom: aBrowser [
+
+	self recordNavigationState: (ClyAccrossWindowNavigationState from: aBrowser)
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageBrowseFullCommand.class.st b/src/NewTools-MethodBrowsers/StMessageBrowseFullCommand.class.st
new file mode 100644
index 000000000..e9adcfaea
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageBrowseFullCommand.class.st
@@ -0,0 +1,28 @@
+"
+Browse full method from a message browser list
+"
+Class {
+	#name : 'StMessageBrowseFullCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StMessageBrowseFullCommand class >> defaultName [
+
+	^ 'Browse full'
+]
+
+{ #category : 'accessing' }
+StMessageBrowseFullCommand class >> defaultShortcut [
+
+	^ $b actionModifier
+]
+
+{ #category : 'executing' }
+StMessageBrowseFullCommand >> execute [
+	
+	context doBrowseMethod
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageBrowser.class.st b/src/NewTools-MethodBrowsers/StMessageBrowser.class.st
new file mode 100644
index 000000000..8b63df04c
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageBrowser.class.st
@@ -0,0 +1,652 @@
+"
+A MessageBrowser is a UI to browse a list of method, regardless of what they could be.
+
+example: 
+
+MessageBrowser new
+	open;
+	messages: (SystemNavigation new allSendersOf: #at:)
+	yourself
+"
+Class {
+	#name : 'StMessageBrowser',
+	#superclass : 'StAbstractMessageCentricBrowserPresenter',
+	#instVars : [
+		'title',
+		'refreshingBlock',
+		'textPresenter',
+		'highlight'
+	],
+	#classVars : [
+		'UsingLayout'
+	],
+	#category : 'NewTools-MethodBrowsers-Senders',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Senders'
+}
+
+{ #category : 'tools registration' }
+StMessageBrowser class >> beDefaultBrowser [
+	<script>
+	
+	self registerToolsOn: Smalltalk tools
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browse: aCollection [
+	"Special Version that sets the correct refreshing Block for Implentors Browser"
+	^ self new
+		messages: aCollection;
+		open
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browse: aCollection asImplementorsOf: aSymbol [ 
+	"Special Version that sets the correct refreshing Block for Implentors Browser"
+
+	^ self new
+		setRefreshingBlockForImplementorsOf: aSymbol;
+		messages: aCollection;
+		title: 'Implementors of ', aSymbol printString;
+		open
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browse: aCollection asSendersOf: aSymbol [ 
+	"Special Version that sets the correct refreshing Block for Senders Browser"
+
+	^ self new
+		setRefreshingBlockForSendersOf: aSymbol;
+		highlight: aSymbol;
+		messages: aCollection;
+		title: 'Senders of ', aSymbol printString;
+		open
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browse: aCollection title: aString [
+	"Special Version that sets the correct refreshing Block for Implentors Browser"
+
+	^ self new
+		messages: aCollection;
+		title: aString;
+		open
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browse: aCollection title: aString autoSelect: aSelectString [
+	
+	self 
+		deprecated: 'Use browse:title:highlight:' 
+		transformWith: '`@receiver browse: `@arg1 title: `@arg2 autoSelect: `@arg3' 
+			-> '`@receiver browse: `@arg1 title: `@arg2 highlight: `@arg3'
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browse: aCollection title: aString highlight: aSelectString [
+	"Special Version that sets the correct refreshing Block for Implentors Browser"
+	
+	^ self new
+		messages: aCollection;
+		title: aString;
+		highlight: aSelectString;
+		open
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browseImplementorsOf: aSymbol [ 
+	"Special Version that sets the correct refreshing Block for Implentors Browser"
+	
+	^ self browse: aSymbol implementors asImplementorsOf: aSymbol
+]
+
+{ #category : 'instance creation' }
+StMessageBrowser class >> browseSendersOf: aSymbol [
+	"Special Version that sets the correct refreshing Block for Implentors Browser"
+
+	^ self browse: aSymbol senders asSendersOf: aSymbol
+]
+
+{ #category : 'instance creation - old' }
+StMessageBrowser class >> openMessageList: messageList name: aString autoSelect: aSelector refreshingBlockSelector: aRefreshingBlockSelector [
+	
+	| browser |
+	browser := self new
+		messages: messageList;
+		title: aString;
+		autoSelect: aSelector;
+		yourself.
+		
+	aRefreshingBlockSelector ifNotNil:[(browser perform: aRefreshingBlockSelector with: aSelector)].
+	^browser open
+	
+				
+
+]
+
+{ #category : 'tool registration' }
+StMessageBrowser class >> registerToolsOn: registry [
+
+	"Add ourselves to registry. See [Smalltalk tools]" 
+	registry register: self as: #messageList
+]
+
+{ #category : 'icons' }
+StMessageBrowser class >> taskbarIconName [
+	"Answer the icon for an instance of the receiver in a task bar"
+
+	^#references
+]
+
+{ #category : 'specs' }
+StMessageBrowser class >> title [
+	^ 'Message Browser'
+]
+
+{ #category : 'private' }
+StMessageBrowser class >> usingLayout [
+
+	^ UsingLayout ifNil: [ UsingLayout := #horizontalLayout ]
+]
+
+{ #category : 'private' }
+StMessageBrowser class >> usingLayout: aSymbol [
+
+	UsingLayout := aSymbol
+]
+
+{ #category : 'private' }
+StMessageBrowser >> accept: text notifying: notifyer [
+
+	^ self selectedMessage ifNotNil: [ :message | 
+		message methodClass 
+			compile: text 
+			classified: message protocol
+			notifying: notifyer ]
+]
+
+{ #category : 'private' }
+StMessageBrowser >> addHighlightedSegments [
+	| message highlightInterval |
+
+	message := self selectedMessage.
+	message ifNil: [ ^ self ].
+	
+	highlightInterval := (self isMethodDefinition: message)
+		ifFalse: [ self intervalOf: highlight inCommentText: textPresenter text ] 
+		ifTrue: [ self intervalOf: highlight inCode: textPresenter text of: message ].
+		
+	textPresenter addTextSegmentDecoration: (SpTextPresenterDecorator forHighlight 
+		interval: (highlightInterval first to: highlightInterval last + 1);
+		yourself)
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> classRenamed: anAnnouncement [ 
+	"this method forces the announcement to be handled in the UI process"
+	self defer: [ 
+		self handleClassRenamed: anAnnouncement ]
+]
+
+{ #category : 'initialization' }
+StMessageBrowser >> connectPresenters [
+	
+	messageList
+		whenSelectionChangedDo: [ :selection | self selectItem: selection selectedItem ];
+		whenModelChangedDo: [ self updateTitle ].
+		
+	textPresenter 
+		whenSubmitDo: [ :text | self accept: text notifying: nil ];
+		whenResetDo: [ self selectItem: messageList selectedMessage ]	
+]
+
+{ #category : 'api - focus' }
+StMessageBrowser >> defaultKeyboardFocus [
+
+	^ messageList
+]
+
+{ #category : 'layout' }
+StMessageBrowser >> defaultLayout [
+
+	^ self perform: self class usingLayout
+]
+
+{ #category : 'text selection' }
+StMessageBrowser >> findFirstOccurrenceOf: searchedString in: textToSearchIn [
+	"Return the first index of aString in textToSearchIn "
+	| firstIndex |
+	firstIndex := textToSearchIn findString: searchedString startingAt: 1.
+	[ (firstIndex > 1) and: [ (textToSearchIn at: (firstIndex - 1)) isAlphaNumeric ] ]
+		whileTrue: [
+			firstIndex := textToSearchIn findString: searchedString startingAt: firstIndex +1 ].
+		
+	^ firstIndex
+]
+
+{ #category : 'private' }
+StMessageBrowser >> flipLayout [
+
+	self class usingLayout: ((self class usingLayout = #horizontalLayout)
+		ifTrue: [ #verticalLayout ]
+		ifFalse: [ #horizontalLayout ]).
+		
+	self layout: self defaultLayout
+	
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> handleClassRenamed: anAnnouncement [
+	| items selectedIndex |
+
+	items := self messages
+		collect: [ :method | 
+			| interestedClassName interestedClass |
+			interestedClassName := anAnnouncement oldName.
+			interestedClass := anAnnouncement classRenamed.
+			method  methodClass isClassSide
+				ifTrue: [ interestedClassName := interestedClassName , ' class'.
+					interestedClass := interestedClass classSide ].
+			method methodClass name = interestedClassName
+				ifTrue: [ interestedClass >> method selector ]
+				ifFalse: [ method ] ].
+	selectedIndex := messageList selectedIndex.
+	self messages: items
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> handleMethodAdded: anAnnouncement [
+	| item sel text boolean |
+
+	self isDisplayed ifFalse: [ ^ self ].
+	refreshingBlock ifNil: [ ^ self ].
+	
+	item := anAnnouncement method.
+	
+	(self shouldRefreshItem: item fromAnnouncement: anAnnouncement) ifFalse: [ ^ self ].
+	((item methodClass notNil) and:[item methodClass isObsolete not]) ifFalse: [ ^ self ].
+	
+	boolean := textPresenter hasUnacceptedEdits.
+	boolean ifTrue: [ text := textPresenter pendingText ].
+	
+	sel := self selectedMessage.
+	self messages: (self messages add: item asFullRingDefinition; yourself).
+	self selectedMessage: sel.
+	
+	boolean ifTrue: [ textPresenter pendingText: text ]
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> handleMethodModified: anAnnouncement [
+	| item oldItem sel index text list edits |
+	
+	self isDisplayed ifFalse: [ ^ self ].
+	
+	refreshingBlock ifNil: [ ^ self ].
+	item := anAnnouncement newMethod.
+	oldItem := anAnnouncement oldMethod.
+	sel := self selectedMessage.
+	sel ifNil: [ ^ self ].
+	(sel methodClass = oldItem methodClass
+		and: [ sel selector = oldItem selector ])
+		ifFalse: [ ^ self ].
+	(self shouldRefreshItem: item fromAnnouncement: anAnnouncement)
+		ifFalse: [ ^ self ].
+	
+	edits := textPresenter hasUnacceptedEdits.
+	edits ifTrue: [ 
+		text := textPresenter pendingText ].
+	index := messageList selectedIndex.
+	list := self messages
+		remove: sel ifAbsent: [  ];
+		add: item asFullRingDefinition;
+		"to ensure it's still a RGMethod"
+			yourself.
+	self messages: list.
+	self selectIndex: index.
+	edits ifFalse: [ ^ self ].
+	
+	textPresenter pendingText: text.
+	textPresenter hasEditingConflicts: true
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> handleMethodRemoved: anAnnouncement [
+	| item selection removeItem |
+
+	self isDisplayed ifFalse: [ ^ self ].
+	refreshingBlock ifNil: [ ^ self ].
+	self okToChange ifFalse: [ ^ self ].
+
+	"Item is a compiled methed, where the list is populated with RGMethod"
+	item := anAnnouncement method.
+	(item methodClass notNil and: [ item methodClass isObsolete not ])
+		ifFalse: [ ^ self ].
+	selection := messageList selectedIndex.
+	removeItem := self selectedMessage.
+
+	self messages: (self messages
+		remove: item ifAbsent: [ nil ];
+		yourself).
+	self selectIndex: (selection min: self messages size)
+]
+
+{ #category : 'text selection' }
+StMessageBrowser >> highlight: aSelector [
+
+	highlight := aSelector.
+	self addHighlightedSegments
+
+]
+
+{ #category : 'layout' }
+StMessageBrowser >> horizontalLayout [
+
+	^ SpBoxLayout newTopToBottom
+		add: toolbarPresenter expand: false;
+		add: (SpPanedLayout newLeftToRight
+			add: messageList;
+			add: (SpBoxLayout newTopToBottom
+				add: textPresenter;
+				yourself);
+			yourself);
+		yourself
+]
+
+{ #category : 'initialization' }
+StMessageBrowser >> initialize [
+
+	super initialize.
+	self registerToAnnouncements
+]
+
+{ #category : 'initialization' }
+StMessageBrowser >> initializeDropList [
+
+	toolbarPresenter 
+		addItemLabeled: 'Source' do: [ self textConverter: SourceMethodConverter new ];
+		addItemLabeled: 'Time stamp' do: [ self textConverter: TimeStampMethodConverter new ]
+]
+
+{ #category : 'initialization' }
+StMessageBrowser >> initializePresenters [
+
+	super initializePresenters.
+
+	textPresenter := self newCode.
+	refreshingBlock := [ :item | true ].
+
+	self initializeDropList
+]
+
+{ #category : 'initialization' }
+StMessageBrowser >> initializeWindow: aWindowPresenter [
+
+	super initializeWindow: aWindowPresenter.
+	aWindowPresenter
+		title: self title;
+		windowIcon: (self iconNamed: self class taskbarIconName)
+]
+
+{ #category : 'private' }
+StMessageBrowser >> installIconStylerFor: anItem [
+	"icons styler are only supported for method definitions (not nil / not for comment definitions    
+	 (those may occure for comment or general string searches))"
+
+	(self isMethodDefinition: anItem)
+		ifFalse: [ ^ self ].
+	
+	IconStyler withStaticStylers 
+		styleText: textPresenter 
+		withAst: anItem ast.
+]
+
+{ #category : 'private' }
+StMessageBrowser >> intervalOf: aSelector inCode: aText of: aMethod [
+
+	aMethod compiledMethod ifNil: [  ^ 0 to: 0 ].
+	^ (self sourceIntervalOf: aSelector in: aMethod ast) 
+		ifEmpty: [ self searchedString: aSelector asString in: aText ]
+]
+
+{ #category : 'private' }
+StMessageBrowser >> intervalOf: aSelector inCommentText: aText [
+	^ self searchedString: aSelector asString in: aText
+]
+
+{ #category : 'api' }
+StMessageBrowser >> messages [
+	^ messageList messages
+]
+
+{ #category : 'api' }
+StMessageBrowser >> messages: aCollection [
+
+	messageList messages: aCollection
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> methodAdded: anAnnouncement [
+	"this method forces the announcement to be handled in the UI process"
+	self defer: [ 
+		self handleMethodAdded: anAnnouncement ]
+]
+
+{ #category : 'private' }
+StMessageBrowser >> methodClassNameForItem: anItem [
+	^ anItem methodClass ifNotNil: [ :class | class name ] ifNil: [ '' ]
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> methodModified: anAnnouncement [
+	"this method forces the announcement to be handled in the UI process"
+	self defer:  [	
+		self handleMethodModified: anAnnouncement ]
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> methodRemoved: anAnnouncement [
+	"this method forces the announcement to be handled in the UI process"
+	self defer:  [ 
+		self handleMethodRemoved: anAnnouncement ]
+]
+
+{ #category : 'initialization' }
+StMessageBrowser >> newMessageToolbar [
+
+	^ (self instantiate: StMessageToolbarPresenter)
+		whenFlipLayoutDo: [ self flipLayout ];
+		yourself
+]
+
+{ #category : 'private' }
+StMessageBrowser >> packageNameForItem: anItem [
+	^ anItem package ifNil: [ '' ] ifNotNil: [ :package | package name ]
+]
+
+{ #category : 'api' }
+StMessageBrowser >> refreshingBlock: aBlock [
+	refreshingBlock := aBlock
+]
+
+{ #category : 'announcements - registration' }
+StMessageBrowser >> registerToAnnouncements [
+
+	SystemAnnouncer uniqueInstance weak		
+		when: MethodAdded send: #methodAdded: to: self;
+		when: MethodModified send: #methodModified: to: self;
+		when: MethodRemoved send: #methodRemoved: to: self;
+		when: ClassRenamed send: #classRenamed: to: self
+]
+
+{ #category : 'text selection' }
+StMessageBrowser >> searchedString: searchedString in: aString [
+	"Return the interval that corresponds to the portion of aString "
+	"This method takes care of finding complete match to searchedString. "
+	| string interval firstIndex |
+	
+	searchedString ifNil: [ ^ 0 to: 0 ].
+	aString isEmptyOrNil ifTrue: [ ^0 to: 0 ].
+	string := aString asString.
+	interval := 0 to: 0.
+	
+	(searchedString includes: $:)
+		ifTrue: [ | list |
+			list := searchedString substrings: ':'.
+			list size = 1
+				ifTrue: [" binary selector "
+					firstIndex := self findFirstOccurrenceOf: searchedString in: string.
+					firstIndex isZero
+						ifFalse: [ interval := firstIndex to: (firstIndex+searchedString size-1) ] ] 
+					
+				ifFalse: [
+					| lastIndex |
+					firstIndex := self findFirstOccurrenceOf: list first, ':' in: string. 
+					firstIndex >0 ifTrue: [ 
+								lastIndex := string findString: list last,':' startingAt: firstIndex+ (list first size -1).
+								interval := firstIndex to: (lastIndex + list last size) ] ] ]
+		ifFalse: [
+			" unary selector "
+			firstIndex := self findFirstOccurrenceOf: searchedString in: string.
+			 firstIndex > 0
+						ifTrue: [ interval := firstIndex to: (firstIndex+searchedString size - 1) ] ].
+	^ interval
+]
+
+{ #category : 'api' }
+StMessageBrowser >> selectIndex: anIndex [
+	messageList selectIndex: anIndex
+]
+
+{ #category : 'private' }
+StMessageBrowser >> selectItem: item [
+	| text |
+
+	toolbarPresenter method: item.
+	textPresenter beForMethod: item.
+	text := (self textConverter
+		method: item;
+		getText).
+	textPresenter text: text.
+
+	highlight ifNotNil: [ self addHighlightedSegments ].
+		
+	self installIconStylerFor: item
+]
+
+{ #category : 'accessing' }
+StMessageBrowser >> selectedClass [
+	^ self selectedMethod origin
+]
+
+{ #category : 'api' }
+StMessageBrowser >> selectedMessage: aMessage [
+	messageList selectMessage: aMessage
+]
+
+{ #category : 'accessing' }
+StMessageBrowser >> selectedMethod [
+	^ messageList selectedMethod
+]
+
+{ #category : 'api' }
+StMessageBrowser >> setRefreshingBlockForImplementorsOf: aSelector [
+	self refreshingBlock: [ :message | message selector = aSelector ]
+]
+
+{ #category : 'api' }
+StMessageBrowser >> setRefreshingBlockForSendersOf: aSelector [
+	| specialIndex |
+	specialIndex := Smalltalk specialSelectorIndexOrNil: aSelector.
+	self refreshingBlock: [:method | 
+		method hasSelector: aSelector specialSelectorIndex: specialIndex ]
+]
+
+{ #category : 'announcements' }
+StMessageBrowser >> shouldRefreshItem: item fromAnnouncement: anAnnouncement [
+	"The refreshing block contains a block that accepts an item of the list, the received announcement and the message browser.
+	It will anwer a boolean indicating if the modified item should be refreshed.
+	
+	Concretely, this is used to know if the contents of the selected message should be refreshed"
+
+	^ refreshingBlock cull: item cull: anAnnouncement cull: self
+]
+
+{ #category : 'api' }
+StMessageBrowser >> sortingBlock: aBlock [
+	messageList sortingBlock: aBlock
+]
+
+{ #category : 'text selection' }
+StMessageBrowser >> sourceIntervalOf: aSelector in: aMethodNode [
+    | senderNode |
+    senderNode := aMethodNode allChildren detect: [ :x | x isMessage and: [ x selector = aSelector ] ] ifNone: [ ^ #() ].
+    ^ senderNode keywordsPositions first to: senderNode keywordsPositions last + senderNode keywords last size - 1 
+]
+
+{ #category : 'accessing' }
+StMessageBrowser >> textConverter: aTextConverter [
+
+	super textConverter: aTextConverter.
+	textPresenter syntaxHighlight: self textConverter shouldShout .
+	textPresenter text: self textConverter getText.
+]
+
+{ #category : 'private' }
+StMessageBrowser >> title [
+
+	^ (title ifNil: [ self class title ]), ' [' , messageList numberOfElements printString , ']'
+]
+
+{ #category : 'accessing' }
+StMessageBrowser >> title: aString [
+
+	title := aString.
+	self updateTitle
+]
+
+{ #category : 'accessing' }
+StMessageBrowser >> toolbarPresenter [
+	
+	^ toolbarPresenter
+]
+
+{ #category : 'api' }
+StMessageBrowser >> topologicSort [
+	^ messageList topologicSort
+]
+
+{ #category : 'api' }
+StMessageBrowser >> topologicSort: aBoolean [
+	^ messageList topologicSort: aBoolean
+]
+
+{ #category : 'api' }
+StMessageBrowser >> updateTitle [
+	self withWindowDo: [ :window | window title: self title ]
+]
+
+{ #category : 'layout' }
+StMessageBrowser >> verticalLayout [
+
+	^ SpBoxLayout newTopToBottom
+		add: toolbarPresenter expand: false;
+		add: (SpPanedLayout newTopToBottom
+			add: messageList;
+			add: (SpBoxLayout newTopToBottom
+				add: textPresenter;
+				yourself);
+			yourself);
+		yourself
+]
+
+{ #category : 'api - events' }
+StMessageBrowser >> whenSelectedItemChanged: aBlock [ 
+	messageList whenSelectedItemChanged: aBlock 
+]
+
+{ #category : 'private' }
+StMessageBrowser >> windowIsClosing [
+	
+	SystemAnnouncer uniqueInstance unsubscribe: self
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageBrowserContributor.class.st b/src/NewTools-MethodBrowsers/StMessageBrowserContributor.class.st
new file mode 100644
index 000000000..fce1bf570
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageBrowserContributor.class.st
@@ -0,0 +1,15 @@
+Class {
+	#name : 'StMessageBrowserContributor',
+	#superclass : 'StPharoStyleContributor',
+	#category : 'NewTools-MethodBrowsers-Senders',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Senders'
+}
+
+{ #category : 'styles' }
+StMessageBrowserContributor >> styleSheetContribution [
+	
+	^ SpStyle newApplication 
+		addClass: 'stMessageBrowserScopeList' with: [ :class | class 
+			addPropertyGeometryWith: [ :geo | geo width: 220 ] ]
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageBrowserPresenter.class.st b/src/NewTools-MethodBrowsers/StMessageBrowserPresenter.class.st
index 1ebea5039..4f5ac77fb 100644
--- a/src/NewTools-MethodBrowsers/StMessageBrowserPresenter.class.st
+++ b/src/NewTools-MethodBrowsers/StMessageBrowserPresenter.class.st
@@ -1,545 +1,16 @@
 "
-A MessageBrowser is a UI to browse a list of method, regardless of what they could be.
-
-example: 
-
-MessageBrowser new
-	open;
-	messages: (SystemNavigation new allSendersOf: #at:)
-	yourself
+NOTE: We need to remove this, but first we need to rename usages in image.
 "
 Class {
 	#name : 'StMessageBrowserPresenter',
-	#superclass : 'AbstractMessageCentricBrowserPresenter',
-	#instVars : [
-		'title',
-		'refreshingBlock',
-		'textPresenter'
-	],
+	#superclass : 'StMessageBrowser',
 	#category : 'NewTools-MethodBrowsers-Senders',
 	#package : 'NewTools-MethodBrowsers',
 	#tag : 'Senders'
 }
 
-{ #category : 'instance creation' }
-StMessageBrowserPresenter class >> browse: aCollection [
-	"Special Version that sets the correct refreshing Block for Implentors Browser"
-	^ self new
-		messages: aCollection;
-		open
-]
-
-{ #category : 'instance creation' }
-StMessageBrowserPresenter class >> browse: aCollection asImplementorsOf: aSymbol [ 
-	"Special Version that sets the correct refreshing Block for Implentors Browser"
-	^ self new
-		setRefreshingBlockForImplementorsOf: aSymbol;
-		messages: aCollection;
-		title: 'Implementors of ', aSymbol printString;
-		open
-]
-
-{ #category : 'instance creation' }
-StMessageBrowserPresenter class >> browse: aCollection asSendersOf: aSymbol [ 
-	"Special Version that sets the correct refreshing Block for Senders Browser"
-	^ self new
-		setRefreshingBlockForSendersOf: aSymbol;
-		autoSelect: aSymbol;
-		messages: aCollection;
-		title: 'Senders of ', aSymbol printString;
-		open
-]
-
-{ #category : 'instance creation' }
-StMessageBrowserPresenter class >> browse: aCollection title: aString [
-	"Special Version that sets the correct refreshing Block for Implentors Browser"
-	^ self new
-		messages: aCollection;
-		title: aString;
-		open
-]
-
-{ #category : 'instance creation' }
-StMessageBrowserPresenter class >> browse: aCollection title: aString autoSelect: aSelectString [
-	"Special Version that sets the correct refreshing Block for Implentors Browser"
-	^ self new
-		messages: aCollection;
-		title: aString;
-		autoSelect: aSelectString;
-		open
-]
-
-{ #category : 'instance creation' }
-StMessageBrowserPresenter class >> browseImplementorsOf: aSymbol [ 
-	"Special Version that sets the correct refreshing Block for Implentors Browser"
-	^ self browse: aSymbol implementors asImplementorsOf: aSymbol
-]
-
-{ #category : 'instance creation' }
-StMessageBrowserPresenter class >> browseSendersOf: aSymbol [ 
-	"Special Version that sets the correct refreshing Block for Implentors Browser"
-	^ self browse: aSymbol senders asSendersOf: aSymbol
-]
-
-{ #category : 'instance creation - old' }
-StMessageBrowserPresenter class >> openMessageList: messageList name: aString autoSelect: aSelector refreshingBlockSelector: aRefreshingBlockSelector [
-	
-	| browser |
-	browser := self new
-		messages: messageList;
-		title: aString;
-		autoSelect: aSelector;
-		yourself.
-		
-	aRefreshingBlockSelector ifNotNil:[(browser perform: aRefreshingBlockSelector with: aSelector)].
-	^browser open
-	
-				
-
-]
-
-{ #category : 'tool registration' }
-StMessageBrowserPresenter class >> registerToolsOn: registry [
-
-	"Add ourselves to registry. See [Smalltalk tools]" 
-	registry register: self as: #messageList
-]
-
-{ #category : 'icons' }
-StMessageBrowserPresenter class >> taskbarIconName [
-	"Answer the icon for an instance of the receiver in a task bar"
-
-	^#referencesIcon
-]
-
-{ #category : 'specs' }
-StMessageBrowserPresenter class >> title [
-	^ 'Message Browser'
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> accept: text notifying: notifyer [
-
-	^ self selectedMessage ifNotNil: [ :message | 
-		message methodClass 
-			compile: text 
-			classified: message protocol
-			notifying: notifyer ]
-]
-
-{ #category : 'text selection' }
-StMessageBrowserPresenter >> autoSelect: aSelector [
-	textPresenter
-		readSelectionBlock:
-			[ :text | 
-			self selectedMessage ifNotNil:
-					[ :msg | (self isMethodDefinition: msg)
-						ifFalse: [ self intervalOf: aSelector inCommentText: text ] 
-						ifTrue: [ self intervalOf: aSelector inCode: text of: msg ] ] ]
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> classRenamed: anAnnouncement [ 
-	"this method forces the announcement to be handled in the UI process"
-	self defer: [ 
-		self handleClassRenamed: anAnnouncement ]
-]
-
-{ #category : 'initialization' }
-StMessageBrowserPresenter >> connectPresenters [
-	messageList
-		whenSelectionChangedDo: [ :selection | self selectItem: selection selectedItem ];
-		whenModelChangedDo: [ self updateTitle ].
-	textPresenter whenSubmitDo: [ :text | (self accept: text notifying: nil) notNil ]
-]
-
-{ #category : 'layout' }
-StMessageBrowserPresenter >> defaultLayout [
-
-	^ SpPanedLayout newTopToBottom
-		add: messageList;
-		add: (SpBoxLayout newTopToBottom
-			add: toolbarPresenter expand: false;
-			add: textPresenter;
-			yourself);
-		yourself
-]
-
-{ #category : 'text selection' }
-StMessageBrowserPresenter >> findFirstOccurrenceOf: searchedString in: textToSearchIn [
-	"Return the first index of aString in textToSearchIn "
-	| firstIndex |
-	firstIndex := textToSearchIn findString: searchedString startingAt: 1.
-	[ (firstIndex > 1) and: [ (textToSearchIn at: (firstIndex - 1)) isAlphaNumeric ] ]
-		whileTrue: [
-			firstIndex := textToSearchIn findString: searchedString startingAt: firstIndex +1 ].
-		
-	^ firstIndex
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> handleClassRenamed: anAnnouncement [
-	| items selectedIndex |
-	items := self messages
-		collect: [ :method | 
-			| interestedClassName interestedClass |
-			interestedClassName := anAnnouncement oldName.
-			interestedClass := anAnnouncement classRenamed.
-			method  methodClass isClassSide
-				ifTrue: [ interestedClassName := interestedClassName , ' class'.
-					interestedClass := interestedClass classSide ].
-			method methodClass name = interestedClassName
-				ifTrue: [ interestedClass >> method selector ]
-				ifFalse: [ method ] ].
-	selectedIndex := messageList selectedIndex.
-	self messages: items
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> handleMethodAdded: anAnnouncement [
-	| item sel text boolean |
-
-	self isDisplayed ifFalse: [ ^ self ].
-	refreshingBlock ifNil: [ ^ self ].
-	
-	item := anAnnouncement method.
-	
-	(self shouldRefreshItem: item fromAnnouncement: anAnnouncement) ifFalse: [ ^ self ].
-	((item methodClass notNil) and:[item methodClass isObsolete not]) ifFalse: [ ^ self ].
-	
-	boolean := textPresenter hasUnacceptedEdits.
-	boolean ifTrue: [ text := textPresenter pendingText ].
-	
-	sel := self selectedMessage.
-	self messages: (self messages add: item asFullRingDefinition; yourself).
-	self selectedMessage: sel.
-	
-	boolean ifTrue: [ textPresenter pendingText: text ]
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> handleMethodModified: anAnnouncement [
-	| item oldItem sel index text list edits |
-	self isDisplayed
-		ifFalse: [ ^ self ].
-	refreshingBlock ifNil: [ ^ self ].
-	item := anAnnouncement newMethod.
-	oldItem := anAnnouncement oldMethod.
-	sel := self selectedMessage.
-	sel ifNil: [ ^ self ].
-	(sel methodClass = oldItem methodClass
-		and: [ sel selector = oldItem selector ])
-		ifFalse: [ ^ self ].
-	(self shouldRefreshItem: item fromAnnouncement: anAnnouncement)
-		ifFalse: [ ^ self ].
-	edits := textPresenter hasUnacceptedEdits.
-	edits
-		ifTrue: [ text := textPresenter pendingText ].
-	index := messageList selectedIndex.
-	list := self messages
-		remove: sel ifAbsent: [  ];
-		add: item asFullRingDefinition;
-		"to ensure it's still a RGMethod"
-			yourself.
-	self messages: list.
-	self selectIndex: index.
-	edits
-		ifFalse: [ ^ self ].
-	textPresenter pendingText: text.
-	textPresenter hasEditingConflicts: true
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> handleMethodRemoved: anAnnouncement [
-	| item selection removeItem |
-	self isDisplayed
-		ifFalse: [ ^ self ].
-	refreshingBlock ifNil: [ ^ self ].
-	self okToChange
-		ifFalse: [ ^ self ].
-
-	"Item is a compiled methed, where the list is populated with RGMethod"
-	item := anAnnouncement method.
-	(item methodClass notNil and: [ item methodClass isObsolete not ])
-		ifFalse: [ ^ self ].
-	selection := messageList selectedIndex.
-	removeItem := self selectedMessage.
-	(removeItem notNil
-		and: [ removeItem methodClass = item methodClass
-				and: [ removeItem selector = item selector ] ])
-		ifTrue: [ textPresenter hasUnacceptedEdits: false ].
-	self
-		messages:
-			(self messages
-				remove: item asFullRingDefinition ifAbsent: [ nil ];
-				yourself).
-	self selectIndex: selection
-]
-
-{ #category : 'initialization' }
-StMessageBrowserPresenter >> initialize [
-
-	super initialize.
-	self registerToAnnouncements
-]
-
-{ #category : 'initialization' }
-StMessageBrowserPresenter >> initializeDropList [
-
-	toolbarPresenter 
-		addItemLabeled: 'Source' do: [ self textConverter: SourceMethodConverter new ];
-		addItemLabeled: 'Time stamp' do: [ self textConverter: TimeStampMethodConverter new ]
-]
-
-{ #category : 'initialization' }
-StMessageBrowserPresenter >> initializePresenters [
-	super initializePresenters.
-
-	textPresenter := self newCode.
-	refreshingBlock := [ :item | true ].
-
-	self initializeDropList
-]
-
-{ #category : 'initialization' }
-StMessageBrowserPresenter >> initializeWindow: aWindowPresenter [
-
-	super initializeWindow: aWindowPresenter.
-	aWindowPresenter
-		title: self title;
-		windowIcon: (self application iconNamed: self class taskbarIconName);
-		askOkToClose: true
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> installIconStylerFor: anItem [
-	"icons styler are only supported for method definitions (not nil / not for comment definitions    
-	 (those may occure for comment or general string searches))"
-
-	(self isMethodDefinition: anItem)
-		ifFalse: [ ^ self ].
-	
-	IconStyler withStaticStylers 
-		styleText: textPresenter 
-		withAst: anItem ast.
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> intervalOf: aSelector inCode: aText of: aMethod [
-	aMethod compiledMethod ifNil: [  ^ 0 to: 0 ].
-	^ (self sourceIntervalOf: aSelector in: aMethod ast) ifEmpty: [ self searchedString: aSelector asString in: aText ]
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> intervalOf: aSelector inCommentText: aText [
-	^ self searchedString: aSelector asString in: aText
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> messages [
-	^ messageList messages
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> messages: aCollection [
-	messageList messages: aCollection
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> methodAdded: anAnnouncement [
-	"this method forces the announcement to be handled in the UI process"
-	self defer: [ 
-		self handleMethodAdded: anAnnouncement ]
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> methodClassNameForItem: anItem [
-	^ anItem methodClass ifNotNil: [ :class | class name ] ifNil: [ '' ]
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> methodModified: anAnnouncement [
-	"this method forces the announcement to be handled in the UI process"
-	self defer:  [	
-		self handleMethodModified: anAnnouncement ]
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> methodRemoved: anAnnouncement [
-	"this method forces the announcement to be handled in the UI process"
-	self defer:  [ 
-		self handleMethodRemoved: anAnnouncement ]
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> packageNameForItem: anItem [
-	^ anItem package ifNil: [ '' ] ifNotNil: [ :package | package name ]
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> refreshingBlock: aBlock [
-	refreshingBlock := aBlock
-]
-
-{ #category : 'announcements - registration' }
-StMessageBrowserPresenter >> registerToAnnouncements [
-
-	SystemAnnouncer uniqueInstance weak		
-		when: MethodAdded send: #methodAdded: to: self;
-		when: MethodModified send: #methodModified: to: self;
-		when: MethodRemoved send: #methodRemoved: to: self;
-		when: ClassRenamed send: #classRenamed: to: self
-]
-
-{ #category : 'text selection' }
-StMessageBrowserPresenter >> searchedString: searchedString in: aString [
-	"Return the interval that corresponds to the portion of aString "
-	"This method takes care of finding complete match to searchedString. "
-	| string interval firstIndex |
-	
-	searchedString ifNil: [ ^ 0 to: 0 ].
-	aString isEmptyOrNil ifTrue: [ ^0 to: 0 ].
-	string := aString asString.
-	interval := 0 to: 0.
-	
-	(searchedString includes: $:)
-		ifTrue: [ | list |
-			list := searchedString substrings: ':'.
-			list size = 1
-				ifTrue: [" binary selector "
-					firstIndex := self findFirstOccurrenceOf: searchedString in: string.
-					firstIndex isZero
-						ifFalse: [ interval := firstIndex to: (firstIndex+searchedString size-1) ] ] 
-					
-				ifFalse: [
-					| lastIndex |
-					firstIndex := self findFirstOccurrenceOf: list first, ':' in: string. 
-					firstIndex >0 ifTrue: [ 
-								lastIndex := string findString: list last,':' startingAt: firstIndex+ (list first size -1).
-								interval := firstIndex to: (lastIndex + list last size) ] ] ]
-		ifFalse: [
-			" unary selector "
-			firstIndex := self findFirstOccurrenceOf: searchedString in: string.
-			 firstIndex > 0
-						ifTrue: [ interval := firstIndex to: (firstIndex+searchedString size - 1) ] ].
-	^ interval
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> selectIndex: anIndex [
-	messageList selectIndex: anIndex
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> selectItem: item [
-
-	toolbarPresenter method: item.
-	textPresenter beForMethod: item.
-	textPresenter text: (self textConverter
-		method: item;
-		getText).
-	self installIconStylerFor: item
-]
-
-{ #category : 'accessing' }
-StMessageBrowserPresenter >> selectedClass [
-	^ self selectedMethod origin
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> selectedMessage: aMessage [
-	messageList selectMessage: aMessage
-]
-
-{ #category : 'accessing' }
-StMessageBrowserPresenter >> selectedMethod [
-	^ messageList selectedMethod
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> setRefreshingBlockForImplementorsOf: aSelector [
-	self refreshingBlock: [ :message | message selector = aSelector ]
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> setRefreshingBlockForSendersOf: aSelector [
-	| specialIndex |
-	specialIndex := Smalltalk specialSelectorIndexOrNil: aSelector.
-	self refreshingBlock: [:method | 
-		method hasSelector: aSelector specialSelectorIndex: specialIndex ]
-]
-
-{ #category : 'announcements' }
-StMessageBrowserPresenter >> shouldRefreshItem: item fromAnnouncement: anAnnouncement [
-	"The refreshing block contains a block that accepts an item of the list, the received announcement and the message browser.
-	It will anwer a boolean indicating if the modified item should be refreshed.
-	
-	Concretely, this is used to know if the contents of the selected message should be refreshed"
-
-	^ refreshingBlock cull: item cull: anAnnouncement cull: self
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> sortingBlock: aBlock [
-	messageList sortingBlock: aBlock
-]
-
-{ #category : 'text selection' }
-StMessageBrowserPresenter >> sourceIntervalOf: aSelector in: aMethodNode [
-    | senderNode |
-    senderNode := aMethodNode allChildren detect: [ :x | x isMessage and: [ x selector = aSelector ] ] ifNone: [ ^ #() ].
-    ^ senderNode keywordsPositions first to: senderNode keywordsPositions last + senderNode keywords last size - 1 
-]
-
-{ #category : 'accessing' }
-StMessageBrowserPresenter >> textConverter: aTextConverter [
-
-	super textConverter: aTextConverter.
-	textPresenter syntaxHighlight: self textConverter shouldShout .
-	textPresenter text: self textConverter getText.
-]
-
-{ #category : 'private' }
-StMessageBrowserPresenter >> title [
-
-	^ (title ifNil: [ self class title ]), ' [' , messageList numberOfElements printString , ']'
-]
-
-{ #category : 'accessing' }
-StMessageBrowserPresenter >> title: aString [
-
-	title := aString.
-	self updateTitle
-]
-
-{ #category : 'accessing' }
-StMessageBrowserPresenter >> toolbarPresenter [
-	
-	^ toolbarPresenter
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> topologicSort [
-	^ messageList topologicSort
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> topologicSort: aBoolean [
-	^ messageList topologicSort: aBoolean
-]
-
-{ #category : 'api' }
-StMessageBrowserPresenter >> updateTitle [
-	self withWindowDo: [ :window | window title: self title ]
-]
-
-{ #category : 'api - events' }
-StMessageBrowserPresenter >> whenSelectedItemChanged: aBlock [ 
-	messageList whenSelectedItemChanged: aBlock 
-]
+{ #category : 'testing' }
+StMessageBrowserPresenter class >> isDeprecated [
 
-{ #category : 'private' }
-StMessageBrowserPresenter >> windowIsClosing [
-	
-	SystemAnnouncer uniqueInstance unsubscribe: self
+	^ true
 ]
diff --git a/src/NewTools-MethodBrowsers/StMessageImplementorsCommand.class.st b/src/NewTools-MethodBrowsers/StMessageImplementorsCommand.class.st
new file mode 100644
index 000000000..7a2c24236
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageImplementorsCommand.class.st
@@ -0,0 +1,28 @@
+"
+Browse implementors from a message browser list
+"
+Class {
+	#name : 'StMessageImplementorsCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StMessageImplementorsCommand class >> defaultName [
+
+	^ 'Implementors'
+]
+
+{ #category : 'accessing' }
+StMessageImplementorsCommand class >> defaultShortcut [
+
+	^ $m actionModifier
+]
+
+{ #category : 'executing' }
+StMessageImplementorsCommand >> execute [
+	
+	context doBrowseImplementors
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageInspectMethodCommand.class.st b/src/NewTools-MethodBrowsers/StMessageInspectMethodCommand.class.st
new file mode 100644
index 000000000..4f55b5f66
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageInspectMethodCommand.class.st
@@ -0,0 +1,28 @@
+"
+Inspect selected method from a message browser list
+"
+Class {
+	#name : 'StMessageInspectMethodCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StMessageInspectMethodCommand class >> defaultName [
+
+	^ 'Inspect method'
+]
+
+{ #category : 'accessing' }
+StMessageInspectMethodCommand class >> defaultShortcut [
+
+	^ $i actionModifier
+]
+
+{ #category : 'executing' }
+StMessageInspectMethodCommand >> execute [
+	
+	context doInspectMethod
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageListPresenter.class.st b/src/NewTools-MethodBrowsers/StMessageListPresenter.class.st
new file mode 100644
index 000000000..90b264eab
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageListPresenter.class.st
@@ -0,0 +1,342 @@
+"
+I am a presenter listing messages. 
+
+I am used by more complexe browsers such as MessageBrowser or VersionBrowser.
+	
+ 
+Internal Representation and Key Implementation Points.
+--------------------
+
+    Instance Variables
+	cachedHierarchy:		<aDictionary>	 	A cache keeping info about the level of a class in the list.
+	listModel:				<aListPresenter>	A list presenter to show all the messages.
+	model:						<aTool>				A model grouping generic methods for managing packages/classes/groups/methods from a browser
+	topologySort:			<aBoolean>		 	A boolean to know if we should use a topology sort or not.
+
+"
+Class {
+	#name : 'StMessageListPresenter',
+	#superclass : 'SpPresenter',
+	#instVars : [
+		'cachedHierarchy',
+		'topologySort',
+		'listPresenter'
+	],
+	#category : 'NewTools-MethodBrowsers-Base',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Base'
+}
+
+{ #category : 'layout' }
+StMessageListPresenter class >> defaultLayout [
+
+	^ SpBoxLayout newTopToBottom
+		add: #listPresenter;
+		yourself
+]
+
+{ #category : 'testing' }
+StMessageListPresenter >> buildHierarchyForMessages: messages [
+	| result classes |
+	self topologicSort ifFalse: [ 
+		result := IdentityDictionary new.
+		messages do: [:m | result at: m put: {} ].
+		^ result ].
+	
+	result := Dictionary new.	
+	classes := (messages collect: [ :each | each methodClass ]) asSet.
+	messages do: [:message || level class |
+		class := message methodClass.
+		level := OrderedCollection new.
+		class allSuperclassesDo: [:superClass |
+			(classes includes: superClass)
+				ifTrue: [ level addFirst: superClass ]].
+		level addLast: class.
+		level addLast: message selector.
+		result at: message put: level ].
+	^ result
+]
+
+{ #category : 'testing' }
+StMessageListPresenter >> cacheHierarchyForClasses: aCollection [
+	cachedHierarchy := self buildHierarchyForMessages: aCollection.
+]
+
+{ #category : 'transmission' }
+StMessageListPresenter >> defaultOutputPort [
+
+	^ self outputSelectionPort
+]
+
+{ #category : 'private - actions' }
+StMessageListPresenter >> doBrowseImplementors [
+		
+	self systemNavigation browseAllImplementorsOf: self selectedMethod selector
+]
+
+{ #category : 'private - actions' }
+StMessageListPresenter >> doBrowseMethod [
+		
+	self systemNavigation browse: self selectedMethod
+]
+
+{ #category : 'private - actions' }
+StMessageListPresenter >> doBrowseSenders [
+
+	self systemNavigation browseAllSendersOf: self selectedMethod selector
+]
+
+{ #category : 'private - actions' }
+StMessageListPresenter >> doBrowseUsers [
+		
+	self systemNavigation browseAllUsersOfClassOrTrait: self selectedMethod methodClass
+]
+
+{ #category : 'private - actions' }
+StMessageListPresenter >> doBrowseVersions [
+	
+	self systemNavigation browseVersionsOf: self selectedMethod
+]
+
+{ #category : 'private - actions' }
+StMessageListPresenter >> doInspectMethod [
+	
+	self systemNavigation inspect: self selectedMethod
+]
+
+{ #category : 'private - actions' }
+StMessageListPresenter >> doRemoveMethod [
+
+	self selectedMessage ifNotNil: [ :aMethod |
+		SystemNavigation new 
+			removeMethod: aMethod 
+			inClass: aMethod methodClass ]
+]
+
+{ #category : 'initialization' }
+StMessageListPresenter >> initialize [
+
+	super initialize.
+	topologySort := true
+
+]
+
+{ #category : 'initialization' }
+StMessageListPresenter >> initializePresenters [
+
+	listPresenter := self newTable.
+	listPresenter
+		sortingBlock: [ :a :b | self sortClassesInCachedHierarchy: a b: b ];
+		addColumn: (SpStringTableColumn 
+			title: 'Location' 
+			evaluated: [ :item | self locationOf: item ]);
+		addColumn: (SpStringTableColumn 
+			title: 'Selector' 
+			evaluated: [ :item | self selectorOf: item ]);
+		addColumn: (SpStringTableColumn 
+			title: 'Package' 
+			evaluated: [ :item | self packageOf: item ]);
+		beResizable.
+		
+	listPresenter outputActivationPort transmitDo: [ :aMethod | self doBrowseMethod ].
+		
+	listPresenter 
+		contextMenu: self messageListActions asMenuPresenter;
+		contextKeyBindings: self messageListActions asKMCategory
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> listPresenter [
+
+	^ listPresenter
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> locationOf: anItem [
+
+	^ String streamContents: [ :aStream | 
+		3 to: (cachedHierarchy at: anItem) size do: [ :i | aStream << '    ' ].
+		aStream << (self methodClassNameForItem: anItem) << ' ('.
+		anItem isFromTrait
+			ifTrue: [ aStream
+					<< anItem compiledMethod origin name;
+					space ].
+		aStream << (self protocolNameForItem: anItem) << ')' ]
+]
+
+{ #category : 'private' }
+StMessageListPresenter >> messageListActions [
+	
+	^ CmCommandGroup forSpec
+		beRoot;
+		register: ((CmCommandGroup forSpecNamed: 'View')
+			beDisplayedAsGroup;
+			register: (StMessageBrowseFullCommand forSpecContext: self);
+			register: (StMessageInspectMethodCommand forSpecContext: self);
+			yourself);
+		register: ((CmCommandGroup forSpecNamed: 'Navigation')
+			beDisplayedAsGroup;
+			register: (StMessageSendersCommand forSpecContext: self);
+			register: (StMessageImplementorsCommand forSpecContext: self);
+			register: (StMessageUsersCommand forSpecContext: self);
+			register: (StMessageVersionsCommand forSpecContext: self);
+			yourself);
+		register: ((CmCommandGroup forSpecNamed: 'CRITICAL')
+			beDisplayedAsGroup;
+			register: (StMessageRemoveMethodCommand forSpecContext: self);
+			yourself);
+		yourself
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> messages [
+
+	^ listPresenter items
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> messages: aCollection [
+
+	self cacheHierarchyForClasses: aCollection.
+	listPresenter items: cachedHierarchy keys asOrderedCollection.
+	listPresenter listSize > 0 ifTrue: [ 
+		listPresenter selectIndex: 1 ]
+]
+
+{ #category : 'private' }
+StMessageListPresenter >> methodClassNameForItem: anItem [
+	^ anItem methodClass ifNotNil: [ :class | class name ] ifNil: [ '' ]
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> numberOfElements [
+
+	^ listPresenter listSize
+]
+
+{ #category : 'transmission' }
+StMessageListPresenter >> outputActivationPort [
+
+	^ (SpActivationPort newPresenter: self)
+		delegateTo: [ listPresenter ];
+		yourself
+]
+
+{ #category : 'transmission' }
+StMessageListPresenter >> outputSelectionPort [
+
+	^ (SpSelectionPort newPresenter: self)
+		delegateTo: [ listPresenter ];
+		yourself
+]
+
+{ #category : 'private' }
+StMessageListPresenter >> packageNameForItem: anItem [
+	^ anItem package ifNil: [ '' ] ifNotNil: [ :package | package name ]
+]
+
+{ #category : 'private' }
+StMessageListPresenter >> packageOf: anItem [
+	^ '[' , (self packageNameForItem: anItem) , ']'
+]
+
+{ #category : 'private' }
+StMessageListPresenter >> protocolNameForItem: anItem [
+
+	^ anItem protocolName ifNil: [ '' ]
+]
+
+{ #category : 'selecting' }
+StMessageListPresenter >> selectIndex: anInteger [
+
+	listPresenter selectIndex: anInteger
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> selectMessage: aMessage [
+
+	listPresenter selectItem: aMessage
+]
+
+{ #category : 'selecting' }
+StMessageListPresenter >> selectedIndex [
+
+	^ listPresenter selection selectedIndex
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> selectedMessage [
+
+	^ listPresenter selection selectedItem
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> selectedMethod [
+
+	self selectedMessage ifNil: [ ^ nil ].
+	^ self selectedMessage compiledMethod
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> selectorOf: anItem [
+
+	^ anItem selector
+]
+
+{ #category : 'initialization' }
+StMessageListPresenter >> setModelBeforeInitialization: aMethod [
+]
+
+{ #category : 'sorting' }
+StMessageListPresenter >> sortClassesInCachedHierarchy: aMethodDefinition b: otherMethodDefinition [
+	"This method checks wether the cached inheritance hierarchy of a method should be before than the one of another method.
+	It compares alphabetically the hierarchy using #compare:
+	If both are alphabetically equals, it uses the size the hierarchy.
+	We do not know why this is done like this."
+	| aMethodHierarchy otherMethodHierarchy minSize|
+	aMethodHierarchy := cachedHierarchy at: aMethodDefinition.
+	otherMethodHierarchy := cachedHierarchy at: otherMethodDefinition.
+	
+	minSize := aMethodHierarchy size min: otherMethodHierarchy size.
+	
+	1 to: minSize do: [ :i | |compare|
+		compare := (aMethodHierarchy at: i) printString compare: (otherMethodHierarchy at: i) printString.
+		compare ~~ 2
+			ifTrue: [  ^ compare == 1 ]].
+	^  aMethodHierarchy size < otherMethodHierarchy size
+]
+
+{ #category : 'api' }
+StMessageListPresenter >> sortingBlock: aBlock [
+
+	listPresenter sortingBlock: aBlock
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> topologicSort [
+
+	^ topologySort
+]
+
+{ #category : 'accessing' }
+StMessageListPresenter >> topologicSort: anObject [
+
+	topologySort := anObject
+]
+
+{ #category : 'api - events' }
+StMessageListPresenter >> whenModelChangedDo: aBlock [
+	listPresenter whenModelChangedDo: aBlock
+]
+
+{ #category : 'api - events' }
+StMessageListPresenter >> whenSelectedDo: aBlock [
+
+	listPresenter whenSelectedDo: aBlock
+]
+
+{ #category : 'api - events' }
+StMessageListPresenter >> whenSelectionChangedDo: aBlock [
+
+	listPresenter whenSelectionChangedDo: aBlock
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageRemoveMethodCommand.class.st b/src/NewTools-MethodBrowsers/StMessageRemoveMethodCommand.class.st
new file mode 100644
index 000000000..ffe8cc4fb
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageRemoveMethodCommand.class.st
@@ -0,0 +1,28 @@
+"
+Remove selected method from a message browser list
+"
+Class {
+	#name : 'StMessageRemoveMethodCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StMessageRemoveMethodCommand class >> defaultName [
+
+	^ 'Remove method'
+]
+
+{ #category : 'accessing' }
+StMessageRemoveMethodCommand class >> defaultShortcut [
+
+	^ $x actionModifier
+]
+
+{ #category : 'executing' }
+StMessageRemoveMethodCommand >> execute [
+	
+	context doRemoveMethod
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageSendersCommand.class.st b/src/NewTools-MethodBrowsers/StMessageSendersCommand.class.st
new file mode 100644
index 000000000..59e95089b
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageSendersCommand.class.st
@@ -0,0 +1,28 @@
+"
+Browse senders of selected method from a message browser list
+"
+Class {
+	#name : 'StMessageSendersCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StMessageSendersCommand class >> defaultName [
+
+	^ 'Senders'
+]
+
+{ #category : 'accessing' }
+StMessageSendersCommand class >> defaultShortcut [
+
+	^ $n actionModifier
+]
+
+{ #category : 'executing' }
+StMessageSendersCommand >> execute [
+	
+	context doBrowseSenders
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageToolbarPresenter.class.st b/src/NewTools-MethodBrowsers/StMessageToolbarPresenter.class.st
new file mode 100644
index 000000000..f329d600e
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageToolbarPresenter.class.st
@@ -0,0 +1,75 @@
+Class {
+	#name : 'StMessageToolbarPresenter',
+	#superclass : 'StMethodToolbarPresenter',
+	#instVars : [
+		'flipAction',
+		'scopeList'
+	],
+	#category : 'NewTools-MethodBrowsers-Senders',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Senders'
+}
+
+{ #category : 'initialization' }
+StMessageToolbarPresenter >> connectPresenters [
+
+	scopeList whenSelectedItemChangedDo: [ :item | 
+		item ifNotNil: [ messageList switchScopeTo: item ] ]
+]
+
+{ #category : 'layout' }
+StMessageToolbarPresenter >> defaultLayout [
+
+	^ SpBoxLayout newLeftToRight
+		spacing: 3;
+		borderWidth: 3;
+		add: (SpBoxLayout newTopToBottom
+				vAlignCenter;
+				add: scopeList;
+				yourself)
+			expand: false;
+		add: toolbarPresenter;
+		add: (SpBoxLayout newTopToBottom
+				vAlignCenter;
+				add: dropList;
+				yourself)
+			expand: false;
+		yourself
+]
+
+{ #category : 'actions' }
+StMessageToolbarPresenter >> doFlipLayout [
+
+	flipAction ifNil: [ ^ self ].
+	flipAction value
+]
+
+{ #category : 'initialization' }
+StMessageToolbarPresenter >> initializePresenters [
+
+	super initializePresenters.
+	
+	scopeList := self newDropList
+		addStyle: 'stMessageBrowserScopeList';
+		display: [ :each | each description ];
+		yourself.
+	
+	toolbarPresenter add: (self newToolbarButton
+		label: 'Flip';
+		action: [ self doFlipLayout ])
+]
+
+{ #category : 'initialization' }
+StMessageToolbarPresenter >> updatePresenter [
+
+	super updatePresenter.
+	
+	messageList ifNil: [ ^ self ].
+	scopeList items: (messageList scopes ifNil: [ #() ])
+]
+
+{ #category : 'events' }
+StMessageToolbarPresenter >> whenFlipLayoutDo: aBlock [
+
+	flipAction := aBlock
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageUsersCommand.class.st b/src/NewTools-MethodBrowsers/StMessageUsersCommand.class.st
new file mode 100644
index 000000000..a49b2e1be
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageUsersCommand.class.st
@@ -0,0 +1,28 @@
+"
+Browse references to class containing method from a message browser list
+"
+Class {
+	#name : 'StMessageUsersCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StMessageUsersCommand class >> defaultName [
+
+	^ 'References'
+]
+
+{ #category : 'accessing' }
+StMessageUsersCommand class >> defaultShortcut [
+
+	^ $n shift actionModifier
+]
+
+{ #category : 'executing' }
+StMessageUsersCommand >> execute [
+	
+	context doBrowseUsers
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageVersionListPresenter.class.st b/src/NewTools-MethodBrowsers/StMessageVersionListPresenter.class.st
new file mode 100644
index 000000000..35e8da368
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageVersionListPresenter.class.st
@@ -0,0 +1,69 @@
+Class {
+	#name : 'StMessageVersionListPresenter',
+	#superclass : 'StMessageListPresenter',
+	#category : 'NewTools-MethodBrowsers-Versions',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Versions'
+}
+
+{ #category : 'private' }
+StMessageVersionListPresenter >> authorOf: anItem [
+	^ anItem author
+]
+
+{ #category : 'actions' }
+StMessageVersionListPresenter >> doCompareToCurrentVersion [
+	
+	self owner doCompareToCurrentVersion
+]
+
+{ #category : 'actions' }
+StMessageVersionListPresenter >> doCompareToOtherVersion [
+	
+	self owner doCompareToOtherVersion
+
+]
+
+{ #category : 'actions' }
+StMessageVersionListPresenter >> doRevert [
+	
+	self owner doRevert
+]
+
+{ #category : 'initialization' }
+StMessageVersionListPresenter >> initializePresenters [
+
+	super initializePresenters.
+	
+	listPresenter addColumn: (SpStringTableColumn 
+		title: 'Timestamp' 
+		evaluated: [ :item | self timeStampOf: item ])
+]
+
+{ #category : 'private' }
+StMessageVersionListPresenter >> messageListActions [
+
+	^ CmCommandGroup forSpec
+		beRoot;
+		register: ((CmCommandGroup forSpecNamed: 'Compare')
+			beDisplayedAsGroup;
+			register: (StVersionCompareToCurrentCommand forSpecContext: self);
+			register: (StVersionCompareToVersionCommand forSpecContext: self);
+			yourself);
+		register: ((CmCommandGroup forSpecNamed: 'Navigation')
+			beDisplayedAsGroup;
+			register: (StMessageSendersCommand forSpecContext: self);
+			register: (StMessageImplementorsCommand forSpecContext: self);
+			yourself);
+		register: ((CmCommandGroup forSpecNamed: 'CRITICAL')
+			beDisplayedAsGroup;
+			register: (StVersionRevertCommand forSpecContext: self);
+			yourself)	;
+		yourself
+
+]
+
+{ #category : 'private' }
+StMessageVersionListPresenter >> timeStampOf: anItem [
+	^ anItem timeStamp
+]
diff --git a/src/NewTools-MethodBrowsers/StMessageVersionsCommand.class.st b/src/NewTools-MethodBrowsers/StMessageVersionsCommand.class.st
new file mode 100644
index 000000000..3bfdafe29
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMessageVersionsCommand.class.st
@@ -0,0 +1,28 @@
+"
+Browse method versions from a message browser list
+"
+Class {
+	#name : 'StMessageVersionsCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StMessageVersionsCommand class >> defaultName [
+
+	^ 'Versions'
+]
+
+{ #category : 'accessing' }
+StMessageVersionsCommand class >> defaultShortcut [
+
+	^ $v actionModifier
+]
+
+{ #category : 'executing' }
+StMessageVersionsCommand >> execute [
+	
+	context doBrowseVersions
+]
diff --git a/src/NewTools-MethodBrowsers/StMethodHistoryToolbarPresenter.class.st b/src/NewTools-MethodBrowsers/StMethodHistoryToolbarPresenter.class.st
new file mode 100644
index 000000000..4139ccd07
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMethodHistoryToolbarPresenter.class.st
@@ -0,0 +1,35 @@
+Class {
+	#name : 'StMethodHistoryToolbarPresenter',
+	#superclass : 'StMethodToolbarPresenter',
+	#instVars : [
+		'revertAction'
+	],
+	#category : 'NewTools-MethodBrowsers-Versions',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Versions'
+}
+
+{ #category : 'actions' }
+StMethodHistoryToolbarPresenter >> doRevert [
+
+	revertAction ifNil: [ ^ self ].
+	revertAction value
+]
+
+{ #category : 'initialization' }
+StMethodHistoryToolbarPresenter >> initializePresenters [
+
+	super initializePresenters.
+	Smalltalk ui icons.
+	versionButton 
+		label: 'Revert';
+		icon: (self iconNamed: #smallUndo);
+		help: 'Revert method to selected version.';
+		action: [ self doRevert ]
+]
+
+{ #category : 'events' }
+StMethodHistoryToolbarPresenter >> whenRevertDo: aBlock [
+
+	revertAction := aBlock
+]
diff --git a/src/NewTools-MethodBrowsers/StMethodToolbarPresenter.class.st b/src/NewTools-MethodBrowsers/StMethodToolbarPresenter.class.st
new file mode 100644
index 000000000..5b350fb36
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StMethodToolbarPresenter.class.st
@@ -0,0 +1,181 @@
+"
+A MethodToolbar is xxxxxxxxx.
+
+self example
+"
+Class {
+	#name : 'StMethodToolbarPresenter',
+	#superclass : 'SpPresenter',
+	#instVars : [
+		'method',
+		'browseButton',
+		'usersButton',
+		'sendersButton',
+		'implementorsButton',
+		'versionButton',
+		'dropList',
+		'toolbarPresenter',
+		'messageList'
+	],
+	#category : 'NewTools-MethodBrowsers-Base',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Base'
+}
+
+{ #category : 'examples' }
+StMethodToolbarPresenter class >> example [
+
+	<sampleInstance>
+	| example |
+	
+	example := self new.
+	example
+		method: SpButtonPresenter >> #state:;
+		method: nil;
+		extent: 550 @ 100;
+		open.
+	^ example
+]
+
+{ #category : 'specs' }
+StMethodToolbarPresenter class >> title [
+
+	^ 'Toolbar'
+]
+
+{ #category : 'accessing' }
+StMethodToolbarPresenter >> addItemLabeled: aString do: aBlock [
+
+	dropList 
+		addItemLabeled: aString 
+		do: aBlock
+]
+
+{ #category : 'layout' }
+StMethodToolbarPresenter >> defaultLayout [
+
+	^ SpBoxLayout newLeftToRight
+		spacing: 3;
+		borderWidth: 3;
+		add: toolbarPresenter;
+		add: (SpBoxLayout newTopToBottom
+				vAlignCenter;
+				add: dropList;
+				yourself)
+			expand: false;
+		yourself
+]
+
+{ #category : 'private - actions' }
+StMethodToolbarPresenter >> doBrowseImplementors [
+
+	messageList doBrowseImplementors
+]
+
+{ #category : 'private - actions' }
+StMethodToolbarPresenter >> doBrowseMethod [
+
+	messageList doBrowseMethod
+]
+
+{ #category : 'private - actions' }
+StMethodToolbarPresenter >> doBrowseSenders [
+
+	messageList doBrowseSenders
+]
+
+{ #category : 'private - actions' }
+StMethodToolbarPresenter >> doBrowseUsers [
+
+	messageList doBrowseUsers
+]
+
+{ #category : 'private - actions' }
+StMethodToolbarPresenter >> doBrowseVersions [
+
+	messageList doBrowseVersions
+]
+
+{ #category : 'accessing' }
+StMethodToolbarPresenter >> emptyDropList [
+	
+	dropList emptyList
+]
+
+{ #category : 'initialization' }
+StMethodToolbarPresenter >> initializePresenters [
+
+	(browseButton := self newToolbarButton)
+		label: 'Browse'; 
+		icon: (self iconNamed: #smallSystemBrowser);
+		help: 'Browse current selected method';
+		action: [ self doBrowseMethod ].
+	(usersButton := self newToolbarButton) 
+		label: 'References'; 
+		icon: (self iconNamed: #smallFind);
+		help: 'Browse references of current selected class';
+		action: [ self doBrowseUsers ].
+	(sendersButton := self newToolbarButton) 
+		label: 'Senders'; 
+		icon: (self iconNamed: #smallFind);
+		help: 'Browse senders of current selected method';
+		action: [ self doBrowseSenders ].
+	(implementorsButton := self newToolbarButton) 
+		label: 'Implementors'; 
+		icon: (self iconNamed: #smallFind);
+		help: 'Browse implementors of current selected method';
+		action: [ self doBrowseImplementors ].
+	(versionButton := self newToolbarButton) 
+		label: 'Versions'; 
+		icon: (self iconNamed: #history);
+		help: 'Browse versions of current selected method';
+		action: [ self doBrowseVersions ].
+		
+ 	toolbarPresenter := self newToolbar
+		displayMode: self application toolbarDisplayMode;
+		add: browseButton;
+		add: usersButton;
+		add: sendersButton;
+		add: implementorsButton;
+		add: versionButton;
+		yourself.
+		
+	dropList := self newDropList
+]
+
+{ #category : 'accessing' }
+StMethodToolbarPresenter >> messageList: aPresenter [
+
+	messageList := aPresenter
+]
+
+{ #category : 'accessing' }
+StMethodToolbarPresenter >> method [
+	^ method
+]
+
+{ #category : 'accessing' }
+StMethodToolbarPresenter >> method: aMethod [
+
+	method := aMethod
+]
+
+{ #category : 'accessing' }
+StMethodToolbarPresenter >> replaceVersionWithLabel: aString action: aBlock [
+
+	versionButton 
+		label: aString;
+		action: aBlock
+]
+
+{ #category : 'accessing' }
+StMethodToolbarPresenter >> selectFirst [
+
+	dropList selectIndex: 1
+]
+
+{ #category : 'initialization' }
+StMethodToolbarPresenter >> setModelBeforeInitialization: aMethod [
+
+	self method: aMethod
+]
diff --git a/src/NewTools-MethodBrowsers/StVersionBrowserPresenter.class.st b/src/NewTools-MethodBrowsers/StVersionBrowserPresenter.class.st
index 0f08f369d..030c59b6c 100644
--- a/src/NewTools-MethodBrowsers/StVersionBrowserPresenter.class.st
+++ b/src/NewTools-MethodBrowsers/StVersionBrowserPresenter.class.st
@@ -22,7 +22,7 @@ Internal Representation and Key Implementation Points.
 "
 Class {
 	#name : 'StVersionBrowserPresenter',
-	#superclass : 'AbstractMessageCentricBrowserPresenter',
+	#superclass : 'StAbstractMessageCentricBrowserPresenter',
 	#instVars : [
 		'rgMethod',
 		'sourcePresenter',
@@ -101,7 +101,7 @@ StVersionBrowserPresenter >> changeList [
 	^ messageList messages
 ]
 
-{ #category : 'actions' }
+{ #category : 'private - actions' }
 StVersionBrowserPresenter >> compareTo: anOtherVersion withLabel: aLabel [
 	| versions texts |
 
@@ -111,11 +111,13 @@ StVersionBrowserPresenter >> compareTo: anOtherVersion withLabel: aLabel [
 		referencesList: versions) 
 		getText.
 
-	(SpDiffPresenter newApplication: self application)
-		title: ('Comparison from {1} to {2}' format: { versions second stamp. aLabel });
+	((SpDiffPresenter newApplication: self application)
 		leftText: texts first;
 		rightText: texts second;
-		open
+		asWindow) 
+			title: ('Comparison from {1} to {2}' format: { versions second stamp. aLabel });
+			initialExtent: 900@600;
+			open
 ]
 
 { #category : 'actions' }
@@ -146,26 +148,70 @@ StVersionBrowserPresenter >> connectPresenters [
 { #category : 'initialization' }
 StVersionBrowserPresenter >> defaultLayout [
 
-	^ SpPanedLayout newTopToBottom
-		add: messageList;
-		add: ((sourceLayout := SpBoxLayout newTopToBottom)
-			add: toolbarPresenter expand: false;
+	^ SpBoxLayout newTopToBottom
+		add: toolbarPresenter expand: false; 
+		add: (SpPanedLayout newTopToBottom
+			add: messageList;
+			add: (sourceLayout := SpBoxLayout newTopToBottom);
 			yourself);
 		yourself
 ]
 
+{ #category : 'actions' }
+StVersionBrowserPresenter >> doBrowseImplementors [
+
+	SystemNavigation new browseAllImplementorsOf: rgMethod selector
+]
+
+{ #category : 'actions' }
+StVersionBrowserPresenter >> doBrowseSenders [
+
+	self systemNavigation 
+		browseSendersOf: rgMethod selector 
+		name: 'Senders of ', rgMethod selector 
+		autoSelect: rgMethod selector
+]
+
+{ #category : 'actions' }
+StVersionBrowserPresenter >> doCompareToCurrentVersion [
+
+	self compareTo: rgMethod withLabel: 'Current version'
+]
+
+{ #category : 'actions' }
+StVersionBrowserPresenter >> doCompareToOtherVersion [
+	| labels versions selected |
+	
+	versions := self changeList.
+	labels := versions collect: [ :each | each stamp ].
+	
+	selected := self application newSelect 
+		title: 'Select a version'; 
+		items: versions;
+		display: [ :aVersion | aVersion stamp ];
+		openModal.
+	selected ifNil: [ ^ self ].
+
+	self compareTo: selected withLabel: selected stamp
+]
+
+{ #category : 'actions' }
+StVersionBrowserPresenter >> doRevert [
+
+]
+
 { #category : 'initialization' }
 StVersionBrowserPresenter >> initializePresenters [
 
-	messageList := self instantiate: MessageListPresenter on: rgMethod.
-	
-	toolbarPresenter := self instantiate: SpMethodToolbarPresenter on: rgMethod.
-	self layout: self defaultLayout.
+	messageList := self newMessageList.
+	toolbarPresenter := self newMessageToolbar.
 	 
 	messageList
 		topologicSort: false;
-		sortingBlock: [ :a | a annotationNamed: #versionIndex ifAbsent: [ 0 ] ] ascending;
-		contextMenu: self messageListMenu.
+		sortingBlock: [ :a | a annotationNamed: #versionIndex ifAbsent: [ 0 ] ] ascending.
+
+	self flag: #TODO. "I need this for now, but this is because toolbar is wrong :P"
+	self layout: self defaultLayout.
 	
 	toolbarPresenter
 		addItemLabeled: 'Side By Side' do: [
@@ -177,11 +223,7 @@ StVersionBrowserPresenter >> initializePresenters [
 		addItemLabeled: 'Diff' do: [ 
 			self showDiffLineWithConverter: (DiffLineChangeRecordConverter 
 				methodReference: self textConverter method
-				referencesList: self changeList) ].
-		
-	toolbarPresenter 
-		replaceVersionWithLabel: 'Revert'
-		action: [ self revert: self selectedMessage ]
+				referencesList: self changeList) ]
 ]
 
 { #category : 'initialization' }
@@ -244,6 +286,20 @@ StVersionBrowserPresenter >> method [
 	^ rgMethod
 ]
 
+{ #category : 'initialization' }
+StVersionBrowserPresenter >> newMessageList [
+
+	^ self instantiate: StMessageVersionListPresenter
+]
+
+{ #category : 'initialization' }
+StVersionBrowserPresenter >> newMessageToolbar [
+		
+	^ (self instantiate: StMethodHistoryToolbarPresenter on: rgMethod)
+		whenRevertDo: [ self revert: self selectedMessage ];
+		yourself
+]
+
 { #category : 'private - factory' }
 StVersionBrowserPresenter >> newSourceDiff [
 
@@ -259,11 +315,11 @@ StVersionBrowserPresenter >> newTextConverter [
 { #category : 'private' }
 StVersionBrowserPresenter >> replaceSourceWith: aPresenter [
 	
-	sourceLayout children size = 1 
-		ifTrue: [ 
-			sourceLayout add: aPresenter ]
-		ifFalse: [ 
-			sourceLayout replace: sourcePresenter with: aPresenter ].
+	sourceLayout children  
+		ifNotEmpty: [ 
+			sourceLayout replace: sourcePresenter with: aPresenter ]
+		ifEmpty: [ 
+			sourceLayout add: aPresenter ].
 		
 	sourcePresenter := aPresenter.
 	messageList selectIndex: messageList selectedIndex
@@ -394,8 +450,8 @@ StVersionBrowserPresenter >> updateDiffLine: content [
 StVersionBrowserPresenter >> updatePresenter [
 
 	self showDiffMorphWithConverter: (DiffSideBySideChangeRecordConverter 
-				methodReference: self textConverter method 
-				referencesList: self changeList)
+		methodReference: self textConverter method 
+		referencesList: self changeList)
 ]
 
 { #category : 'private - updating' }
diff --git a/src/NewTools-MethodBrowsers/StVersionCompareToCurrentCommand.class.st b/src/NewTools-MethodBrowsers/StVersionCompareToCurrentCommand.class.st
new file mode 100644
index 000000000..bc8a99493
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StVersionCompareToCurrentCommand.class.st
@@ -0,0 +1,25 @@
+Class {
+	#name : 'StVersionCompareToCurrentCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StVersionCompareToCurrentCommand class >> defaultDescription [
+
+	^ 'Compare selected version to the current version'
+]
+
+{ #category : 'accessing' }
+StVersionCompareToCurrentCommand class >> defaultName [
+
+	^ 'Compare to current'
+]
+
+{ #category : 'executing' }
+StVersionCompareToCurrentCommand >> execute [
+	
+	context doCompareToCurrentVersion
+]
diff --git a/src/NewTools-MethodBrowsers/StVersionCompareToVersionCommand.class.st b/src/NewTools-MethodBrowsers/StVersionCompareToVersionCommand.class.st
new file mode 100644
index 000000000..62d897f04
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StVersionCompareToVersionCommand.class.st
@@ -0,0 +1,25 @@
+Class {
+	#name : 'StVersionCompareToVersionCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StVersionCompareToVersionCommand class >> defaultDescription [
+
+	^ 'Compare selected version to another selected version'
+]
+
+{ #category : 'accessing' }
+StVersionCompareToVersionCommand class >> defaultName [
+
+	^ 'Compare to version...'
+]
+
+{ #category : 'executing' }
+StVersionCompareToVersionCommand >> execute [
+	
+	context doCompareToOtherVersion
+]
diff --git a/src/NewTools-MethodBrowsers/StVersionRevertCommand.class.st b/src/NewTools-MethodBrowsers/StVersionRevertCommand.class.st
new file mode 100644
index 000000000..e7376ca72
--- /dev/null
+++ b/src/NewTools-MethodBrowsers/StVersionRevertCommand.class.st
@@ -0,0 +1,25 @@
+Class {
+	#name : 'StVersionRevertCommand',
+	#superclass : 'StCommand',
+	#category : 'NewTools-MethodBrowsers-Commands',
+	#package : 'NewTools-MethodBrowsers',
+	#tag : 'Commands'
+}
+
+{ #category : 'accessing' }
+StVersionRevertCommand class >> defaultDescription [
+
+	^ 'Compare selected version to the current version'
+]
+
+{ #category : 'accessing' }
+StVersionRevertCommand class >> defaultName [
+
+	^ 'Revert to selected version'
+]
+
+{ #category : 'executing' }
+StVersionRevertCommand >> execute [
+	
+	context doRevert
+]
diff --git a/src/NewTools-Playground-Playbook/StPlaybook.class.st b/src/NewTools-Playground-Playbook/StPlaybook.class.st
new file mode 100644
index 000000000..7c3564205
--- /dev/null
+++ b/src/NewTools-Playground-Playbook/StPlaybook.class.st
@@ -0,0 +1,269 @@
+"
+A playbook is a keeper of playgrounds (in a list). 
+This works to enhance grouping (as playgrounds tends to accumulate).
+"
+Class {
+	#name : #StPlaybook,
+	#superclass : #StPlayground,
+	#instVars : [
+		'pageList',
+		'pageListToolbar',
+		'pages',
+		'activating'
+	],
+	#category : #'NewTools-Playground-Playbook-View'
+}
+
+{ #category : #'private - commands' }
+StPlaybook class >> baseToolbarCommands [
+
+	^ { 
+	StPlaybookNewPageCommand.
+	StPlaybookPagesCommand.
+	}
+]
+
+{ #category : #accessing }
+StPlaybook class >> defaultTitle [
+
+	^ 'Playbook'
+]
+
+{ #category : #'private - commands' }
+StPlaybook class >> extendedToolbarCommands [
+
+	^ #()
+]
+
+{ #category : #'world menu' }
+StPlaybook class >> menuCommandOn: aBuilder [
+	<worldMenu>
+	
+	(aBuilder item: #Playbook)
+		parent: #InputOutput;
+		action: [ StPlaybook open ];
+		order: 1;
+		keyText: 'o, p';
+		help: 'A window used as a scratchpad area where fragments of Pharo code can be entered, stored, edited, and evaluated.';
+		icon: (self iconNamed: #workspace)
+]
+
+{ #category : #'private - commands' }
+StPlaybook class >> toolbarCommands [
+
+	^ (self baseToolbarCommands, self extendedToolbarCommands) sorted: #order ascending
+]
+
+{ #category : #actions }
+StPlaybook >> activateExistingPage: aPage [
+	
+	pageList selectItem: (pageList items detect: [ :each | each model = aPage ]).
+	self loadPage: aPage.
+	millerList takeKeyboardFocus
+]
+
+{ #category : #actions }
+StPlaybook >> activatePage: aPage [
+
+	"if page is already in list, select it"
+	(pages includes: aPage) ifTrue: [ 
+		self activateExistingPage: aPage.
+		^ self ].
+
+	self activatingDo: [
+		self cleanEmptyPlaygrounds.
+		aPage touch.
+		pages add: aPage.
+		self updatePresenter ]
+]
+
+{ #category : #actions }
+StPlaybook >> activateSelectedPage [
+
+	self activatingDo: [ 
+		self loadPage: self selectedPage ]
+]
+
+{ #category : #private }
+StPlaybook >> activatingDo: aBlock [
+	| oldActivating |
+	
+	oldActivating := activating.
+	activating := true.
+	aBlock ensure: [ 
+		activating := false ]
+]
+
+{ #category : #private }
+StPlaybook >> addPageListToolbarCommandsTo: aGroup [
+
+	self class toolbarCommands do: [ :each | 
+		aGroup register: (each forSpecContext: self) ]
+]
+
+{ #category : #private }
+StPlaybook >> cleanEmptyPlaygrounds [
+
+	"'clean' empty playgrounds"
+	(pages 
+		select: [ :each | each isEmpty ])
+		do: [ :each | pages remove: each ].
+]
+
+{ #category : #layout }
+StPlaybook >> defaultLayout [
+
+	^ SpPanedLayout newHorizontal
+		positionOfSlider: 250;
+		add: (SpBoxLayout newTopToBottom 
+			add: pageListToolbar expand: false;
+			add: pageList;
+			yourself);
+		add: millerList;
+		yourself
+]
+
+{ #category : #actions }
+StPlaybook >> doAddNewPage [
+
+	pages add: StPlaygroundPage new.
+	self updatePresenter
+]
+
+{ #category : #actions }
+StPlaybook >> doRemoveSelectedPage [
+
+	pages remove: self selectedPage.
+	pages 
+		ifEmpty: [ self doAddNewPage ]
+		ifNotEmpty: [ self updatePresenter ]
+]
+
+{ #category : #initialization }
+StPlaybook >> initialize [
+
+	activating := false.
+	pages := OrderedCollection with: StPlaygroundPage new.
+	super initialize
+]
+
+{ #category : #initialization }
+StPlaybook >> initializePresenters [
+
+	super initializePresenters.
+	
+	pageListToolbar := self newToolbar
+		displayMode: self application toolbarDisplayMode;
+		addStyle: 'stToolbar';
+		fillWith: self pageListToolbarActions;
+		yourself.
+	
+	pageList := self newComponentList
+		activateOnSingleClick;
+		contextMenu: [ self pageListActions asMenuPresenter ];
+		contextKeyBindings: self pageListActions asKMCategory;
+		whenActivatedDo: [ self activateSelectedPage ];
+		yourself
+]
+
+{ #category : #'private - events' }
+StPlaybook >> pageFlushed: ann [
+
+	pageList selectedItem updatePresenter.
+	"do not trigger an update (that will make me lose the cursor)"
+	pageList disableActivationDuring: [ 
+		self updatePresenter ]
+]
+
+{ #category : #private }
+StPlaybook >> pageListActions [
+
+	^ CmCommandGroup forSpec
+		beRoot;
+		register: (StPlaybookRemovePageCommand forSpecContext: self);
+		yourself
+]
+
+{ #category : #private }
+StPlaybook >> pageListToolbarActions [
+
+	^ CmCommandGroup forSpec
+		in: [ :this | self addPageListToolbarCommandsTo: this ];
+		yourself
+]
+
+{ #category : #'private - events' }
+StPlaybook >> pageLoaded: ann [
+	| selectedItem |
+
+	activating ifTrue: [ ^ self ].
+
+	selectedItem := pageList selectedItem.
+	ann page touch.
+	pages 
+		at: (pages indexOf: selectedItem model) 
+		put: ann page.
+	selectedItem model: ann page
+]
+
+{ #category : #private }
+StPlaybook >> pages [
+
+	^ pages
+]
+
+{ #category : #private }
+StPlaybook >> pagesAsPresenters [
+
+	^ self pages collect: [ :each | 
+		self 
+			instantiate: StPlaygroundPageSummaryPresenter
+			on: each  ]
+]
+
+{ #category : #private }
+StPlaybook >> prepareInspectorAsPlayground: inspector [
+	
+	inspector announcer
+		when: StPlaygroundPageLoaded 
+			send: #pageLoaded: 
+			to: self;
+		when: StPlaygroundPageFlushed
+			send: #pageFlushed:
+			to: self
+]
+
+{ #category : #private }
+StPlaybook >> selectedPage [
+
+	^ pageList selectedItem page
+]
+
+{ #category : #private }
+StPlaybook >> sortFunction [
+
+	^ [ :aPresenter | aPresenter model modificationTime ] descending
+]
+
+{ #category : #'private - stepping' }
+StPlaybook >> startProcessing [
+
+	super startProcessing.
+	self updatePageList
+]
+
+{ #category : #'private - updating' }
+StPlaybook >> updatePageList [
+
+	pageList updateItemsKeepingSelection: (pageList items sort: self sortFunction)
+]
+
+{ #category : #initialization }
+StPlaybook >> updatePresenter [
+
+	pageList 
+		presenters: (self pagesAsPresenters sort: self sortFunction);
+		selectFirst.
+	
+	self loadPage: pageList selectedItem model
+]
diff --git a/src/NewTools-Playground-Playbook/StPlaybookNewPageCommand.class.st b/src/NewTools-Playground-Playbook/StPlaybookNewPageCommand.class.st
new file mode 100644
index 000000000..03b0c3dde
--- /dev/null
+++ b/src/NewTools-Playground-Playbook/StPlaybookNewPageCommand.class.st
@@ -0,0 +1,38 @@
+"
+A command to add a new page to current book.
+"
+Class {
+	#name : #StPlaybookNewPageCommand,
+	#superclass : #StCommand,
+	#category : #'NewTools-Playground-Playbook-Command'
+}
+
+{ #category : #default }
+StPlaybookNewPageCommand class >> defaultDescription [
+
+	^ 'Add new playground page.'
+]
+
+{ #category : #accessing }
+StPlaybookNewPageCommand class >> defaultIconName [
+
+	^ #smallAdd
+]
+
+{ #category : #default }
+StPlaybookNewPageCommand class >> defaultName [
+
+	^ 'New Page'
+]
+
+{ #category : #default }
+StPlaybookNewPageCommand class >> order [
+
+	^ 0
+]
+
+{ #category : #executing }
+StPlaybookNewPageCommand >> execute [ 
+
+	context doAddNewPage
+]
diff --git a/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st b/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st
new file mode 100644
index 000000000..7c297e4d5
--- /dev/null
+++ b/src/NewTools-Playground-Playbook/StPlaybookPageEntry.class.st
@@ -0,0 +1,53 @@
+"
+An entry for playbook processor.
+"
+Class {
+	#name : #StPlaybookPageEntry,
+	#superclass : #StEntry,
+	#instVars : [
+		'page',
+		'playbook'
+	],
+	#category : #'NewTools-Playground-Playbook-Processor'
+}
+
+{ #category : #'instance creation' }
+StPlaybookPageEntry class >> newPlaybook: aPlaybook page: aPage [
+
+	^ self new 
+		playbook: aPlaybook;
+		page: aPage;
+		yourself
+]
+
+{ #category : #converting }
+StPlaybookPageEntry >> asString [ 
+
+	^ page title
+]
+
+{ #category : #evaluating }
+StPlaybookPageEntry >> doEvaluate [ 
+
+	playbook window activate.
+	playbook activatePage: page
+]
+
+{ #category : #accessing }
+StPlaybookPageEntry >> iconName [
+	
+	^ StPlaybook systemIconName 
+]
+
+{ #category : #initialization }
+StPlaybookPageEntry >> page: aPage [
+
+	page := aPage.
+	self content: page contents
+]
+
+{ #category : #initialization }
+StPlaybookPageEntry >> playbook: aPlaybook [
+
+	playbook := aPlaybook
+]
diff --git a/src/NewTools-Playground-Playbook/StPlaybookPagesCommand.class.st b/src/NewTools-Playground-Playbook/StPlaybookPagesCommand.class.st
new file mode 100644
index 000000000..2dd07e7c4
--- /dev/null
+++ b/src/NewTools-Playground-Playbook/StPlaybookPagesCommand.class.st
@@ -0,0 +1,14 @@
+"
+Load page command for playbook
+"
+Class {
+	#name : #StPlaybookPagesCommand,
+	#superclass : #StPlaygroundPagesCommand,
+	#category : #'NewTools-Playground-Playbook-Command'
+}
+
+{ #category : #actions }
+StPlaybookPagesCommand >> loadPage: page [
+
+	context activatePage: page
+]
diff --git a/src/NewTools-Playground-Playbook/StPlaybookProcessor.class.st b/src/NewTools-Playground-Playbook/StPlaybookProcessor.class.st
new file mode 100644
index 000000000..84628619b
--- /dev/null
+++ b/src/NewTools-Playground-Playbook/StPlaybookProcessor.class.st
@@ -0,0 +1,46 @@
+"
+A spotter processor to show playbook pages (and being able to pick them there)
+"
+Class {
+	#name : #StPlaybookProcessor,
+	#superclass : #StCollectionBasedProcessor,
+	#category : #'NewTools-Playground-Playbook-Processor'
+}
+
+{ #category : #'default-settings' }
+StPlaybookProcessor class >> defaultEnabled [
+
+	^ true
+]
+
+{ #category : #accessing }
+StPlaybookProcessor class >> order [
+	
+	^ 10
+]
+
+{ #category : #accessing }
+StPlaybookProcessor class >> title [
+	
+	^ 'Playbook Pages'
+]
+
+{ #category : #filtering }
+StPlaybookProcessor >> collection [
+
+	^ StPlaybook allInstances flatCollect: [ :eachBook | 
+		eachBook pages collect: [ :each | 
+			StPlaybookPageEntry newPlaybook: eachBook page: each ] ]
+]
+
+{ #category : #filtering }
+StPlaybookProcessor >> newEntryOn: anElement [
+
+	^ anElement
+]
+
+{ #category : #configuration }
+StPlaybookProcessor >> showForEmptyQuery [
+
+	^ true
+]
diff --git a/src/NewTools-Playground-Playbook/StPlaybookRemovePageCommand.class.st b/src/NewTools-Playground-Playbook/StPlaybookRemovePageCommand.class.st
new file mode 100644
index 000000000..519823e03
--- /dev/null
+++ b/src/NewTools-Playground-Playbook/StPlaybookRemovePageCommand.class.st
@@ -0,0 +1,32 @@
+"
+A command to temove page from current playbook
+"
+Class {
+	#name : #StPlaybookRemovePageCommand,
+	#superclass : #StCommand,
+	#category : #'NewTools-Playground-Playbook-Command'
+}
+
+{ #category : #default }
+StPlaybookRemovePageCommand class >> defaultDescription [
+
+	^ 'Remove selected playground from book.'
+]
+
+{ #category : #default }
+StPlaybookRemovePageCommand class >> defaultName [
+
+	^ 'Remove'
+]
+
+{ #category : #accessing }
+StPlaybookRemovePageCommand class >> defaultShortcut [
+
+	^ $x command mac | $x ctrl unix | $x ctrl win
+]
+
+{ #category : #executing }
+StPlaybookRemovePageCommand >> execute [
+	
+	context doRemoveSelectedPage
+]
diff --git a/src/NewTools-Playground-Playbook/package.st b/src/NewTools-Playground-Playbook/package.st
new file mode 100644
index 000000000..a2b714046
--- /dev/null
+++ b/src/NewTools-Playground-Playbook/package.st
@@ -0,0 +1 @@
+Package { #name : #'NewTools-Playground-Playbook' }
diff --git a/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st
index 387ccd0b5..94da90bcd 100644
--- a/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st
+++ b/src/NewTools-Playground-Tests/StPlaygroundPagePresenterTest.class.st
@@ -125,7 +125,7 @@ StPlaygroundPagePresenterTest >> testPageIsSavedWhenExecutingACommand [
 	memory := FileSystem memory.
 	fileReference := memory / 'page.ph'. 
 	fileReference writeStreamDo: [ :stream | ].
-	presenter loadPage: fileReference.
+	presenter loadPage: (StPlaygroundPage fromReference: fileReference).
 	"ensure we do not save in the inner process by mistake"
 	presenter page timeToWait: 1 minute.
 	"we need the activation otherwise the command we are using will not work :("
diff --git a/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st
index 4a25d258c..449e475ba 100644
--- a/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st
+++ b/src/NewTools-Playground-Tests/StPlaygroundPageSummaryPresenterTest.class.st
@@ -11,13 +11,13 @@ StPlaygroundPageSummaryPresenterTest >> classToTest [
 	^ StPlaygroundPageSummaryPresenter
 ]
 
-{ #category : 'initialization' }
+{ #category : 'running' }
 StPlaygroundPageSummaryPresenterTest >> initializeInstanceBeforeInitialization: aPresenter [
 
-	aPresenter setModelBeforeInitialization: memoryFileSystem / 'test1.ph'
+	aPresenter setModelBeforeInitialization: (StPlaygroundPage fromReference: memoryFileSystem / 'test1.ph')
 ]
 
-{ #category : 'initialization' }
+{ #category : 'running' }
 StPlaygroundPageSummaryPresenterTest >> initializeMemoryFileSystem: aFileSystem [
 
 	aFileSystem / 'test1.ph' writeStreamDo: [ :stream | stream << '' ].
@@ -30,7 +30,7 @@ StPlaygroundPageSummaryPresenterTest >> initializeMemoryFileSystem: aFileSystem
 StPlaygroundPageSummaryPresenterTest >> testContents [
 
 	self assert: presenter contents equals: ''.
-	presenter setModelBeforeInitialization: memoryFileSystem / 'test2.ph'.
+	presenter setModelBeforeInitialization: (StPlaygroundPage fromReference: (memoryFileSystem / 'test2.ph')).
 	self assert: presenter contents equals: 'Test
 Test 2'	
 ]
@@ -38,7 +38,7 @@ Test 2'
 { #category : 'tests' }
 StPlaygroundPageSummaryPresenterTest >> testPageFirstLine [
 	
-	self assert: presenter pageFirstLine equals: 'Empty'.	
-	presenter setModelBeforeInitialization: memoryFileSystem / 'test2.ph'.
-	self assert: presenter pageFirstLine equals: 'Test'
+	self assert: presenter pageTitle equals: 'Empty'.	
+	presenter setModelBeforeInitialization: (StPlaygroundPage fromReference: memoryFileSystem / 'test2.ph').
+	self assert: presenter pageTitle equals: 'Test'
 ]
diff --git a/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st
index e9719fd78..01b1d12bf 100644
--- a/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st
+++ b/src/NewTools-Playground-Tests/StPlaygroundPagesPresenterTest.class.st
@@ -28,13 +28,14 @@ StPlaygroundPagesPresenterTest >> initializeMemoryFileSystem: aFileSystem [
 
 { #category : 'tests' }
 StPlaygroundPagesPresenterTest >> testLoadPage [
+	| loaded |
 
+	loaded := false.
 	self deny: presenter window notNil.
 	self openInstance.
 	self assert: presenter window isOpen.
-	presenter loadPage: (memoryFileSystem / 'test1.ph').
+	presenter onLoadPage: [ :aPage | loaded := true ].
+	presenter loadPage: (StPlaygroundPage fromReference: (memoryFileSystem / 'test1.ph')).
 	self deny: presenter window isOpen .
-	self 
-		assert: presenter parent page contents
-		equals: (memoryFileSystem / 'test1.ph') contents
+	self assert: loaded
 ]
diff --git a/src/NewTools-Playground-Tests/StPlaygroundTest.class.st b/src/NewTools-Playground-Tests/StPlaygroundTest.class.st
index e4a182ed4..4d8f07d2c 100644
--- a/src/NewTools-Playground-Tests/StPlaygroundTest.class.st
+++ b/src/NewTools-Playground-Tests/StPlaygroundTest.class.st
@@ -46,10 +46,10 @@ StPlaygroundTest >> testLoadPage [
 	presenter page flush.
 
 	page := self newPage
-		        contents: 'Test 2';
-		        flush;
-		        yourself.
-	presenter loadPage: page fileReference.
+		contents: 'Test 2';
+		flush;
+		yourself.
+	presenter loadPage: page.
 	self waitUntilUIRedrawed.
 	self assert: presenter page contents equals: page contents
 ]
@@ -73,7 +73,7 @@ StPlaygroundTest >> testStopProcessing [
 		        contents: 'Test 1';
 		        flush;
 		        yourself.
-	presenter loadPage: page fileReference.
+	presenter loadPage: page.
 	self waitUntilUIRedrawed.
 	"a lot of time"
 	presenter page timeToWait: 1 minute.
diff --git a/src/NewTools-Playground/StPlayground.class.st b/src/NewTools-Playground/StPlayground.class.st
index 939cafa7e..02d2c20dc 100644
--- a/src/NewTools-Playground/StPlayground.class.st
+++ b/src/NewTools-Playground/StPlayground.class.st
@@ -1,3 +1,49 @@
+"
+It is useful to explore ideas or learn something before writing it to a more definitive place.
+In older versions of Pharo, this tool was known as Workspace.
+
+The idea of a playground is not new in smalltalk systems and many other dynamic languages have implemented in one way or another some features of it, usually through a REPL, which shares much of a playground functionality. 
+
+Some of the things a playground can do for you: 
+
+- it can execute code (and print its results).
+- it can debug some piece of code you just typed.
+- it can search references, implementors and senders
+- it can store variables (both locally or shared to all playgrounds).
+
+!! Opening:
+You usually will open a playground by choosing it from the Pharo menu (Playground option), but it can also be opened programatically. 
+[[[language=Smalltalk
+StPlayground open.
+StPlayground openContents: 'Some scripting'
+]]]
+
+!! Using the playground
+Most of the functionalities a playground does can be found in the context menu of it (==<meta+t>== or right button click), and we will not explain in detail each of them. But there are some usages that may requirse some more documentation than ""self discovery"". Here are some hints you may find useful: 
+
+!!! Keyboard friendly
+There is a shortcut, ==<meta+t>==, that will show the context menu corresponding to the playground. Additionaly, there will be entries to control also what you can find in the toolbar or status bar. This redundancy is intentional and it will allow the user to navigate through all the options of the playgrounds without needing a secondary device (which, of course, can be used anyway if desired).
+
+!!! The print it popover
+If you try to print results of a computation, you will see that you receive a popover with the results of the execution (e.g. ==21*2== will show a popover with the ==42== number). There are some other things you can do with this popover besides just dismiss it (pressing ==<esc>==, ==<backspace>== or just focusing somewhere else).
+You can also: 
+
+- press ==<cr>== to print the result into your playground (it will be shown enclosed with ""quotation marks"", as a comment.
+- press ==<meta+i>== to inspect the result.
+
+!!! The bindings window
+The bindings window will be shown by selecting the ""Bindings"" option of the context menu or toolbar.
+You will see the variables panel and an inspector allowing you to explore/modify the values of a variable. There is also a context menu in the variables list that will allow you some other options. One interesting option you will see is the ""make variable shared"" option. This option will make the variable common to all playgrounds. It is an easy way to explore some posibilities in a separated space, not modifying what you already have there.
+
+See *class:StPlaygroundBindingsPresenter*
+
+!!! The pages window
+The pages window will be shown by selecting the ""Pages"" option of the context menu or toolbar.
+This window will list all playgrounds pages stored in the playground cache directory. You can choose any playground edited in any moment and load it into your playgroud.
+
+See *class:StPlaygroundPagesPresenter*
+
+"
 Class {
 	#name : 'StPlayground',
 	#superclass : 'StPlaygroundPresenter',
@@ -9,5 +55,5 @@ Class {
 { #category : 'testing' }
 StPlayground class >> isDeprecated [ 
 	
-	^ true
+	^ false
 ]
diff --git a/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st b/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st
index 0e3b4cffc..6afba8459 100644
--- a/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st
+++ b/src/NewTools-Playground/StPlaygroundBindingsPresenter.class.st
@@ -95,7 +95,7 @@ StPlaygroundBindingsPresenter >> initializeDialogWindow: aDialogWindowPresenter
 
 	aDialogWindowPresenter 
 		centeredRelativeTo: parent window;
-		addButton: 'Close' do: [ :presenter | 
+		addDefaultButton: 'Close' do: [ :presenter | 
 			presenter triggerOkAction.
 			presenter close ]
 ]
diff --git a/src/NewTools-Playground/StPlaygroundPage.class.st b/src/NewTools-Playground/StPlaygroundPage.class.st
index 0110984d1..bb55edeaf 100644
--- a/src/NewTools-Playground/StPlaygroundPage.class.st
+++ b/src/NewTools-Playground/StPlaygroundPage.class.st
@@ -18,7 +18,9 @@ Class {
 		'contentReceived',
 		'timeToWait',
 		'baseDirectory',
-		'versionLog'
+		'versionLog',
+		'flushAction',
+		'modificationTime'
 	],
 	#category : 'NewTools-Playground-Model',
 	#package : 'NewTools-Playground',
@@ -31,6 +33,12 @@ StPlaygroundPage class >> defaultTimeToWait [
 	^ 10 seconds
 ]
 
+{ #category : 'accessing' }
+StPlaygroundPage class >> emptyTitle [
+
+	^ 'Empty'
+]
+
 { #category : 'instance creation' }
 StPlaygroundPage class >> fromReference: aFileReference [
 
@@ -130,6 +138,16 @@ StPlaygroundPage >> fileReference [
 	^ (self baseDirectory / self fileName) withExtension: self class pageExtension
 ]
 
+{ #category : 'accessing' }
+StPlaygroundPage >> firstLine [
+
+	self readStreamDo: [ :stream | | line |
+		[ stream atEnd not and: [ (line := stream nextLine trimmed) isEmpty ] ] whileTrue.
+		line isEmptyOrNil ifFalse: [ ^ line ] ].
+
+	^ nil
+]
+
 { #category : 'private' }
 StPlaygroundPage >> flush [
 
@@ -141,7 +159,10 @@ StPlaygroundPage >> flush [
 			writeStreamDo: [ :stream |
 				stream << flushContents ].
 		flushContents := nil.
-		self storeVersion ]
+		self storeVersion.
+		self touch.
+		flushAction ifNotNil: [ 
+			flushAction value ] ]
 ]
 
 { #category : 'initialization' }
@@ -162,6 +183,32 @@ StPlaygroundPage >> initialize [
 	mutex := Mutex new
 ]
 
+{ #category : 'testing' }
+StPlaygroundPage >> isEmpty [
+
+	^ self firstLine isNil
+]
+
+{ #category : 'accessing' }
+StPlaygroundPage >> modificationTime [
+
+	^ modificationTime ifNil: [ modificationTime := self creationTime ]
+]
+
+{ #category : 'events' }
+StPlaygroundPage >> onFlush: aBlock [
+
+	flushAction := aBlock
+]
+
+{ #category : 'streaming' }
+StPlaygroundPage >> readStreamDo: aBlock [
+
+	^ self fileReference 
+		ifExists: [ :ref | ref readStreamDo: aBlock ]
+		ifAbsent: [ nil ]
+]
+
 { #category : 'private' }
 StPlaygroundPage >> spawnFlushProcess [
 
@@ -206,6 +253,18 @@ StPlaygroundPage >> timeToWait: aDuration [
 	timeToWait := aDuration
 ]
 
+{ #category : 'accessing' }
+StPlaygroundPage >> title [
+
+	^ self firstLine ifNil: [ self class emptyTitle ]
+]
+
+{ #category : 'accessing' }
+StPlaygroundPage >> touch [
+
+	modificationTime := DateAndTime now
+]
+
 { #category : 'accessing - versions' }
 StPlaygroundPage >> versionLog [
 	
diff --git a/src/NewTools-Playground/StPlaygroundPageFlushed.class.st b/src/NewTools-Playground/StPlaygroundPageFlushed.class.st
new file mode 100644
index 000000000..dc33458fd
--- /dev/null
+++ b/src/NewTools-Playground/StPlaygroundPageFlushed.class.st
@@ -0,0 +1,33 @@
+"
+Announces when a page is just flushed (saved to disk, generated a new version)
+"
+Class {
+	#name : 'StPlaygroundPageFlushed',
+	#superclass : 'Announcement',
+	#instVars : [
+		'page'
+	],
+	#category : 'NewTools-Playground-Model',
+	#package : 'NewTools-Playground',
+	#tag : 'Model'
+}
+
+{ #category : 'instance creation' }
+StPlaygroundPageFlushed class >> newPage: aPage [
+
+	^ self new 
+		page: aPage;
+		yourself
+]
+
+{ #category : 'accessing' }
+StPlaygroundPageFlushed >> page [
+
+	^ page
+]
+
+{ #category : 'accessing' }
+StPlaygroundPageFlushed >> page: anObject [
+
+	page := anObject
+]
diff --git a/src/NewTools-Playground/StPlaygroundPageLoaded.class.st b/src/NewTools-Playground/StPlaygroundPageLoaded.class.st
new file mode 100644
index 000000000..3970f49fb
--- /dev/null
+++ b/src/NewTools-Playground/StPlaygroundPageLoaded.class.st
@@ -0,0 +1,33 @@
+"
+Announces when a page has been loaded.
+"
+Class {
+	#name : 'StPlaygroundPageLoaded',
+	#superclass : 'Announcement',
+	#instVars : [
+		'page'
+	],
+	#category : 'NewTools-Playground-Model',
+	#package : 'NewTools-Playground',
+	#tag : 'Model'
+}
+
+{ #category : 'instance creation' }
+StPlaygroundPageLoaded class >> newPage: aPage [
+
+	^ self new 
+		page: aPage;
+		yourself
+]
+
+{ #category : 'accessing' }
+StPlaygroundPageLoaded >> page [
+
+	^ page
+]
+
+{ #category : 'accessing' }
+StPlaygroundPageLoaded >> page: anObject [
+
+	page := anObject
+]
diff --git a/src/NewTools-Playground/StPlaygroundPagePresenter.class.st b/src/NewTools-Playground/StPlaygroundPagePresenter.class.st
index fca50b555..21c94fea7 100644
--- a/src/NewTools-Playground/StPlaygroundPagePresenter.class.st
+++ b/src/NewTools-Playground/StPlaygroundPagePresenter.class.st
@@ -12,7 +12,8 @@ Class {
 		'lineLabel',
 		'toggleLineNumberButton',
 		'page',
-		'activationBlock'
+		'activationBlock',
+		'loading'
 	],
 	#classVars : [
 		'CacheDirectory'
@@ -194,6 +195,13 @@ StPlaygroundPagePresenter >> hasOutputActivationPort [
 	^ true
 ]
 
+{ #category : 'initialization' }
+StPlaygroundPagePresenter >> initialize [
+
+	loading := false.
+	super initialize
+]
+
 { #category : 'initialization' }
 StPlaygroundPagePresenter >> initializePresenters [
 
@@ -207,7 +215,7 @@ StPlaygroundPagePresenter >> initializePresenters [
 		withEditionContextMenu;
 		contextMenu: [ (self menuActionsFor: text) asMenuPresenter ];
 		contextKeyBindings: (self menuActionsFor: text) asKMCategory;
-		whenTextChangedDo: [ :aString | page contents: aString ].
+		whenTextChangedDo: [ :aString | self updateContents: aString ].
 
 	text announcer
 		when: SpCodeWillBeEvaluatedAnnouncement
@@ -268,10 +276,19 @@ StPlaygroundPagePresenter >> interactionModel [
 ]
 
 { #category : 'actions' }
-StPlaygroundPagePresenter >> loadPage: aFileReference [
+StPlaygroundPagePresenter >> loadPage: aPage [
 
-	self basicPage: (StPlaygroundPage fromReference: aFileReference).
-	text text: page contents.
+	loading := true.
+	
+	[
+		self basicPage: aPage.
+		aPage onFlush: [
+			self announce: (StPlaygroundPageFlushed newPage: aPage) ].
+		self announce: (StPlaygroundPageLoaded newPage: aPage).
+		self updatePresenter ]
+	ensure: [ 
+		loading := false ].
+	
 	^ page
 ]
 
@@ -382,6 +399,13 @@ StPlaygroundPagePresenter >> toolbarActions [
 		yourself
 ]
 
+{ #category : 'private - updating' }
+StPlaygroundPagePresenter >> updateContents: aString [
+
+	loading ifTrue: [ ^ self ].
+	self page contents: aString
+]
+
 { #category : 'private - updating' }
 StPlaygroundPagePresenter >> updateLineNumber [
 	| pos |
diff --git a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st
index e0a0b6e80..5a634732c 100644
--- a/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st
+++ b/src/NewTools-Playground/StPlaygroundPageSummaryPresenter.class.st
@@ -6,8 +6,9 @@ I am meant to be used in StPlaygroundPagesPresenter, as element of a list.
 Class {
 	#name : 'StPlaygroundPageSummaryPresenter',
 	#superclass : 'SpPresenter',
+	#traits : 'SpTModel',
+	#classTraits : 'SpTModel classTrait',
 	#instVars : [
-		'page',
 		'firstLineLabel',
 		'timeLabel'
 	],
@@ -19,7 +20,7 @@ Class {
 { #category : 'accessing' }
 StPlaygroundPageSummaryPresenter >> contents [
 
-	^ page contents
+	^ self model contents
 ]
 
 { #category : 'initialization' }
@@ -32,30 +33,25 @@ StPlaygroundPageSummaryPresenter >> initializePresenters [
 		add: (timeLabel := self newLabel) expand: false;
 		yourself.
 
-	firstLineLabel label: self pageFirstLine.
-	timeLabel 
-		addStyle: 'dim';
-		label: page creationTime epiceaBrowsersAsString
+	timeLabel addStyle: 'dim'
 ]
 
 { #category : 'accessing' }
 StPlaygroundPageSummaryPresenter >> page [
 
-	^ page
+	^ self model
 ]
 
 { #category : 'initialization' }
-StPlaygroundPageSummaryPresenter >> pageFirstLine [
-		
-	page readStreamDo: [ :stream | | line |
-		[ stream atEnd not and: [ (line := stream nextLine trimmed) isEmpty ] ] whileTrue.
-		line isEmptyOrNil ifFalse: [ ^ line ] ].
+StPlaygroundPageSummaryPresenter >> pageTitle [
 
-	^ 'Empty'
+	^ self model title
 ]
 
-{ #category : 'accessing - model' }
-StPlaygroundPageSummaryPresenter >> setModelBeforeInitialization: aPage [
+{ #category : 'initialization' }
+StPlaygroundPageSummaryPresenter >> updatePresenter [
 
-	page := aPage
+	self model ifNil: [ ^ self ].
+	firstLineLabel label: self pageTitle.
+	timeLabel label: self model modificationTime epiceaBrowsersAsString
 ]
diff --git a/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st b/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st
index e8aa77fef..638cd5d1c 100644
--- a/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st
+++ b/src/NewTools-Playground/StPlaygroundPageVersionsPresenter.class.st
@@ -64,12 +64,12 @@ StPlaygroundPageVersionsPresenter >> doAdoptVersionOnNewPlayground [
 StPlaygroundPageVersionsPresenter >> initializeDialogWindow: aDialogWindowPresenter [
 
 	aDialogWindowPresenter
-		addButton: 'Adopt' do: [ :presenter | 
-			presenter triggerOkAction.
-			self adoptSelectedVersion ];
 		addButton: 'Close' do: [ :presenter | 
 			presenter triggerCancelAction.
-			presenter close ]	
+			presenter close ];
+		addDefaultButton: 'Adopt' do: [ :presenter | 
+			presenter triggerOkAction.
+			self adoptSelectedVersion ]
 ]
 
 { #category : 'initialization' }
diff --git a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st
index 5cd33ba3d..db0aad694 100644
--- a/src/NewTools-Playground/StPlaygroundPagesCommand.class.st
+++ b/src/NewTools-Playground/StPlaygroundPagesCommand.class.st
@@ -39,5 +39,14 @@ StPlaygroundPagesCommand >> execute [
 	(StPlaygroundPagesPresenter 
 		newApplication: context application
 		model: context) 
+		onLoadPage: [ :page |
+			self loadPage: page.
+			context takeKeyboardFocus ];
 		openDialog
 ]
+
+{ #category : 'actions' }
+StPlaygroundPagesCommand >> loadPage: page [
+
+	context loadPage: page
+]
diff --git a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st
index 560abebfe..a6ecc44d8 100644
--- a/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st
+++ b/src/NewTools-Playground/StPlaygroundPagesPresenter.class.st
@@ -12,7 +12,8 @@ Class {
 		'pageList',
 		'pagePreview',
 		'pageListPanel',
-		'pagePreviewPanel'
+		'pagePreviewPanel',
+		'loadPageAction'
 	],
 	#category : 'NewTools-Playground-View',
 	#package : 'NewTools-Playground',
@@ -81,12 +82,12 @@ StPlaygroundPagesPresenter >> initializeDialogWindow: aDialogWindowPresenter [
 
 	aDialogWindowPresenter 
 		centeredRelativeToTopWindow;
-		addButton: 'Load' do: [ :presenter |
-			presenter triggerOkAction.
-			self loadSelectedPage ];		
 		addButton: 'Close' do: [ :presenter |
 			presenter triggerCancelAction.
-			presenter close ]
+			presenter close ];
+		addDefaultButton: 'Load' do: [ :presenter |
+			presenter triggerOkAction.
+			self loadSelectedPage ]
 ]
 
 { #category : 'initialization' }
@@ -136,9 +137,9 @@ StPlaygroundPagesPresenter >> initializeWindow: aWindowPresenter [
 { #category : 'actions' }
 StPlaygroundPagesPresenter >> loadPage: aPage [
 
-	self parent loadPage: aPage.
 	self window close.
-	self parent takeKeyboardFocus 
+	loadPageAction ifNotNil: [ 
+		loadPageAction value: aPage ]
 ]
 
 { #category : 'actions' }
@@ -147,11 +148,18 @@ StPlaygroundPagesPresenter >> loadSelectedPage [
 	self loadPage: self selectedPage
 ]
 
+{ #category : 'events' }
+StPlaygroundPagesPresenter >> onLoadPage: aBlock [
+
+	loadPageAction := aBlock
+]
+
 { #category : 'accessing' }
 StPlaygroundPagesPresenter >> pages [
 	
-	^ (StPlaygroundPresenter cacheDirectory allChildrenMatching: '*.ph')
-		sorted: [ :a :b | a creationTime > b creationTime ]
+	^ ((StPlaygroundPresenter cacheDirectory allChildrenMatching: '*.ph')
+		sorted: [ :a :b | a creationTime > b creationTime ])
+		collect: [ :each | StPlaygroundPage fromReference: each ]
 ]
 
 { #category : 'private' }
diff --git a/src/NewTools-Playground/StPlaygroundPresenter.class.st b/src/NewTools-Playground/StPlaygroundPresenter.class.st
index 9ecb836e7..d692afd65 100644
--- a/src/NewTools-Playground/StPlaygroundPresenter.class.st
+++ b/src/NewTools-Playground/StPlaygroundPresenter.class.st
@@ -176,13 +176,17 @@ StPlaygroundPresenter >> newDefaultPlaygroundPage [
 
 { #category : 'private - factory' }
 StPlaygroundPresenter >> newInspectorFor: aModel [
-	| modelToInspectOrPlayground |
-	
-	modelToInspectOrPlayground := (millerList pages isEmpty and: [ aModel isNil ]) 
-		ifTrue: [ self newDefaultPlaygroundPage ]
-		ifFalse: [ aModel ].
+	| isPlayground  inspector |
 
-	^ super newInspectorFor: modelToInspectOrPlayground
+	isPlayground := millerList pages isEmpty and: [ aModel isNil ].
+
+	inspector := super newInspectorFor: (isPlayground 
+		ifTrue: [ self newDefaultPlaygroundPage ]
+		ifFalse: [ aModel ]).
+		
+	isPlayground ifTrue: [ self prepareInspectorAsPlayground: inspector ].
+		
+	^ inspector
 ]
 
 { #category : 'accessing' }
@@ -191,6 +195,11 @@ StPlaygroundPresenter >> page [
 	^ self firstPage page
 ]
 
+{ #category : 'private' }
+StPlaygroundPresenter >> prepareInspectorAsPlayground: inspector [
+
+]
+
 { #category : 'private - stepping' }
 StPlaygroundPresenter >> startProcessing [
 	
diff --git a/src/NewTools-Spotter-Processors/StSpotterPragmaBasedProcessor.class.st b/src/NewTools-Spotter-Processors/StSpotterPragmaBasedProcessor.class.st
index ab0c8650c..274f5b3b9 100644
--- a/src/NewTools-Spotter-Processors/StSpotterPragmaBasedProcessor.class.st
+++ b/src/NewTools-Spotter-Processors/StSpotterPragmaBasedProcessor.class.st
@@ -131,15 +131,16 @@ StSpotterPragmaBasedProcessor >> initialize [
 ]
 
 { #category : 'key-bindings' }
-StSpotterPragmaBasedProcessor >> installKeymappingsOn: aGTSpotterMorph [
+StSpotterPragmaBasedProcessor >> installKeymappingsOn: aSpotterMorph [
 
-	self keyBinding
+	self flag: #TODO. "This should be used?"
+	"self keyBinding
 		ifNotNil: [ | keyCombination |
 			keyCombination := self keyBinding asKeyCombination.
 			aGTSpotterMorph 
 				bindKeyCombination: keyCombination 
 				ofProcessor: self 
-				toAction: [ aGTSpotterMorph onKeyProcessor: self ] ]
+				toAction: [ aGTSpotterMorph onKeyProcessor: self ] ]"
 ]
 
 { #category : 'key-bindings' }
diff --git a/src/NewTools-Spotter/StSpotterStep.class.st b/src/NewTools-Spotter/StSpotterStep.class.st
index a0bb2f60f..8356f7d12 100644
--- a/src/NewTools-Spotter/StSpotterStep.class.st
+++ b/src/NewTools-Spotter/StSpotterStep.class.st
@@ -171,7 +171,6 @@ StSpotterStep >> processors: aCollection [
 StSpotterStep >> pushQuery: aQuery [
 
 	self deactivate.
-	
 	aQuery processors: (self processors sort: #order ascending).
 	self activateQuery: aQuery.
 	aQuery process