new navigation pane for inspector

src/MooseIDE-NewTools-Tests/MiModelNavigationBrowserTest.class.st

@@ -11,11 +11,9 @@ Class {
 { #category : #tests }
 MiModelNavigationBrowserTest >> clickOnAllClasses [
 
-	| navigationTable |
-	navigationTable := browser presenterAt: #navigation.
-
-	navigationTable selectItem:
-		(navigationTable items detect: [ :item | item key = 'All classes' ])
+	| navigationTreeTable |
+	navigationTreeTable := browser presenterAt: #navigation.
+	navigationTreeTable selectItem: navigationTreeTable roots first
 ]
 
 { #category : #running }
@@ -28,7 +26,7 @@ MiModelNavigationBrowserTest >> setUp [
 		                  newClassNamed: #C2;
 		                  yourself.
 
-	browser := MiModelNavigationBrowser on: inspectedModel
+	browser := MiMetaModelNavigationBrowser on: inspectedModel
 ]
 
 { #category : #running }
@@ -44,5 +42,5 @@ MiModelNavigationBrowserTest >> testClickingOpensMooseGroup [
 
 	self clickOnAllClasses.
 
-	self assert: browser selectedObject equals: inspectedModel allClasses
+	self assert: browser selectedObject equals: (inspectedModel allWithType: FamixStClass)
 ]

src/MooseIDE-NewTools/MiAbstractGroupNavigationBrowser.class.st → src/MooseIDE-NewTools/MiAbstractMetaGroupNavigationBrowser.class.st

@@ -21,23 +21,17 @@ Internal Representation and Key Implementation Points.
     Implementation Points
 "
 Class {
-	#name : #MiAbstractGroupNavigationBrowser,
-	#superclass : #MiNavigationBrowser,
+	#name : #MiAbstractMetaGroupNavigationBrowser,
+	#superclass : #MiMetaNavigationBrowser,
 	#category : #'MooseIDE-NewTools-Inspector tabs'
 }
 
 { #category : #initialization }
-MiAbstractGroupNavigationBrowser >> initializePresenters [
+MiAbstractMetaGroupNavigationBrowser >> initializePresenters [
 
 	super initializePresenters.
 	navigation whenActivatedDo: [ :selection |
 		self inspectorObjectContextPresenter owner
 			changeSelection: selection selectedItem value
-			from: self inspectorObjectContextPresenter ]
-]
-
-{ #category : #initialization }
-MiAbstractGroupNavigationBrowser >> itemsFor: anEntity [
-
-	^ anEntity collect: [ :entity | entity inspectorToString -> entity ]
+			from: self inspectorObjectContextPresenter ].
 ]

src/MooseIDE-NewTools/MiMetaModelNavigationBrowser.class.st

@@ -0,0 +1,68 @@
+Class {
+	#name : #MiMetaModelNavigationBrowser,
+	#superclass : #MiMetaNavigationBrowser,
+	#category : #'MooseIDE-NewTools-Inspector tabs'
+}
+
+{ #category : #initialization }
+MiMetaModelNavigationBrowser >> iconBlock [
+
+	^ [ :el | self iconNamed: #mooseMetamodelGroup ]
+]
+
+{ #category : #initialization }
+MiMetaModelNavigationBrowser >> initializePresenters [
+
+	| sizeColumn |
+	super initializePresenters.
+	navigation whenActivatedDo: [ :selection |
+		self inspectorObjectContextPresenter owner
+			changeSelection: selection selectedItem value
+			from: self inspectorObjectContextPresenter ].
+	navigation children: [ :aFMPackage |
+		{  }
+		"aFMPackage value isFM3Package
+			ifTrue: [
+				((aFMPackage value classes reject: [ :a |
+					  a implementingClass isTrait ])
+					 collect: [ :metaClass |
+						 metaClass name
+						 -> (self model allWithType: metaClass implementingClass) ]
+					 thenReject: [ :a | a value isEmpty ]) sorted: [ :a :b |
+					a name < b name ] ]
+			ifFalse: [ {  } ]" ].
+	sizeColumn := SpStringTableColumn new
+		              title: 'Size';
+		              width: 50;
+		              evaluated: [ :each |
+			              each value isCollection
+				              ifTrue: [ each value size printString ]
+				              ifFalse: [ '' ] ].
+	navigation columns: (navigation columns copyWithFirst: sizeColumn).
+	navigation items: (((navigation roots flatCollect: [ :el |
+
+			   el value classes
+				   reject: [ :a | a implementingClass isTrait ]
+				   thenCollect: [ :clazz |
+
+					   clazz name
+					   -> (self model allWithType: clazz implementingClass ofGroupClass: MooseSpecializedGroup) ] ])
+			  reject: [ :a | a value isEmpty ]) sorted: [ :a :b |
+			 a name < b name ]).
+	navigation expandRoots
+]
+
+{ #category : #accessing }
+MiMetaModelNavigationBrowser >> selectedItem [
+
+	^ ([ 
+	   self model mooseInterestingEntity perform:
+		   navigation selection selectedItem value ] onErrorDo: [ nil ])
+		  mooseInterestingEntity
+]
+
+{ #category : #initialization }
+MiMetaModelNavigationBrowser >> selectedObject [
+
+	^ navigation selection selectedItem value
+]

src/MooseIDE-NewTools/MiMetaNavigationBrowser.class.st

@@ -0,0 +1,229 @@
+"
+Please comment me using the following template inspired by Class Responsibility Collaborator (CRC) design:
+
+For the Class part:  State a one line summary. For example, ""I represent a paragraph of text"".
+
+For the Responsibility part: Three sentences about my main responsibilities - what I do, what I know.
+
+For the Collaborators Part: State my main collaborators and one line about how I interact with them. 
+
+Public API and Key Messages
+
+- message one   
+- message two 
+- (for bonus points) how to create instances.
+
+   One simple example is simply gorgeous.
+
+Internal Representation and Key Implementation Points.
+
+    Instance Variables
+	model:		<Object>
+	properties:		<Object>
+
+
+    Implementation Points
+"
+Class {
+	#name : #MiMetaNavigationBrowser,
+	#superclass : #StPresenter,
+	#instVars : [
+		'navigation',
+		'model',
+		'activationBlock',
+		'activateOnSingleClick',
+		'properties',
+		'entitiesColumn',
+		'actionBar',
+		'shouldShowPropertiesPane'
+	],
+	#category : #'MooseIDE-NewTools-Inspector tabs'
+}
+
+{ #category : #specs }
+MiMetaNavigationBrowser class >> buildCommandsGroupWith: presenter forRoot: aCmCommandsGroup [
+	aCmCommandsGroup
+		beDisplayedAsGroup;
+		register: (StInspectorInspectSelectedCommand forSpecContext: presenter)
+]
+
+{ #category : #'as yet unclassified' }
+MiMetaNavigationBrowser class >> defaultShouldShowPropertiesPane [
+
+	^ false
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> activateOnSingleClick [
+	navigation activateOnSingleClick
+]
+
+{ #category : #accessing }
+MiMetaNavigationBrowser >> activateOnSingleClick: anObject [
+
+	activateOnSingleClick := anObject
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> addPropertiesPane [
+
+	self layout add: properties
+]
+
+{ #category : #layout }
+MiMetaNavigationBrowser >> defaultLayout [
+
+	^ SpBoxLayout newTopToBottom
+		  add: (SpBoxLayout newTopToBottom
+				   add: #navigation;
+				   yourself);
+		  add: #actionBar expand: false;
+		  yourself
+]
+
+{ #category : #action }
+MiMetaNavigationBrowser >> filterEmptyValues: entities [
+
+	^ entities select: [ :each | 
+		  each value isCollection
+			  ifTrue: [ each value isNotEmpty ]
+			  ifFalse: [ true ] ]
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> hasOutputActivationPort [
+
+	^ true
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> iconBlock [
+
+	^ [ :el | el value mooseIcon ]
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> initializePresenters [
+
+	| items |
+	"navigation"
+	navigation := self newTreeTable.
+	navigation isResizable: true.
+	items := self filterEmptyValues: (self itemsFor: self model).
+	entitiesColumn := SpStringTableColumn new
+		                  evaluated: [ :el |
+			                  String streamContents: [ :str |
+					                  self printEntry: el on: str ] ];
+		                  beSortable;
+		                  yourself.
+	navigation addColumn: (SpCompositeTableColumn new
+			 title: 'Entities';
+			 addColumn: (SpImageTableColumn new
+					  width: 20;
+					  evaluated: self iconBlock;
+					  yourself);
+			 addColumn: entitiesColumn).
+	navigation children: [ :anEntity | self itemsFor: anEntity value ].
+	navigation
+		contextMenu: [ self rootCommandsGroup asMenuPresenter ];
+		items: items.
+	navigation whenActivatedDo: [ :selection |
+		self inspectorObjectContextPresenter owner
+			changeSelection: selection selectedItem value
+			from: self inspectorObjectContextPresenter ].
+	"action bar"
+	actionBar := self newActionBar add: (self newButton
+			              label: 'Properties';
+			              help: 'Show properties panel';
+			              action: [ self toggleShouldShowPropertiesPane ];
+			              yourself).
+	"properties"
+	properties := MiPropertyExtension on: self model.
+	self shouldShowPropertiesPane ifTrue: [ self addPropertiesPane ]
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> inspectorObjectContextPresenter [
+
+	^ self owner owner owner owner
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> itemsFor: anEntity [
+
+	^ anEntity isMooseObject
+		  ifTrue: [ anEntity miMetaNavigationItems ]
+		  ifFalse: [ {  } ]
+]
+
+{ #category : #accessing }
+MiMetaNavigationBrowser >> model [
+	^ model
+]
+
+{ #category : #accessing }
+MiMetaNavigationBrowser >> model: anObject [
+	model := anObject
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> outputActivationPort [
+	^ (SpActivationPort newPresenter: self)
+		yourself
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> printEntry: el on: aStream [
+
+	aStream nextPutAll: el key.
+	(el value isBlock not and: [ el value mooseName ~= el key ])
+		ifFalse: [ ^ self ].
+	aStream nextPutAll: ': '.
+	aStream nextPutAll: el value mooseName
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> removePropertiesPane [
+
+	self layout remove: properties
+]
+
+{ #category : #accessing }
+MiMetaNavigationBrowser >> selectedItem [
+
+	^ navigation selection selectedItem value
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> selectedObject [
+	^ navigation selection selectedItem value
+]
+
+{ #category : #'accessing - model' }
+MiMetaNavigationBrowser >> setModelBeforeInitialization: anInspectionModel [ 
+
+	model := anInspectionModel
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> shouldShowPropertiesPane [
+
+	^ shouldShowPropertiesPane ifNil: [ self class defaultShouldShowPropertiesPane ]
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> toggleShouldShowPropertiesPane [
+
+	^ self shouldShowPropertiesPane
+		  ifTrue: [
+			  shouldShowPropertiesPane := false.
+			  self removePropertiesPane ]
+		  ifFalse: [
+			  shouldShowPropertiesPane := true.
+			  self addPropertiesPane ]
+]
+
+{ #category : #initialization }
+MiMetaNavigationBrowser >> whenActivatedDo: aBlock [
+	activationBlock := aBlock
+]