diff --git a/BaselineOfIceberg/BaselineOfIceberg.class.st b/BaselineOfIceberg/BaselineOfIceberg.class.st
index 53f150158b..2e6adfd143 100644
--- a/BaselineOfIceberg/BaselineOfIceberg.class.st
+++ b/BaselineOfIceberg/BaselineOfIceberg.class.st
@@ -28,11 +28,13 @@ BaselineOfIceberg >> baseline: spec [
 			package: 'Iceberg-Plugin-Migration' with: [ spec requires: #('Iceberg-Plugin') ];
 			package: 'Iceberg-Metacello-Integration' with: [ spec requires: #('Iceberg')];
 			package: 'Iceberg-TipUI' with: [ spec requires: #('Iceberg') ];
+			package: 'Iceberg-TipUI-SnapshotBrowser';
 			package: 'Iceberg-Memory' with: [ spec requires: #('Iceberg') ];
 			"tests"
 			package: 'Iceberg-Tests' with: [ spec requires: #('Iceberg' 'Iceberg-Memory') ];
 			package: 'Iceberg-Tests-MetacelloIntegration' with: [ spec requires: #('Iceberg-Tests') ];
 			package: 'Iceberg-UI-Tests' with: [ spec requires: #('Iceberg-TipUI' 'Iceberg-Tests')];
+			package: 'Iceberg-TipUI-SnapshotBrowser-Tests' with: [ spec requires: #( 'Iceberg-TipUI-SnapshotBrowser' ) ];
 			package: 'Iceberg-Plugin-Migration-Tests' with: [ spec requires: #('Iceberg-Plugin-Migration' 'Iceberg-Tests') ];
 			"libgit"
 			package: 'Iceberg-Libgit' with: [ spec requires: #('Iceberg' 'LibGit') ];
@@ -43,6 +45,7 @@ BaselineOfIceberg >> baseline: spec [
 				minimal 
 				'Iceberg-Metacello-Integration' 
 				'Iceberg-TipUI'
+				'Iceberg-TipUI-SnapshotBrowser'
 				'Iceberg-Plugin' 
 				'Iceberg-Plugin-Metacello'
 				'Iceberg-Plugin-GitHub'
@@ -58,6 +61,7 @@ BaselineOfIceberg >> baseline: spec [
 				'Iceberg-Tests-MetacelloIntegration'
 				'LibGit-Tests' 
 				'Iceberg-UI-Tests'
+				'Iceberg-TipUI-SnapshotBrowser-Tests'
 				'Iceberg-Plugin-Migration-Tests' );
 			group: 'development' with: #(default allTests) ].
 
diff --git a/Iceberg-TipUI-SnapshotBrowser-Tests/IceSnapshotBrowserTest.class.st b/Iceberg-TipUI-SnapshotBrowser-Tests/IceSnapshotBrowserTest.class.st
new file mode 100644
index 0000000000..ac4ac94577
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser-Tests/IceSnapshotBrowserTest.class.st
@@ -0,0 +1,349 @@
+Class {
+	#name : 'IceSnapshotBrowserTest',
+	#superclass : 'MCTestCase',
+	#instVars : [
+		'model'
+	],
+	#category : 'Iceberg-TipUI-SnapshotBrowser-Tests',
+	#package : 'Iceberg-TipUI-SnapshotBrowser-Tests'
+}
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> allCategories [
+	^ Array with: model extensionsCategory with: self mockCategoryName.
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> allMethods [
+	^ MCSnapshotResource current definitions
+		select: [:def | def isMethodDefinition]
+		thenCollect: [:def | def selector]		
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> allProtocols [
+	^ MCSnapshotResource current definitions
+		select: [:def | def isMethodDefinition]
+		thenCollect: [:def | def category]		
+]
+
+{ #category : 'asserting' }
+IceSnapshotBrowserTest >> assertAListMatches: strings [
+
+	| lists |
+	lists := self presenterLists collect: #items.
+	lists
+		detect: [ :list | list size = strings size and: [ list includesAll: strings ] ]
+		ifNone: [ self fail: 'Could not find all "' , strings asArray asString , '" ' , 'in any of "' , (lists collect: #asArray) asArray asString , '"' ]
+]
+
+{ #category : 'asserting' }
+IceSnapshotBrowserTest >> assertButtonOn: aString [
+	self assert: (self findButtonWithLabel: aString) getModelState.
+	
+]
+
+{ #category : 'asserting' }
+IceSnapshotBrowserTest >> assertTextIs: aString [
+
+	self 
+		assert: self methodPresenter text 
+		equals: aString
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> bottomLayout [
+	
+	^ model layout children second
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> classABooleanMethods [
+	^ #(falsehood moreTruth truth)
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> classAClassProtocols [
+
+	^ self mockClassA class protocolNames
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> classAComment [
+	^ self mockClassA comment.
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> classADefinitionString [
+
+	^ self mockClassA oldDefinition
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> classAProtocols [
+	^ self mockClassA protocolNames
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> classAclassDefinitionString [
+
+	^ (ClassDefinitionPrinter oldPharo for: self mockClassA class) definitionString
+]
+
+{ #category : 'accessing - presenters' }
+IceSnapshotBrowserTest >> classDefinitionPresenter [
+
+	^ self codePresenters first
+]
+
+{ #category : 'simulating' }
+IceSnapshotBrowserTest >> clickOnButton: aString [
+	(self findButtonWithLabel: aString) click.
+]
+
+{ #category : 'simulating' }
+IceSnapshotBrowserTest >> clickOnListItem: aString [
+	| list |
+	list := self findListContaining: aString.
+	list listPresenter clickAtIndex: (list listPresenter items indexOf: aString).
+]
+
+{ #category : 'accessing - presenters' }
+IceSnapshotBrowserTest >> codePresenters [
+
+	^ self bottomLayout allPresenters 
+		select: [ : p | p isKindOf: SpCodePresenter ]
+]
+
+{ #category : 'accessing - presenters' }
+IceSnapshotBrowserTest >> commentPresenter [
+
+	^ self textPresenters anyOne
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> definedClasses [
+	^ MCSnapshotResource current definitions 
+		select: [:def | def isClassDefinition] 
+		thenCollect: [:def | def className].
+]
+
+{ #category : 'asserting' }
+IceSnapshotBrowserTest >> denyAListHasSelection: aString [
+	| found |
+	found := true.
+	self presenterLists
+			detect: [:m | m selectedItem = aString]
+			ifNone: [found := false].
+	self deny: found.
+]
+
+{ #category : 'asserting' }
+IceSnapshotBrowserTest >> denyAListIncludesAnyOf: anArrayOfStrings [
+	| found |
+	found := true.
+	self presenterLists 
+			detect: [:m | m items includesAnyOf: anArrayOfStrings]
+			ifNone: [found := false].
+	self deny: found.
+]
+
+{ #category : 'asserting' }
+IceSnapshotBrowserTest >> denyButtonOn: aString [
+	self deny: (self findButtonWithLabel: aString) getModelState.
+	
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> falsehoodMethodSource [
+	^ 'falsehood
+	^ false'
+]
+
+{ #category : 'accessing - presenters' }
+IceSnapshotBrowserTest >> findButtonWithLabel: aString [ 
+
+	^ model allPresenters 
+		detect: [ : p | p isKindOf: SpCheckBoxPresenter ]
+		ifNone: [ nil ]
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> findListContaining: aString [
+
+	^ self presenterLists detect: [: m | m items includes: aString ]
+]
+
+{ #category : 'accessing - presenters' }
+IceSnapshotBrowserTest >> methodPresenter [
+	"For now we cannot properly distinguish between method and class definition code presenters"
+
+	^ self codePresenters last
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> presenterListChildren [
+
+	^ self upperLayout allPresenters
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> presenterLists [
+
+	^ self presenterListChildren select: [ : p | p isKindOf: SpFilteringListPresenter ]
+]
+
+{ #category : 'selecting' }
+IceSnapshotBrowserTest >> selectMockClassA [
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	
+]
+
+{ #category : 'running' }
+IceSnapshotBrowserTest >> setUp [
+	super setUp.
+	model := IceSnapshotBrowser forSnapshot: MCSnapshotResource current snapshot.
+
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testCategorySelected [
+	self clickOnListItem: self mockCategoryName.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self denyAListIncludesAnyOf: self allProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+	self assertTextIs: ''.
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testClassSelected [
+	self selectMockClassA.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+	self 
+		assert: self classDefinitionPresenter text 
+		equals: self classADefinitionString.
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testClassSideClassSelected [
+
+	self selectMockClassA.
+	self clickOnButton: 'Class'.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAClassProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+	self 
+		assert: self classDefinitionPresenter text 
+		equals: self classAclassDefinitionString.
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testComment [
+
+	self 
+		assert: self commentPresenter text 
+		equals: String empty.
+	
+	self clickOnListItem: self mockCategoryName.
+	self 
+		assert: self commentPresenter text 
+		equals: String empty.
+	
+	self clickOnListItem: 'MCMockClassA'.
+	self 
+		assert: self commentPresenter text 
+		equals: self classAComment.
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testFourColumns [
+
+	self assert: self presenterLists size equals: 4
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testMethodIsCleared [
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	self clickOnListItem: 'boolean'.
+	self clickOnListItem: 'falsehood'.
+	self clickOnListItem: 'numeric'.
+	
+	self denyAListHasSelection: 'falsehood'.
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testMethodSelected [
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	self clickOnListItem: 'boolean'.
+	self clickOnListItem: 'falsehood'.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAProtocols.
+	self assertAListMatches: self classABooleanMethods.
+	self assertTextIs: self falsehoodMethodSource.
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testNoSelection [
+
+	self assertAListMatches: self allCategories.
+	self denyAListIncludesAnyOf: self definedClasses.
+	self denyAListIncludesAnyOf: self allProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testProtocolIsCleared [
+
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockASubclass'.
+	self clickOnListItem: Protocol unclassified.
+	self clickOnListItem: 'MCMockClassA'.
+
+	self denyAListHasSelection: Protocol unclassified
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testProtocolSelected [
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	self clickOnListItem: 'boolean'.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAProtocols.
+	self assertAListMatches: self classABooleanMethods.
+	self assertTextIs: ''.		
+]
+
+{ #category : 'testing' }
+IceSnapshotBrowserTest >> testSwitchClassButton [
+
+	self deny: (self findButtonWithLabel: 'Class') isNil.
+]
+
+{ #category : 'accessing - presenters' }
+IceSnapshotBrowserTest >> textPresenters [
+
+	^ self bottomLayout allPresenters 
+		select: [ : p | p class = SpTextPresenter ]
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserTest >> upperLayout [
+	
+	^ model layout children first
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser-Tests/package.st b/Iceberg-TipUI-SnapshotBrowser-Tests/package.st
new file mode 100644
index 0000000000..2f38f86413
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser-Tests/package.st
@@ -0,0 +1 @@
+Package { #name : 'Iceberg-TipUI-SnapshotBrowser-Tests' }
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseFullClassCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseFullClassCommand.class.st
new file mode 100644
index 0000000000..b8fe4cebef
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseFullClassCommand.class.st
@@ -0,0 +1,28 @@
+"
+I am a command used to browse a selected class of the snapshot browser.
+"
+Class {
+	#name : 'IceSBBrowseFullClassCommand',
+	#superclass : 'IceSBBrowserAbstractClassCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseFullClassCommand class >> defaultName [
+
+	^ 'Browse full'
+]
+
+{ #category : 'testing' }
+IceSBBrowseFullClassCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self selectedClassIsLoaded ]
+]
+
+{ #category : 'executing' }
+IceSBBrowseFullClassCommand >> execute [
+	"Browse the selected class"
+
+	(self class environment at: self selectedClass) browse
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseFullMethodCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseFullMethodCommand.class.st
new file mode 100644
index 0000000000..b8c4d84338
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseFullMethodCommand.class.st
@@ -0,0 +1,28 @@
+"
+I am a command to browse a method from the snapshot browser.
+"
+Class {
+	#name : 'IceSBBrowseFullMethodCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseFullMethodCommand class >> defaultName [
+
+	^ 'Browse full'
+]
+
+{ #category : 'testing' }
+IceSBBrowseFullMethodCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self selectedClassIsLoaded ]
+]
+
+{ #category : 'executing' }
+IceSBBrowseFullMethodCommand >> execute [
+	"Browse the selected method"
+
+	self selectedMethod browse
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseHierarchyClassCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseHierarchyClassCommand.class.st
new file mode 100644
index 0000000000..7208060eb5
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseHierarchyClassCommand.class.st
@@ -0,0 +1,28 @@
+"
+I am a command to browse the hierarchy of a class.
+"
+Class {
+	#name : 'IceSBBrowseHierarchyClassCommand',
+	#superclass : 'IceSBBrowserAbstractClassCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseHierarchyClassCommand class >> defaultName [
+
+	^ 'Browse hierarchy'
+]
+
+{ #category : 'testing' }
+IceSBBrowseHierarchyClassCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self class environment hasClassNamed: self selectedClass ]
+]
+
+{ #category : 'executing' }
+IceSBBrowseHierarchyClassCommand >> execute [
+	"Browse the selected class"
+
+	(self class environment at: self selectedClass) browseHierarchy
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseHierarchyMethodCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseHierarchyMethodCommand.class.st
new file mode 100644
index 0000000000..c62e86a3e8
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseHierarchyMethodCommand.class.st
@@ -0,0 +1,30 @@
+"
+I am a command to be able to see the hierarchy of a method.
+"
+Class {
+	#name : 'IceSBBrowseHierarchyMethodCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseHierarchyMethodCommand class >> defaultName [
+
+	^ 'Browse hierarchy...'
+]
+
+{ #category : 'testing' }
+IceSBBrowseHierarchyMethodCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self selectedClassIsLoaded ]
+]
+
+{ #category : 'executing' }
+IceSBBrowseHierarchyMethodCommand >> execute [
+	"Browse the selected method"
+
+	self systemNavigation 
+		browseHierarchy: context selectedClassOrMetaClass
+		selector: context selectedMessageName	
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodImplementorsCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodImplementorsCommand.class.st
new file mode 100644
index 0000000000..436dc8bc09
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodImplementorsCommand.class.st
@@ -0,0 +1,28 @@
+"
+I am a command to be able to browse the implementors of a method.
+"
+Class {
+	#name : 'IceSBBrowseMethodImplementorsCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseMethodImplementorsCommand class >> defaultName [
+
+	^ 'Browse inheritance'
+]
+
+{ #category : 'testing' }
+IceSBBrowseMethodImplementorsCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self selectedClassIsLoaded ]
+]
+
+{ #category : 'executing' }
+IceSBBrowseMethodImplementorsCommand >> execute [
+	"Browse implementors of the selected method"
+
+	self systemNavigation browseAllImplementorsOf: (context selectedMessageName ifNil: [ ^nil ])
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodInheritanceCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodInheritanceCommand.class.st
new file mode 100644
index 0000000000..945f504bac
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodInheritanceCommand.class.st
@@ -0,0 +1,31 @@
+"
+I am a method to be able to see a method inheritance hierarchy
+"
+Class {
+	#name : 'IceSBBrowseMethodInheritanceCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseMethodInheritanceCommand class >> defaultName [
+
+	^ 'Browse implementors'
+]
+
+{ #category : 'testing' }
+IceSBBrowseMethodInheritanceCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self selectedClassIsLoaded ]
+]
+
+{ #category : 'executing' }
+IceSBBrowseMethodInheritanceCommand >> execute [
+	"Browse implementors of the selected method"
+
+	self systemNavigation 
+		methodHierarchyBrowserForClass: context selectedClassOrMetaClass 
+		selector: context selectedMessageName
+
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodSendersCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodSendersCommand.class.st
new file mode 100644
index 0000000000..7e079d93bf
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodSendersCommand.class.st
@@ -0,0 +1,22 @@
+"
+I am a command to be able to see the senders of a method in the snapshot browser
+"
+Class {
+	#name : 'IceSBBrowseMethodSendersCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseMethodSendersCommand class >> defaultName [
+
+	^ 'Browse senders'
+]
+
+{ #category : 'executing' }
+IceSBBrowseMethodSendersCommand >> execute [
+	"Browse senders of the selected method"
+
+	self selectedMethod browseSenders
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodVersionsCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodVersionsCommand.class.st
new file mode 100644
index 0000000000..da5673a78e
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowseMethodVersionsCommand.class.st
@@ -0,0 +1,30 @@
+"
+I am a command to see different versions of a method
+"
+Class {
+	#name : 'IceSBBrowseMethodVersionsCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBBrowseMethodVersionsCommand class >> defaultName [
+
+	^ 'Versions'
+]
+
+{ #category : 'testing' }
+IceSBBrowseMethodVersionsCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self selectedClassIsLoaded ]
+]
+
+{ #category : 'executing' }
+IceSBBrowseMethodVersionsCommand >> execute [
+	"Browse versions of the selected method"
+
+	self tools versionBrowser
+		browseVersionsForClass: context selectedClassOrMetaClass 
+		selector: context selectedMessageName
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowserAbstractClassCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowserAbstractClassCommand.class.st
new file mode 100644
index 0000000000..2a85bdb2e8
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowserAbstractClassCommand.class.st
@@ -0,0 +1,15 @@
+"
+I am an abstract class to manage the snapshot browser commands about classes.
+"
+Class {
+	#name : 'IceSBBrowserAbstractClassCommand',
+	#superclass : 'IceSnapshotBrowserCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'testing' }
+IceSBBrowserAbstractClassCommand >> canBeExecuted [ 
+
+	^ self selectedClass notNil
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBBrowserAbstractMethodCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowserAbstractMethodCommand.class.st
new file mode 100644
index 0000000000..f107068e8f
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBBrowserAbstractMethodCommand.class.st
@@ -0,0 +1,29 @@
+"
+I am an abstract class to manage the snapshot browser commands about methods.
+"
+Class {
+	#name : 'IceSBBrowserAbstractMethodCommand',
+	#superclass : 'IceSnapshotBrowserCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'testing' }
+IceSBBrowserAbstractMethodCommand >> canBeExecuted [ 
+
+	^ self selectedMethod notNil
+]
+
+{ #category : 'accessing - selection' }
+IceSBBrowserAbstractMethodCommand >> selectedMethod [
+	"Answer the actual selected <CompiledMethod>"
+
+	^ self selectedMethodDefinition method
+]
+
+{ #category : 'accessing - selection' }
+IceSBBrowserAbstractMethodCommand >> selectedMethodDefinition [
+	"Answer the currently selected <MCMethodDefinition>"
+
+	^ context selectedMethod
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBCopySelectorCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBCopySelectorCommand.class.st
new file mode 100644
index 0000000000..61138dd9a8
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBCopySelectorCommand.class.st
@@ -0,0 +1,24 @@
+"
+I am a command to copy the selector of a method in the snapshot browser.
+"
+Class {
+	#name : 'IceSBCopySelectorCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBCopySelectorCommand class >> defaultName [
+
+	^ 'Copy selector'
+]
+
+{ #category : 'executing' }
+IceSBCopySelectorCommand >> execute [
+	"Browse the selected method"
+
+	Clipboard 
+		clipboardText: self selectedMethod selector 
+		informing: ('Selector {1} copied to clipboard' format: { self selectedMethod selector })
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBFileOutMethodCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBFileOutMethodCommand.class.st
new file mode 100644
index 0000000000..82aa1b0bc6
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBFileOutMethodCommand.class.st
@@ -0,0 +1,22 @@
+"
+I am a command to file out a method in the snapshot browser.
+"
+Class {
+	#name : 'IceSBFileOutMethodCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBFileOutMethodCommand class >> defaultName [
+
+	^ 'File out'
+]
+
+{ #category : 'executing' }
+IceSBFileOutMethodCommand >> execute [
+	"File out the selected method"
+
+	context fileOutMessage
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBLoadCategoryCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadCategoryCommand.class.st
new file mode 100644
index 0000000000..35047f6f66
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadCategoryCommand.class.st
@@ -0,0 +1,39 @@
+Class {
+	#name : 'IceSBLoadCategoryCommand',
+	#superclass : 'IceSnapshotBrowserCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBLoadCategoryCommand class >> defaultName [
+
+	^ 'Load category...'
+]
+
+{ #category : 'testing' }
+IceSBLoadCategoryCommand >> canBeExecuted [ 
+
+	^ self categorySelection notNil
+]
+
+{ #category : 'executing' }
+IceSBLoadCategoryCommand >> categorySelection [
+
+	^ context categorySelection
+]
+
+{ #category : 'executing' }
+IceSBLoadCategoryCommand >> execute [
+	"Load the entire selected category"
+
+	self methodsForSelectedClassCategory 
+		do: [ :m | m load ]
+		displayingProgress: 'Loading definitions...'
+]
+
+{ #category : 'executing' }
+IceSBLoadCategoryCommand >> methodsForSelectedClassCategory [
+
+	^ context methodsForSelectedClassCategory 
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBLoadClassCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadClassCommand.class.st
new file mode 100644
index 0000000000..f709b9c159
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadClassCommand.class.st
@@ -0,0 +1,40 @@
+"
+I am a command to load a class in the snapshot browser.
+"
+Class {
+	#name : 'IceSBLoadClassCommand',
+	#superclass : 'IceSBBrowserAbstractClassCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBLoadClassCommand class >> defaultName [
+
+	^ 'Load class...'
+]
+
+{ #category : 'executing' }
+IceSBLoadClassCommand >> execute [
+	"Load the selected class"
+
+	self packageClasses
+		detect: [ :ea | ea className = self selectedClass ]
+		ifFound: [ :packageClass | 
+			packageClass load.
+			self methodsForSelectedClass 
+				do: [ :m | m load ]
+				displayingProgress: 'Loading definitions...' ]
+]
+
+{ #category : 'executing' }
+IceSBLoadClassCommand >> methodsForSelectedClass [
+
+	^ context methodsForSelectedClass
+]
+
+{ #category : 'executing' }
+IceSBLoadClassCommand >> packageClasses [
+
+	^ context packageClasses
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBLoadMethodCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadMethodCommand.class.st
new file mode 100644
index 0000000000..b97483c123
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadMethodCommand.class.st
@@ -0,0 +1,28 @@
+"
+I am a command to load a method from the Snapshot browser
+"
+Class {
+	#name : 'IceSBLoadMethodCommand',
+	#superclass : 'IceSBBrowserAbstractMethodCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBLoadMethodCommand class >> defaultName [
+
+	^ 'Load method...'
+]
+
+{ #category : 'testing' }
+IceSBLoadMethodCommand >> canBeExecuted [ 
+
+	^ super canBeExecuted and: [ self selectedMethodDefinition isLoadable ]
+]
+
+{ #category : 'executing' }
+IceSBLoadMethodCommand >> execute [
+	"Load the selected method"
+
+	self selectedMethod load
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSBLoadProtocolCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadProtocolCommand.class.st
new file mode 100644
index 0000000000..80ded04873
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSBLoadProtocolCommand.class.st
@@ -0,0 +1,31 @@
+Class {
+	#name : 'IceSBLoadProtocolCommand',
+	#superclass : 'IceSnapshotBrowserCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'default' }
+IceSBLoadProtocolCommand class >> defaultName [
+
+	^ 'Load protocol...'
+]
+
+{ #category : 'testing' }
+IceSBLoadProtocolCommand >> canBeExecuted [ 
+
+	^ self selectedProtocol notNil
+]
+
+{ #category : 'executing' }
+IceSBLoadProtocolCommand >> execute [
+	"Load the selected protocol"
+
+	self selectedProtocol load
+]
+
+{ #category : 'accessing - selection' }
+IceSBLoadProtocolCommand >> selectedProtocol [
+
+	^ context protocolSelection 
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSnapshotBrowser.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSnapshotBrowser.class.st
new file mode 100644
index 0000000000..195af1b69d
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSnapshotBrowser.class.st
@@ -0,0 +1,570 @@
+"
+I am a browser to be able to browse the code of a Monticello snapshot. 
+
+I am made with the Spec framework.
+"
+Class {
+	#name : 'IceSnapshotBrowser',
+	#superclass : 'StPresenter',
+	#instVars : [
+		'srcCodePresenter',
+		'classesPresenter',
+		'protocolsPresenter',
+		'methodsPresenter',
+		'items',
+		'classOrInstanceSelectorPresenter',
+		'categoriesPresenter',
+		'commentPresenter',
+		'classDefinitionPresenter',
+		'titleString'
+	],
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'commands' }
+IceSnapshotBrowser class >> buildCommandsGroupWith: presenterInstance forRoot: rootCommandGroup [
+
+	super
+		buildCommandsGroupWith: presenterInstance
+		forRoot: rootCommandGroup.
+	rootCommandGroup 
+		"Package category commands"
+		register: ((CmCommandGroup named: 'MCCategorySelContextualMenu') asSpecGroup
+					  register: ((IceSBLoadCategoryCommand
+							    forSpecWithIconNamed: #smallLoadProject
+							    shortcutKey: 'K' asShortcut) context: presenterInstance);
+					  beDisplayedAsGroup;
+					  yourself);
+
+		"Class commands"
+		register: ((CmCommandGroup named: 'MCClassSelContextualMenu') asSpecGroup
+					  register: ((IceSBLoadClassCommand
+							    forSpecWithIconNamed: #smallLoadProject
+							    shortcutKey: 'C' asShortcut) context: presenterInstance);
+					  register: ((IceSBBrowseFullClassCommand
+							    forSpecWithIconNamed: #browse
+							    shortcutKey: 'B' asShortcut) context: presenterInstance);
+					  register: ((IceSBBrowseHierarchyClassCommand
+							    forSpecWithIconNamed: #smallHierarchyBrowser
+							    shortcutKey: 'H' asShortcut) context: presenterInstance);
+					  beDisplayedAsGroup;
+					  yourself);
+
+		"Protocol commands"
+		register: ((CmCommandGroup named: 'MCProtocolsSelContextualMenu') asSpecGroup
+					  register: ((IceSBLoadProtocolCommand
+							    forSpecWithIconNamed: #smallLoadProject
+							    shortcutKey: 'P' asShortcut) context: presenterInstance);
+					  beDisplayedAsGroup;
+					  yourself);
+
+		"Method commands"
+		register: ((CmCommandGroup named: 'MCMethodsSelContextualMenu') asSpecGroup
+					  register: ((IceSBLoadMethodCommand
+							    forSpecWithIconNamed: #smallLoadProject
+							    shortcutKey: 'B' asShortcut) context: presenterInstance);
+					  register: ((IceSBBrowseFullMethodCommand
+							    forSpecWithIconNamed: #browse
+							    shortcutKey: 'M' asShortcut) context: presenterInstance);
+					  register: ((IceSBBrowseHierarchyMethodCommand
+							    forSpecWithIconNamed: #smallHierarchyBrowser 
+							    shortcutKey: 'Y' asShortcut) context: presenterInstance);
+					  register: ((IceSBBrowseMethodImplementorsCommand
+							    forSpecWithIconNamed: #browseMethodImplementors
+							    shortcutKey: 'T' asShortcut) context: presenterInstance);
+					  register: ((IceSBBrowseMethodInheritanceCommand
+							    forSpecWithIconNamed: #browseMethodInheritance
+							    shortcutKey: 'E' asShortcut) context: presenterInstance);
+					  register: ((IceSBBrowseMethodVersionsCommand
+							    forSpecWithIconNamed: #versionControl
+							    shortcutKey: 'V' asShortcut) context: presenterInstance);
+					  register: ((IceSBFileOutMethodCommand
+							    forSpecWithIconNamed: #save
+							    shortcutKey: 'O' asShortcut) context: presenterInstance);
+					  register: ((IceSBCopySelectorCommand
+							    forSpecWithIconNamed: #smallCopy
+							    shortcutKey: 'C' asShortcut) context: presenterInstance);
+					  beDisplayedAsGroup;
+					  yourself)
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser class >> defaultPreferredExtent [
+
+	^ 650 @ 400
+]
+
+{ #category : 'instance creation' }
+IceSnapshotBrowser class >> forSnapshot: aMCSnapshot [
+
+	^ self on: aMCSnapshot
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> allClassNames [
+	^ (items 
+		select: [:ea | (ea isOrganizationDefinition | ea isScriptDefinition) not]
+		thenCollect: [:ea | ea className]) asSet.
+
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> browserTitle [
+		
+	^ 'Snapshot Browser for: ' , titleString
+]
+
+{ #category : 'listing' }
+IceSnapshotBrowser >> categorySelection [
+
+	^ categoriesPresenter selectedItem
+]
+
+{ #category : 'text' }
+IceSnapshotBrowser >> classCommentString [
+	^ items
+		detect: [ :ea | ea isClassDefinition and: [ ea className = self classSelection ] ]
+		ifFound: [ :classDefinition | classDefinition comment ]
+		ifNone: [ '' ]
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> classDefinitionString [
+
+	| defs |
+	defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension])
+			and: [ea className = self classSelection]].
+
+	defs isEmpty ifTrue: [^ 'This class is defined elsewhere.'].
+
+	^ String streamContents: [:stream | 
+		defs asArray sort 
+			do: [:ea | ea printDefinitionOn: stream]
+			separatedBy: [stream nextPut: $.; cr] ].
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> classSelection [
+
+	^ classesPresenter selectedItem
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> classTarget: aClass [
+
+	^ self isClassSide
+		  ifTrue: [ aClass class ]
+		  ifFalse: [ aClass ]
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> connectPresenters [
+
+	categoriesPresenter 
+		transmitTo: classesPresenter
+		transform: [ : aCategory | 
+			aCategory
+				ifNotNil: [ self visibleClasses ]
+				ifNil: [	Array empty ] ].
+
+	classesPresenter
+		transmitTo: protocolsPresenter
+		transform: [ : aClass | aClass
+		  ifNotNil: [ self visibleProtocols ]
+		  ifNil: [ Array empty ] ].
+		
+	classesPresenter
+		transmitTo: classDefinitionPresenter 
+		transform: [ : aClass | self classDefinitionString ]
+		postTransmission: [ : p | p unselectAll. ].
+		
+	protocolsPresenter
+		transmitTo: methodsPresenter
+		transform: [ : aProtocolName | 
+			aProtocolName
+				ifNotNil: [ self visibleMethods ]
+				ifNil: [ Array empty ] ].
+			
+	methodsPresenter
+		transmitTo: srcCodePresenter
+		transform: [ :aMethod |
+			aMethod
+				ifNotNil: [ self updateSourceCode: aMethod ]
+				ifNil: [ '' ] ]
+		postTransmission: [ : p | p unselectAll. ]
+]
+
+{ #category : 'layout' }
+IceSnapshotBrowser >> defaultLayout [
+
+	^ SpPanedLayout newTopToBottom
+		  add: (SpBoxLayout newLeftToRight
+				   spacing: self spacingBetweenPanes;
+				   add: categoriesPresenter;
+				   add: classesPresenter;
+				   add: (SpBoxLayout newTopToBottom
+						    add: protocolsPresenter;
+						    add: classOrInstanceSelectorPresenter expand: false;
+						    yourself);
+				   add: methodsPresenter;
+				   yourself);
+		  add: (SpBoxLayout newLeftToRight
+				   spacing: self spacingBetweenPanes;
+				   add: (SpBoxLayout newTopToBottom
+						    spacing: self spacingBetweenPanes;
+						    add: classDefinitionPresenter;
+						    add: commentPresenter;
+						    yourself);
+				   add: srcCodePresenter;
+				   yourself);
+		  yourself
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> extensionClassNames [
+	^ (self allClassNames difference: self packageClassNames) asSortedCollection
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> extensionsCategory [
+	^ '*Extensions'
+]
+
+{ #category : 'file in/out' }
+IceSnapshotBrowser >> fileOutMessage [
+	"Put a description of the selected message on a file"
+
+	| fileName |
+	self selectedMessageName ifNotNil: [
+		Cursor write showWhile: [
+			self selectedClassOrMetaClass fileOutMethod: self selectedMessageName ].
+			^ self ].
+	items isEmpty ifTrue: [ ^ self ].
+	fileName := MorphicUIManager new
+		            request: 'File out on which file?'
+		            initialAnswer: 'methods'.
+	Cursor write showWhile: [
+		| internalStream |
+		internalStream := WriteStream on: (String new: 1000).
+		internalStream
+			header;
+			timeStamp.
+		items do: [ :patchOp |
+			patchOp definition isMethodDefinition ifTrue: [
+				(patchOp definition actualClass isNotNil and: [
+					 patchOp definition actualClass includesSelector:
+						 patchOp definition selector ])
+					ifTrue: [
+						patchOp definition actualClass
+							printMethodChunk: patchOp definition selector
+							on: internalStream ]
+					ifFalse: [
+						internalStream nextChunkPut:
+							patchOp definition className , ' removeSelector: '
+							, patchOp definition selector printString ] ].
+			patchOp definition isClassDefinition ifTrue: [
+				patchOp definition actualClass
+					ifNotNil: [
+						internalStream nextChunkPut:
+							patchOp definition actualClass definition.
+						patchOp definition comment ifNotNil: [
+							patchOp definition actualClass putCommentOnFile: internalStream ] ]
+					ifNil: [
+						internalStream nextChunkPut:
+							patchOp definition className , ' removeFromSystem' ] ] ].
+		CodeExporter
+			writeSourceCodeFrom: internalStream
+			baseName: fileName
+			isSt: true ]
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> hasExtensions [
+	^ self extensionClassNames notEmpty
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeCategoriesPresenter [
+
+	categoriesPresenter := self newFilteringList.
+	categoriesPresenter
+		items: self visibleCategories;
+		headerTitle: 'Categories';   
+		displayIcon: [ : aPackage | self iconNamed: aPackage systemIconName ];
+		sortingBlock: [ :a :b | a < b ] ;
+		contextMenu: [ (self rootCommandsGroup / 'MCCategorySelContextualMenu') beRoot asMenuPresenter ].
+
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeClassDefinitionPresenter [
+
+	classDefinitionPresenter := self newCode
+		beNotEditable;
+		yourself.
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeClassesPresenter [
+
+	classesPresenter := self newFilteringList.
+	classesPresenter
+		items: self visibleClasses;
+		headerTitle: 'Classes';
+		displayIcon: [ :aClass | self iconNamed: aClass systemIconName ];
+		sortingBlock: [ :a :b | a < b ];
+		contextMenu: [ (self rootCommandsGroup / 'MCClassSelContextualMenu') beRoot asMenuPresenter ]
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeCodePresenter [
+
+	srcCodePresenter := self newCode
+		beNotEditable;
+		withoutSyntaxHighlight;
+		withLineNumbers;
+		yourself.
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeCommentPresenter [
+
+	commentPresenter := self newText
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeMethodsPresenter [
+
+	methodsPresenter := self newFilteringList.
+	methodsPresenter
+		items: OrderedCollection new;
+		headerTitle: 'Methods';
+		sortingBlock: [ :a :b | a < b ];
+		contextMenu: [ (self rootCommandsGroup / 'MCMethodsSelContextualMenu') beRoot asMenuPresenter ]
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializePresenters [
+
+	self initializeCategoriesPresenter.
+	self initializeClassesPresenter.
+	self initializeProtocolsPresenter.
+	self initializeSideSelectorPresenter.
+	self initializeClassDefinitionPresenter.
+	self initializeMethodsPresenter.
+	self initializeCodePresenter.
+	self initializeCommentPresenter
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeProtocolsPresenter [
+
+	protocolsPresenter := self newFilteringList.
+	protocolsPresenter
+		headerTitle: 'Protocols';
+		contextMenu: [ (self rootCommandsGroup / 'MCProtocolsSelContextualMenu') beRoot asMenuPresenter ]
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeSideSelectorPresenter [
+
+	classOrInstanceSelectorPresenter := self newCheckBox
+		label: 'Class';
+		whenActivatedDo: [ 
+			protocolsPresenter 
+				headerTitle: 'Class protocols';
+				items: self visibleProtocols.
+			classDefinitionPresenter 
+				text: self metaclassDefinitionString;
+				unselectAll ];
+
+		whenDeactivatedDo: [ 
+			protocolsPresenter 
+				headerTitle: 'Instance protocols';
+				items: self visibleProtocols.
+			classDefinitionPresenter 
+				text: self classDefinitionString;
+				unselectAll  ];
+		yourself.
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> initializeWindow: aWindowPresenter [
+
+	aWindowPresenter
+		title: self browserTitle;
+		initialExtent: 1000 @ 700;
+		centered
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> isClassSide [
+	"Answer <true> if the receiver's class side is selected"
+
+	^ classOrInstanceSelectorPresenter isActive
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> metaclassDefinitionString [
+	| defs |
+	defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension])
+			and: [ea className = self classSelection]].
+
+	defs isEmpty ifTrue: [^ 'This class is defined elsewhere.'].
+
+	^ String streamContents: [:stream | 
+		defs asArray sort 
+			do: [:ea | ea printClassDefinitionOn: stream]
+			separatedBy: [stream nextPut: $.; cr] ].
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> methodsForSelectedClass [
+
+	^ items select: [ :ea | ea className = self classSelection and: [ ea isMethodDefinition and: [ ea classIsMeta = self switchIsClass ] ] ]
+]
+
+{ #category : 'executing' }
+IceSnapshotBrowser >> methodsForSelectedClassCategory [
+
+	| visibleClasses |
+	visibleClasses := self visibleClasses.
+	^ items select: [ :ea |
+		  (visibleClasses includes: ea className) and: [
+			  ea isMethodDefinition and: [ ea classIsMeta = self switchIsClass ] ] ]
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> methodsForSelectedProtocol [
+
+	| methods |
+	
+	self protocolSelection ifNil: [^ Array new].
+	methods := self methodsForSelectedClass asOrderedCollection.
+	(self protocolSelection = '-- all --') 
+		ifFalse: [methods removeAllSuchThat: [:ea | ea protocol ~= self protocolSelection]].
+	^ methods collect: #selector
+	
+								
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> packageClassNames [
+	^ self packageClasses collect: [:ea | ea className]
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> packageClasses [
+	^ items select: [:ea | ea isClassDefinition ]
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> packageOrganizations [
+
+	^ items select: [:ea | ea isOrganizationDefinition]
+]
+
+{ #category : 'selecting' }
+IceSnapshotBrowser >> protocolSelection [
+	
+	^ protocolsPresenter selectedItem
+]
+
+{ #category : 'file in/out' }
+IceSnapshotBrowser >> selectedClassOrMetaClass [
+
+	| class |
+
+	self classSelection ifNil: [ ^ nil ].
+	class := self class environment 
+		at: self classSelection 
+		ifAbsent: [ ^ nil ].
+	^ self switchIsClass
+		ifTrue: [ class class ]
+		ifFalse: [ class ]
+]
+
+{ #category : 'file in/out' }
+IceSnapshotBrowser >> selectedMessageName [
+	"Answer a <Symbol> representing the currently selected method selector"
+
+	^ self selectedMethod 
+		ifNotNil: [ ^ self selectedMethod selector ].
+
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> selectedMethod [
+
+	^ self methodsForSelectedClass anyOne
+]
+
+{ #category : 'accessing - model' }
+IceSnapshotBrowser >> setModelBeforeInitialization: aMCSnapshot [
+
+	items := aMCSnapshot definitions asSortedCollection.
+	titleString := (aMCSnapshot definitions detect: #isOrganizationDefinition) packageName
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> spacingBetweenPanes [
+	
+	^ 5
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> switchIsClass [
+
+	^ classOrInstanceSelectorPresenter state
+]
+
+{ #category : 'callbacks' }
+IceSnapshotBrowser >> updateSourceCode: aMCMethodSelector [ 
+
+	| mcDef |
+	mcDef := items detect: [ : mcObject |
+		(mcObject isMethodDefinition and: [ mcObject className = self classSelection ])
+			and: [ mcObject selector = aMCMethodSelector ] ].
+	^  mcDef source
+]
+
+{ #category : 'accessing' }
+IceSnapshotBrowser >> visibleCategories [
+
+	^ ((self packageOrganizations flatCollect: [ :ea | ea categories ]),
+		(self packageClasses collect: [ :ea | ea category ]),
+			(self hasExtensions ifTrue: [{ self extensionsCategory }] ifFalse: [#()]))
+				asSet asSortedCollection
+]
+
+{ #category : 'listing' }
+IceSnapshotBrowser >> visibleClasses [
+
+	^ self categorySelection = self extensionsCategory
+		ifTrue: [ self extensionClassNames ]
+		ifFalse: [
+			self packageClasses
+				select: [:ea | ea category = self categorySelection]
+				thenCollect: [:ea | ea className ] ].
+]
+
+{ #category : 'listing' }
+IceSnapshotBrowser >> visibleMethods [
+
+	^ self classSelection 
+		ifNil: [#()]
+		ifNotNil: [self methodsForSelectedProtocol]
+]
+
+{ #category : 'initialization' }
+IceSnapshotBrowser >> visibleProtocols [
+
+	| methods |
+
+	methods := self methodsForSelectedClass.
+	commentPresenter 
+		text: self classCommentString;
+		unselectAll.
+	^ (methods collect: [ :ea | ea category ]) asSet asSortedCollection
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/IceSnapshotBrowserCommand.class.st b/Iceberg-TipUI-SnapshotBrowser/IceSnapshotBrowserCommand.class.st
new file mode 100644
index 0000000000..016e339138
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/IceSnapshotBrowserCommand.class.st
@@ -0,0 +1,30 @@
+"
+I am a common superclass for all the commands of the Snapshot browser. 
+
+Probably we could reuse some of the Iceberg commands instead of those, we should iterate.
+"
+Class {
+	#name : 'IceSnapshotBrowserCommand',
+	#superclass : 'CmCommand',
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'accessing - selection' }
+IceSnapshotBrowserCommand >> selectedClass [
+
+	^ context classSelection
+]
+
+{ #category : 'private' }
+IceSnapshotBrowserCommand >> selectedClassIsLoaded [
+	"Answer <true> if the currently selected class is loaded in the system"
+
+	^ self class environment hasClassNamed: self selectedClass
+]
+
+{ #category : 'menu messages' }
+IceSnapshotBrowserCommand >> tools [
+
+	^ context application tools
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/MCSnapshotBrowser.class.st b/Iceberg-TipUI-SnapshotBrowser/MCSnapshotBrowser.class.st
new file mode 100644
index 0000000000..72f609697c
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/MCSnapshotBrowser.class.st
@@ -0,0 +1,676 @@
+"
+Browser for snapshots
+"
+Class {
+	#name : 'MCSnapshotBrowser',
+	#superclass : 'IceSnapshotBrowser',
+	#instVars : [
+		'categorySelection',
+		'classSelection',
+		'protocolSelection',
+		'methodSelection',
+		'switch',
+		'modal',
+		'morph',
+		'label'
+	],
+	#category : 'Iceberg-TipUI-SnapshotBrowser',
+	#package : 'Iceberg-TipUI-SnapshotBrowser'
+}
+
+{ #category : 'instance creation' }
+MCSnapshotBrowser class >> forSnapshot: aSnapshot [
+
+	^ self new snapshot: aSnapshot
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> accept [
+	" do nothing by default"
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> arrowKey: aCharacter from: aPluggableListMorph [ 
+	"backstop"
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> browseMessages [
+	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all implementors of the selector chosen."
+
+	self systemNavigation browseAllImplementorsOf: (self selectedMessageName ifNil: [ ^nil ])
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> browseMethodFull [
+	"Create and schedule a full Browser and then select the current class and message."
+
+	| myClass |
+	(myClass := self selectedClassOrMetaClass) ifNotNil:
+		[Smalltalk tools browser openOnClass: myClass selector: self selectedMessageName]
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> browseSendersOfMessages [
+	"Present a menu of the currently selected message, as well as all messages sent by it.  Open a message set browser of all senders of the selector chosen."
+
+	self systemNavigation browseAllSendersOf: (self selectedMessageName ifNil: [ ^nil ])
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> browseVersions [
+	"Create and schedule a message set browser on all versions of the 
+	currently selected message selector."
+	
+	Smalltalk tools versionBrowser  
+		browseVersionsForClass:  self selectedClassOrMetaClass 
+		selector: self selectedMessageName
+		
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> buildWindow [
+	| window |
+	window := SystemWindow labelled: self label.
+	window model: self.
+	self widgetSpecs do: [:spec |
+		| send fractions offsets |
+		send := spec first.
+		fractions := spec at: 2 ifAbsent: [#(0 0 1 1)].
+		offsets := spec at: 3 ifAbsent: [#(0 0 0 0)].
+		window
+			addMorph: (self perform: send first withArguments: send allButFirst)
+			fullFrame:
+				(LayoutFrame new 
+					leftFraction: fractions first; 
+					topFraction: fractions second;
+					rightFraction: fractions third ; 
+					bottomFraction: fractions fourth; 
+					leftOffset: offsets first;
+					topOffset: offsets second;
+					rightOffset: offsets third;
+					bottomOffset: offsets fourth)].
+	^ window
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> buttonEnabled [
+	^ true
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> buttonRow [
+	^ self buttonRow: self buttonSpecs
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> buttonRow: specArray [
+	| aRow |
+	aRow := PanelMorph new.
+	aRow layoutPolicy: TableLayout new; listDirection: #leftToRight.
+	aRow hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true.
+	aRow clipSubmorphs: true; borderWidth: 0.
+	aRow layoutInset: 2@2; cellInset: 1.
+	aRow wrapCentering: #center; cellPositioning: #leftCenter.
+	specArray do:
+		[:triplet | | aButton state |
+			state := triplet at: 5 ifAbsent: [#buttonState].
+			aButton := PluggableButtonMorph
+				on: self
+				getState: state
+				action: #performButtonAction:enabled:.
+			aButton
+				hResizing: #spaceFill;
+				vResizing: #spaceFill;
+				label: triplet first asString;
+				getEnabledSelector: (triplet at: 4 ifAbsent: [#buttonEnabled]);
+				arguments: (Array with: triplet second with: (triplet at: 4 ifAbsent: [#buttonEnabled])).
+			aRow addMorphBack: aButton.
+			aButton setBalloonText: triplet third].
+	^ aRow
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> buttonSelected [
+	^ false
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> buttonSpecs [
+	^ #(('instance' switchBeInstance 'show instance' buttonEnabled switchIsInstance)
+		('?' switchBeComment 'show comment' buttonEnabled switchIsComment)
+		('class' switchBeClass 'show class' buttonEnabled switchIsClass))
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> buttonState [
+	^ false
+]
+
+{ #category : 'listing' }
+MCSnapshotBrowser >> categoryList [
+	^ self visibleCategories
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> categoryListMenu: aMenu [ 
+	categorySelection
+		ifNotNil: [aMenu
+				add: (categorySelection = '*Extensions'
+						ifTrue: ['Load all extension methods']
+						ifFalse: ['Load class category {1}' format: {categorySelection}])
+				selector: #loadCategorySelection].
+	^ aMenu
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> categorySelection [
+	^ categorySelection ifNil: [0] ifNotNil: [self visibleCategories indexOf: categorySelection]
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> categorySelection: aNumber [
+	categorySelection := aNumber = 0 ifFalse: [self visibleCategories at: aNumber].
+	self classSelection: 0.
+	self changed: #categorySelection;
+		changed: #classList.
+
+]
+
+{ #category : 'text' }
+MCSnapshotBrowser >> classCommentString [
+	^ items
+		detect: [ :ea | ea isClassDefinition and: [ ea className = classSelection ] ]
+		ifFound: [ :classDefinition | classDefinition comment ]
+		ifNone: [ '' ]
+]
+
+{ #category : 'text' }
+MCSnapshotBrowser >> classDefinitionString [
+	| defs |
+	defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension])
+			and: [ea className = classSelection]].
+
+	defs isEmpty ifTrue: [^ 'This class is defined elsewhere.'].
+
+	^ String streamContents: [:stream | 
+		defs asArray sort 
+			do: [:ea | ea printDefinitionOn: stream]
+			separatedBy: [stream nextPut: $.; cr]
+	].
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> classHierarchy [
+	"Create and schedule a class list browser on the receiver's hierarchy."
+
+	self systemNavigation 
+		browseHierarchy: self selectedClassOrMetaClass
+		selector: self selectedMessageName	"OK if nil"
+]
+
+{ #category : 'listing' }
+MCSnapshotBrowser >> classList [
+	^ self visibleClasses
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> classListMenu: aMenu [
+
+	classSelection ifNil: [ ^ aMenu ].
+	aMenu
+		addList: #( #- #( 'Browse full (b)' browseMethodFull ) #( 'Browse hierarchy (h)' classHierarchy ) #- #( 'Show hierarchy' methodHierarchy ) );
+		addLine;
+		add: ('Load class {1}' format: { classSelection }) selector: #loadClassSelection.
+	^ aMenu
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> classSelection [
+	^ classSelection ifNil: [0] ifNotNil: [self visibleClasses indexOf: classSelection]
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> classSelection: aNumber [
+	classSelection := aNumber = 0 ifFalse: [self visibleClasses at: aNumber].
+	self protocolSelection: 0.
+	self changed: #classSelection; 
+		changed: #protocolList;
+		changed: #methodList.
+
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> close [
+
+	self window ifNotNil: [ :w | w delete ]
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> copySelector [
+	"Copy the selected selector to the clipboard"
+
+	| selector |
+	(selector := self selectedMessageName) ifNotNil:
+		[Clipboard clipboardText: selector asString]
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> defaultLabel [
+	^ 'Snapshot Browser'
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> inspectSelection [
+	^ self methodSelection inspect
+]
+
+{ #category : 'utilities' }
+MCSnapshotBrowser >> interactionModel [
+	^ self
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> label [
+	^ label ifNil: [self defaultLabel]
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> label: aString [
+
+	label := aString
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> listMorph: listSymbol [
+
+	| selectionSymbol |
+	selectionSymbol := (listSymbol , 'Selection') asSymbol.
+
+	^ PluggableListMorph
+		  on: self
+		  list: (listSymbol , 'List') asSymbol
+		  selected: selectionSymbol
+		  changeSelected: (selectionSymbol , ':') asSymbol
+		  menu: (listSymbol , 'ListMenu:') asSymbol
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol [
+	^ (PluggableListMorph
+		on: self
+		list: listSymbol
+		selected: selectionSymbol
+		changeSelected: (selectionSymbol, ':') asSymbol
+		menu: menuSymbol)
+		keystrokeActionSelector: keystrokeSymbol;
+		yourself
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> loadCategorySelection [
+	"Load the entire selected category"
+	categorySelection ifNil: [ ^self ].
+	self methodsForSelectedClassCategory do: [ :m | m load ].
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> loadClassSelection [
+	classSelection ifNil: [ ^ self ].
+	self packageClasses
+		detect: [ :ea | ea className = classSelection ]
+		ifFound: [ :packageClass | 
+			packageClass load.
+			self methodsForSelectedClass do: [ :m | m load ] ]
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> loadMethodSelection [
+	methodSelection ifNil: [ ^self ].
+	methodSelection load.
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> loadProtocolSelection [
+	protocolSelection ifNil: [ ^self ].
+	self methodsForSelectedProtocol do: [ :m | m load ].
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> menu [
+	" returns nil to let the editing mode offer the right menu"
+	^ nil
+]
+
+{ #category : 'text' }
+MCSnapshotBrowser >> metaclassDefinitionString [
+	| defs |
+	defs := items select: [:ea | (ea isClassDefinition or: [ea isClassDefinitionExtension])
+			and: [ea className = classSelection]].
+
+	defs isEmpty ifTrue: [^ 'This class is defined elsewhere.'].
+
+	^ String streamContents: [:stream | 
+		defs asArray sort 
+			do: [:ea | ea printClassDefinitionOn: stream]
+			separatedBy: [stream nextPut: $.; cr]
+	].
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> methodHierarchy [
+	"Create and schedule a method browser on the hierarchy of implementors."
+
+	self systemNavigation methodHierarchyBrowserForClass: self selectedClassOrMetaClass
+		selector: self selectedMessageName
+]
+
+{ #category : 'listing' }
+MCSnapshotBrowser >> methodList [
+	^ self visibleMethods collect: [:ea | ea selector]
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> methodListKey: aKeystroke from: aListMorph [ 
+	aKeystroke caseOf: {
+		[$b] -> [self browseMethodFull].
+		[$h] -> [self classHierarchy].
+		[$o] -> [self fileOutMessage].
+		[$c] -> [self copySelector].
+		[$n] -> [self browseSendersOfMessages].
+		[$m] -> [self browseMessages].
+		[$i] -> [self methodHierarchy].
+		[$v] -> [self browseVersions]}
+		 otherwise: []
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> methodListMenu: aMenu [
+
+	self selectedMessageName
+		ifNil: [ items isNotEmpty ifTrue: [ aMenu add: 'FileOut (o)' selector: #fileOutMessage ] ]
+		ifNotNil: [
+			aMenu addList:
+				#( #( 'Browse full (b)' browseMethodFull ) #( 'Browse hierarchy (h)' classHierarchy ) #- #( 'FileOut (o)' fileOutMessage ) #( 'Copy selector (c)'
+				      copySelector ) ).
+			aMenu addList: #( #- #( 'Browse senders (n)' browseSendersOfMessages ) #( 'Browse implementors (m)' browseMessages )
+				   #( 'Inheritance (i)' methodHierarchy ) #( 'Versions (v)' browseVersions ) ) ].
+
+
+	(self selectedMessageName isNotNil and: [ methodSelection isLoadable ]) ifTrue: [
+		aMenu
+			addLine;
+			add: 'Load method' selector: #loadMethodSelection ].
+	^ aMenu
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> methodSelection [
+	^ methodSelection
+			ifNil: [0] 
+			ifNotNil: [self visibleMethods indexOf: methodSelection]
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> methodSelection: aNumber [
+	methodSelection := aNumber = 0 ifFalse: [self visibleMethods at: aNumber].
+	self changed: #methodSelection; changed: #text.
+]
+
+{ #category : 'accessing' }
+MCSnapshotBrowser >> methodsForSelectedClass [
+
+	^ items select: [ :ea | ea className = classSelection and: [ ea isMethodDefinition and: [ ea classIsMeta = self switchIsClass ] ] ]
+]
+
+{ #category : 'accessing' }
+MCSnapshotBrowser >> methodsForSelectedProtocol [
+	| methods |
+	protocolSelection ifNil: [^ Array new].
+	methods := self methodsForSelectedClass asOrderedCollection.
+	(protocolSelection = '-- all --') 
+		ifFalse: [methods removeAllSuchThat: [:ea | ea protocol ~= protocolSelection]].
+	^ methods 
+	
+								
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> performButtonAction: anActionSelector enabled: anEnabledSelector [
+	(self perform: anEnabledSelector) 
+		ifTrue: [ self perform: anActionSelector ]
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> preferredColor [  
+	^ (Color r: 0.627 g: 0.69 b: 0.976)
+]
+
+{ #category : 'listing' }
+MCSnapshotBrowser >> protocolList [
+	^ self visibleProtocols
+]
+
+{ #category : 'menus' }
+MCSnapshotBrowser >> protocolListMenu: aMenu [ 
+	protocolSelection
+		ifNotNil: [aMenu
+				add: ('Load protocol ''{1}''' format: {protocolSelection})
+				selector: #loadProtocolSelection ].
+	^ aMenu
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> protocolSelection [
+	^ protocolSelection 
+		ifNil: [0]
+		ifNotNil: [self visibleProtocols indexOf: protocolSelection]
+]
+
+{ #category : 'selecting' }
+MCSnapshotBrowser >> protocolSelection: anInteger [
+	protocolSelection := (anInteger = 0 ifFalse: [self visibleProtocols at: anInteger]).
+	self methodSelection: 0.
+	self changed: #protocolSelection;
+		changed: #methodList.
+]
+
+{ #category : 'text' }
+MCSnapshotBrowser >> scriptDefinitionString [
+	| defs |
+	defs := items select: [:ea | ea isScriptDefinition].
+	defs isEmpty ifTrue: [^'(package defines no scripts)'].
+	
+	^ String streamContents: [:stream | 
+		defs asArray sort 
+			do: [:ea | stream nextPutAll: '---------- package ';
+					nextPutAll: ea scriptSelector;
+					nextPutAll: ' ----------'; cr;
+					nextPutAll: ea script; cr]
+			separatedBy: [stream cr]].
+]
+
+{ #category : 'accessing' }
+MCSnapshotBrowser >> selectedClass [
+	classSelection ifNil: [ ^ nil ].
+	^ Smalltalk globals at: classSelection ifAbsent: [ nil ]
+]
+
+{ #category : 'accessing' }
+MCSnapshotBrowser >> selectedClassOrMetaClass [
+	| class |
+	classSelection ifNil: [ ^ nil ].
+	class := Smalltalk globals at: classSelection ifAbsent: [ ^ nil ].
+	^ self switchIsClass
+		ifTrue: [ class class ]
+		ifFalse: [ class ]
+]
+
+{ #category : 'accessing' }
+MCSnapshotBrowser >> selectedMessageCategoryName [
+	^protocolSelection
+]
+
+{ #category : 'accessing' }
+MCSnapshotBrowser >> selectedMessageName [
+	^methodSelection ifNotNil: [^ methodSelection selector ].
+
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> shoutAboutToStyle: aPluggableShoutMorphOrView [
+	^ false
+]
+
+{ #category : 'opening' }
+MCSnapshotBrowser >> show [
+	"Open the tool returning the window."
+
+	modal := false.
+	self window openInWorld.
+	^ self window
+]
+
+{ #category : 'opening' }
+MCSnapshotBrowser >> showLabelled: labelString [
+
+	modal := false.
+	self label: labelString.
+	self window openInWorld.
+	^ self window
+]
+
+{ #category : 'switch' }
+MCSnapshotBrowser >> signalSwitchChanged [
+	self protocolSelection: 0.
+	self 
+		changed: #switchIsInstance;
+		changed: #switchIsComment;
+		changed: #switchIsClass;
+		changed: #protocolList;
+		changed: #methodList;
+		changed: #text.
+]
+
+{ #category : 'accessing' }
+MCSnapshotBrowser >> snapshot: aSnapshot [
+	items := aSnapshot definitions asSortedCollection.
+	self categorySelection: 0.
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> summary: aString [
+	" do nothing by default"
+]
+
+{ #category : 'switch' }
+MCSnapshotBrowser >> switchBeClass [
+	switch := #class.
+	self signalSwitchChanged.
+]
+
+{ #category : 'switch' }
+MCSnapshotBrowser >> switchBeComment [
+	switch := #comment.
+	self signalSwitchChanged.
+]
+
+{ #category : 'switch' }
+MCSnapshotBrowser >> switchBeInstance [
+	switch := #instance.
+	self signalSwitchChanged.
+]
+
+{ #category : 'switch' }
+MCSnapshotBrowser >> switchIsClass [
+	^ switch = #class
+]
+
+{ #category : 'switch' }
+MCSnapshotBrowser >> switchIsComment [
+	^ switch = #comment.
+]
+
+{ #category : 'switch' }
+MCSnapshotBrowser >> switchIsInstance [
+	switch ifNil: [switch := #instance].
+	^ switch = #instance.
+]
+
+{ #category : 'text' }
+MCSnapshotBrowser >> text [
+	self switchIsComment ifTrue: [ ^ self classCommentString ].
+	methodSelection ifNotNil: [ ^ methodSelection source ].
+	protocolSelection ifNotNil: [ ^ '' ].
+	classSelection ifNotNil: [
+		^ self switchIsClass 
+			ifTrue: [ self metaclassDefinitionString ]
+			ifFalse: [ self classDefinitionString ] ].
+	categorySelection ifNil: [ ^ self scriptDefinitionString ].
+	^ ''
+]
+
+{ #category : 'text' }
+MCSnapshotBrowser >> text: aTextOrString [
+	self changed: #text
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> textMorph: aSymbol [
+	| textMorph |
+	textMorph := RubPluggableTextMorph new
+		getTextSelector: aSymbol;
+		setTextSelector: (aSymbol , ':') asSymbol;
+		on: self;
+		beWrapped;
+		hScrollbarShowNever;
+		beForSmalltalkScripting;
+		yourself.
+	textMorph announcer when: RubTextAcceptRequest send: #accept to: self.
+	textMorph hasUnacceptedEdits: false.
+	^ textMorph
+]
+
+{ #category : 'listing' }
+MCSnapshotBrowser >> visibleClasses [
+	^ categorySelection = self extensionsCategory
+		ifTrue: [self extensionClassNames]
+		ifFalse: [self packageClasses
+					select: [:ea | ea category = categorySelection]
+					thenCollect: [:ea | ea className]].
+]
+
+{ #category : 'listing' }
+MCSnapshotBrowser >> visibleMethods [
+	^ classSelection 
+		ifNil: [#()]
+		ifNotNil: [self methodsForSelectedProtocol]
+]
+
+{ #category : 'listing' }
+MCSnapshotBrowser >> visibleProtocols [
+
+	| methods |
+	self switchIsComment ifTrue: [ ^ Array new ].
+	methods := self methodsForSelectedClass.
+	^ (methods collect: [ :ea | ea category ]) asSet asSortedCollection
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> widgetSpecs [
+
+	 ^#(
+		((listMorph: category) (0 0 0.25 0.4))
+		((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30))
+		((listMorph: protocol) (0.50 0 0.75 0.4))
+		((listMorph:selection:menu:keystroke:  methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
+		((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
+		((textMorph: text) (0 0.4 1 1))
+		) 
+]
+
+{ #category : 'morphic ui' }
+MCSnapshotBrowser >> window [
+
+	^ morph ifNil: [ morph := self buildWindow ]
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/MCVersion.extension.st b/Iceberg-TipUI-SnapshotBrowser/MCVersion.extension.st
new file mode 100644
index 0000000000..0d4858e6a3
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/MCVersion.extension.st
@@ -0,0 +1,7 @@
+Extension { #name : 'MCVersion' }
+
+{ #category : '*Iceberg-TipUI-SnapshotBrowser' }
+MCVersion >> browse [
+
+	^ (IceSnapshotBrowser forSnapshot: self completeSnapshot) open
+]
diff --git a/Iceberg-TipUI-SnapshotBrowser/package.st b/Iceberg-TipUI-SnapshotBrowser/package.st
new file mode 100644
index 0000000000..7af7886cb1
--- /dev/null
+++ b/Iceberg-TipUI-SnapshotBrowser/package.st
@@ -0,0 +1 @@
+Package { #name : 'Iceberg-TipUI-SnapshotBrowser' }