diff --git a/src/MooseIDE-NewTools-Tests/MiModelNavigationBrowserTest.class.st b/src/MooseIDE-NewTools-Tests/MiModelNavigationBrowserTest.class.st index 1a73fa80b..2317b3131 100644 --- a/src/MooseIDE-NewTools-Tests/MiModelNavigationBrowserTest.class.st +++ b/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) ] diff --git a/src/MooseIDE-NewTools/MiAbstractGroupNavigationBrowser.class.st b/src/MooseIDE-NewTools/MiAbstractMetaGroupNavigationBrowser.class.st similarity index 72% rename from src/MooseIDE-NewTools/MiAbstractGroupNavigationBrowser.class.st rename to src/MooseIDE-NewTools/MiAbstractMetaGroupNavigationBrowser.class.st index 1128fdbf3..491bc36b9 100644 --- a/src/MooseIDE-NewTools/MiAbstractGroupNavigationBrowser.class.st +++ b/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 ]. ] diff --git a/src/MooseIDE-NewTools/MiMetaModelNavigationBrowser.class.st b/src/MooseIDE-NewTools/MiMetaModelNavigationBrowser.class.st new file mode 100644 index 000000000..bd5494969 --- /dev/null +++ b/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 +] diff --git a/src/MooseIDE-NewTools/MiMetaNavigationBrowser.class.st b/src/MooseIDE-NewTools/MiMetaNavigationBrowser.class.st new file mode 100644 index 000000000..e5887e3ed --- /dev/null +++ b/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: + properties: + + + 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 +] diff --git a/src/MooseIDE-NewTools/MiModelNavigationBrowser.class.st b/src/MooseIDE-NewTools/MiModelNavigationBrowser.class.st deleted file mode 100644 index bfa7082e2..000000000 --- a/src/MooseIDE-NewTools/MiModelNavigationBrowser.class.st +++ /dev/null @@ -1,29 +0,0 @@ -Class { - #name : #MiModelNavigationBrowser, - #superclass : #MiNavigationBrowser, - #category : #'MooseIDE-NewTools-Inspector tabs' -} - -{ #category : #initialization } -MiModelNavigationBrowser >> entitiesForActivationOf: selection [ - - ^ selection value value: self model -] - -{ #category : #initialization } -MiModelNavigationBrowser >> iconBlock [ - - ^ [ :el | self iconNamed: #mooseMetamodelGroup ] -] - -{ #category : #initialization } -MiModelNavigationBrowser >> itemsFor: anEntity [ - - ^ anEntity navigationItemsFromPragmas -] - -{ #category : #initialization } -MiModelNavigationBrowser >> selectedObject [ - - ^ navigation selectedItem value value: self model -] diff --git a/src/MooseIDE-NewTools/MiNavigationBrowser.class.st b/src/MooseIDE-NewTools/MiNavigationBrowser.class.st deleted file mode 100644 index 44ea8f017..000000000 --- a/src/MooseIDE-NewTools/MiNavigationBrowser.class.st +++ /dev/null @@ -1,181 +0,0 @@ -" -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: - properties: - - - Implementation Points -" -Class { - #name : #MiNavigationBrowser, - #superclass : #StPresenter, - #instVars : [ - 'navigation', - 'model', - 'activationBlock', - 'activateOnSingleClick' - ], - #category : #'MooseIDE-NewTools-Inspector tabs' -} - -{ #category : #specs } -MiNavigationBrowser class >> buildCommandsGroupWith: presenter forRoot: aCmCommandsGroup [ - aCmCommandsGroup - beDisplayedAsGroup; - register: (StInspectorInspectSelectedCommand forSpecContext: presenter) -] - -{ #category : #layout } -MiNavigationBrowser class >> defaultLayout [ - - ^ SpBoxLayout newVertical - add: #navigation; - yourself -] - -{ #category : #initialization } -MiNavigationBrowser >> activateOnSingleClick [ - navigation activateOnSingleClick -] - -{ #category : #accessing } -MiNavigationBrowser >> activateOnSingleClick: anObject [ - - activateOnSingleClick := anObject -] - -{ #category : #initialization } -MiNavigationBrowser >> entitiesForActivationOf: selection [ - - ^ selection value -] - -{ #category : #action } -MiNavigationBrowser >> filterEmptyValues: entities [ - - ^ entities select: [ :each | - | values | - values := self entitiesForActivationOf: each. - values isCollection - ifTrue: [ values isNotEmpty ] - ifFalse: [ true ] ] -] - -{ #category : #initialization } -MiNavigationBrowser >> hasOutputActivationPort [ - - ^ true -] - -{ #category : #initialization } -MiNavigationBrowser >> iconBlock [ - - ^ [ :el | el value mooseIcon ] -] - -{ #category : #initialization } -MiNavigationBrowser >> initializePresenters [ - - | items | - navigation := self newTable. - items := self filterEmptyValues: (self itemsFor: self model). - navigation - addColumn: (SpImageTableColumn new - beNotExpandable; - evaluated: self iconBlock; - yourself); - addColumn: (SpStringTableColumn new - title: 'Size'; - evaluated: [ :el | - ((self entitiesForActivationOf: el) - ifNil: [ '-' ] - ifNotNil: [ :coll | - coll isCollection - ifTrue: [ coll size ] - ifFalse: [ '-' ] ]) asString ]; - beSortable; - width: 60; - yourself); - addColumn: (SpStringTableColumn new - title: 'Entities'; - evaluated: [ :el | el key ]; - beSortable; - yourself). - navigation - contextMenu: [ self rootCommandsGroup asMenuPresenter ]; - items: items. - navigation whenActivatedDo: [ :selection | - self inspectorObjectContextPresenter owner changeSelection: (self entitiesForActivationOf: selection selectedItem) from: self inspectorObjectContextPresenter ] -] - -{ #category : #initialization } -MiNavigationBrowser >> inspectorObjectContextPresenter [ - - ^ self owner owner owner owner -] - -{ #category : #initialization } -MiNavigationBrowser >> itemsFor: anEntity [ - - ^ anEntity mooseDescription allComplexProperties - collect: [ :property | property name -> (anEntity propertyNamed: property name ifAbsent: [ nil ]) ] - thenReject: [ :assoc | assoc value isNil or: [ assoc value isCollection and: [ assoc value isEmpty ] ] ] -] - -{ #category : #accessing } -MiNavigationBrowser >> model [ - ^ model -] - -{ #category : #accessing } -MiNavigationBrowser >> model: anObject [ - model := anObject -] - -{ #category : #initialization } -MiNavigationBrowser >> outputActivationPort [ - - ^ (SpActivationPort newPresenter: self) yourself -] - -{ #category : #accessing } -MiNavigationBrowser >> selectedItem [ - - ^ navigation selection selectedItem value -] - -{ #category : #initialization } -MiNavigationBrowser >> selectedObject [ - - ^ navigation selection selectedItem value -] - -{ #category : #'accessing - model' } -MiNavigationBrowser >> setModelBeforeInitialization: anInspectionModel [ - - model := anInspectionModel -] - -{ #category : #initialization } -MiNavigationBrowser >> whenActivatedDo: aBlock [ - - activationBlock := aBlock -] diff --git a/src/MooseIDE-NewTools/MiPropertyExtension.class.st b/src/MooseIDE-NewTools/MiPropertyExtension.class.st index 94730afb4..38f6dec5f 100644 --- a/src/MooseIDE-NewTools/MiPropertyExtension.class.st +++ b/src/MooseIDE-NewTools/MiPropertyExtension.class.st @@ -21,16 +21,16 @@ MiPropertyExtension >> initializePresenters [ properties := self newTable. properties - addColumn: (SpStringTableColumn - title: 'Properties' + addColumn: (SpStringTableColumn new + title: 'Properties'; + width: 200; evaluated: [ :item | item name ]) yourself; - addColumn: - (SpStringTableColumn title: 'Value' evaluated: [ :item | - [ self model mmGetProperty: item ] - on: Error - do: [ 'error' ] ]); + addColumn: (SpStringTableColumn title: 'Value' evaluated: [ :item | + [ self model mmGetProperty: item ] + on: Error + do: [ 'error' ] ]); items: (self model mooseDescription allPrimitiveProperties sorted: - #name ascending); + #name ascending); beResizable ] diff --git a/src/MooseIDE-NewTools/MooseAbstractGroup.extension.st b/src/MooseIDE-NewTools/MooseAbstractGroup.extension.st index ac80f5e6b..1e4c4df8a 100644 --- a/src/MooseIDE-NewTools/MooseAbstractGroup.extension.st +++ b/src/MooseIDE-NewTools/MooseAbstractGroup.extension.st @@ -30,8 +30,14 @@ MooseAbstractGroup >> details [ ] { #category : #'*MooseIDE-NewTools' } -MooseAbstractGroup >> miNavigationInspectorExtension [ +MooseAbstractGroup >> miMetaNavigationInspectorExtension [ - ^ MiAbstractGroupNavigationBrowser on: self + ^ MiAbstractMetaGroupNavigationBrowser on: self +] + +{ #category : #'*MooseIDE-NewTools' } +MooseAbstractGroup >> miMetaNavigationItems [ + + ^ self collect: [ :entity | entity inspectorToString -> entity ] ] diff --git a/src/MooseIDE-NewTools/MooseGroup.extension.st b/src/MooseIDE-NewTools/MooseGroup.extension.st index 4926a5908..a20a2fc55 100644 --- a/src/MooseIDE-NewTools/MooseGroup.extension.st +++ b/src/MooseIDE-NewTools/MooseGroup.extension.st @@ -12,3 +12,9 @@ MooseGroup >> mooseInterestingEntity [ ifTrue: [ self first mooseInterestingEntity ] ifFalse: [ self specialize ] ] + +{ #category : #'*MooseIDE-NewTools' } +MooseGroup >> sum [ + + ^ storage sum +] diff --git a/src/MooseIDE-NewTools/MooseModel.extension.st b/src/MooseIDE-NewTools/MooseModel.extension.st index 4526980f2..3c0454007 100644 --- a/src/MooseIDE-NewTools/MooseModel.extension.st +++ b/src/MooseIDE-NewTools/MooseModel.extension.st @@ -1,21 +1,25 @@ Extension { #name : #MooseModel } { #category : #'*MooseIDE-NewTools' } -MooseModel >> miNavigationInspectorExtension [ +MooseModel >> miMetaNavigationInspectorExtension [ - ^ MiModelNavigationBrowser on: self + ^ MiMetaModelNavigationBrowser on: self ] { #category : #'*MooseIDE-NewTools' } -MooseModel >> navigationItemsFromMetamodel [ +MooseModel >> miMetaNavigationItems [ + + ^ (self metamodel packages sorted: #name ascending) collect: [ + :fm3package | fm3package name -> fm3package ] +] - | classes | +{ #category : #'*MooseIDE-NewTools' } +MooseModel >> navigationItemsFromMetamodel [ - ^ (self metamodel classes reject: [ :a | - a implementingClass isTrait ]) - collect: [ :metaClass | - metaClass implementingClass inspectorToString - -> (self allWithSubTypesOf: metaClass implementingClass) ] - thenReject: [ :a | a value isEmpty ] + ^ (self metamodel classes reject: [ :a | a implementingClass isTrait ]) + collect: [ :metaClass | + metaClass implementingClass inspectorToString + -> (self allWithType: metaClass implementingClass) ] + thenReject: [ :a | a value isEmpty ] ] diff --git a/src/MooseIDE-NewTools/MooseObject.extension.st b/src/MooseIDE-NewTools/MooseObject.extension.st index e0a3ab5af..91c2caf52 100644 --- a/src/MooseIDE-NewTools/MooseObject.extension.st +++ b/src/MooseIDE-NewTools/MooseObject.extension.st @@ -19,17 +19,24 @@ MooseObject >> miFameInspectorExtension [ ] { #category : #'*MooseIDE-NewTools' } -MooseObject >> miNavigationInspectorExtension [ +MooseObject >> miMetaNavigationInspectorExtension [ - - ^ MiNavigationBrowser on: self + + ^ MiMetaNavigationBrowser on: self ] { #category : #'*MooseIDE-NewTools' } -MooseObject >> miPropertiesInspectorExtension [ - - - ^ MiPropertyExtension on: self +MooseObject >> miMetaNavigationItems [ + + ^ self mooseDescription allComplexProperties + collect: [ :property | + | value | + value := self propertyNamed: property name ifAbsent: [ nil ]. + value isCollection ifTrue: [ value := value asMooseGroup ]. + property name -> value ] + thenReject: [ :assoc | + assoc value isNil or: [ + assoc value isCollection and: [ assoc value isEmpty ] ] ] ] { #category : #'*MooseIDE-NewTools' } @@ -40,9 +47,9 @@ MooseObject >> navigationItemsFromPragmas [ the pragma #navigation:" pragmaValueAssociations := (self mooseInterestingEntity navigationPragmas sorted: - [ :pragma | + [ :pragma | pragma argumentNamed: #navigation: ] - ascending) collect: [ :pragma | + ascending) collect: [ :pragma | pragma inspectorToString -> pragma methodSelector ].