Merge pull request #54 from LABSARI/main

Adding a builder for menu items so one can define its own menu items.

src/Hierarchical-Roassal3-Menu/HAbstractMenuItem.class.st

@@ -11,37 +11,6 @@ Class {
 	#category : #'Hierarchical-Roassal3-Menu'
 }
 
-{ #category : #public }
-HAbstractMenuItem class >> buildIn: aMenuMorph shape: aRoassalShape visualization: anHSimpleVisualizationBuilder [
-	| items clazz |
-	clazz := self classFor: aRoassalShape.
-	items := clazz subclasses, { HInspectorMenuItem } collect: #new.
-	items := items groupedBy: [ :item | item group ].
-	items keys sorted do: [ :key | | group |
-		group := (items at: key) sorted: [ :a :b | a order < b order ].
-		group do: [ :item | 
-			item
-				shape: aRoassalShape;
-				visualization: anHSimpleVisualizationBuilder;
-				buildOn: aMenuMorph ]
-		] separatedBy: [ aMenuMorph addSeparator ].
-
-]
-
-{ #category : #public }
-HAbstractMenuItem class >> classFor: aRoassalShape [
-	aRoassalShape isShape
-		ifFalse: [ ^ HCanvasMenuItem ].
-	^ aRoassalShape isNode
-		ifTrue: [ 
-			(aRoassalShape canvas selectedShapes notEmpty 
-				and: [ (aRoassalShape canvas selectedShapes includes: aRoassalShape)])
-				ifTrue: [ HGroupMenuItem ]
-			 	ifFalse: [ HNodeMenuItem ] ]
-		ifFalse: [ HLineMenuItem ]
-
-]
-
 { #category : #accessing }
 HAbstractMenuItem >> argument [
 	^ nil

src/Hierarchical-Roassal3-Menu/HDefaultMenuItemStrategy.class.st

@@ -0,0 +1,29 @@
+"
+I am a strategy for HMenuBuilder.
+I define menu items that can be executed (or needed) for a given object.
+"
+Class {
+	#name : #HDefaultMenuItemStrategy,
+	#superclass : #Object,
+	#category : #'Hierarchical-Roassal3-Menu'
+}
+
+{ #category : #public }
+HDefaultMenuItemStrategy >> classFor: aRoassalShape [
+	aRoassalShape isShape
+		ifFalse: [ ^ HCanvasMenuItem ].
+	^ aRoassalShape isNode
+		ifTrue: [ 
+			(aRoassalShape canvas selectedShapes notEmpty 
+				and: [ (aRoassalShape canvas selectedShapes includes: aRoassalShape)])
+				ifTrue: [ HGroupMenuItem ]
+			 	ifFalse: [ HNodeMenuItem ] ]
+		ifFalse: [ HLineMenuItem ]
+
+]
+
+{ #category : #public }
+HDefaultMenuItemStrategy >> menuItemClassesFor: aShape [
+
+	^ (self classFor: aShape) subclasses , { HInspectorMenuItem }
+]

src/Hierarchical-Roassal3-Menu/HMenuBuilder.class.st

@@ -0,0 +1,74 @@
+"
+I build a roassal menu given a shape in a visualization.
+
+Entry point is `buildIn: aMorph shape: aShape visualization: aCanvas`
+
+Items in the menu are provided by the method `menuItemsFor:`
+"
+Class {
+	#name : #HMenuBuilder,
+	#superclass : #Object,
+	#instVars : [
+		'menuItemStrategy'
+	],
+	#category : #'Hierarchical-Roassal3-Menu'
+}
+
+{ #category : #public }
+HMenuBuilder >> buildIn: aMenuMorph shape: aRoassalShape visualization: anHSimpleVisualizationBuilder [
+
+	| items |
+	items := self groupItems: (self menuItemsFor: aRoassalShape).
+
+	self
+		buildIn: aMenuMorph
+		shape: aRoassalShape
+		visualization: anHSimpleVisualizationBuilder
+		withItems: items
+]
+
+{ #category : #public }
+HMenuBuilder >> buildIn: aMenuMorph shape: aRoassalShape visualization: anHSimpleVisualizationBuilder withItems: items [
+
+	items keys sorted
+		do: [ :key | 
+			| group |
+			group := (items at: key) sorted: [ :a :b | a order < b order ].
+			group do: [ :item | 
+				item
+					shape: aRoassalShape;
+					visualization: anHSimpleVisualizationBuilder;
+					buildOn: aMenuMorph ] ]
+		separatedBy: [ aMenuMorph addSeparator ]
+]
+
+{ #category : #public }
+HMenuBuilder >> groupItems: items [
+
+	^ items groupedBy: [ :item | item group ]
+]
+
+{ #category : #initialization }
+HMenuBuilder >> initialize [
+
+	super initialize.
+	menuItemStrategy := HDefaultMenuItemStrategy new
+]
+
+{ #category : #accessing }
+HMenuBuilder >> menuItemStrategy [
+
+	^ menuItemStrategy
+]
+
+{ #category : #accessing }
+HMenuBuilder >> menuItemStrategy: anObject [
+
+	menuItemStrategy := anObject
+]
+
+{ #category : #public }
+HMenuBuilder >> menuItemsFor: aShape [
+
+	^ (menuItemStrategy menuItemClassesFor: aShape) collect: #new
+]

src/Hierarchical-Roassal3-Tests/HMenuBuilderTest.class.st

@@ -0,0 +1,63 @@
+Class {
+	#name : #HMenuBuilderTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'menuBuilder'
+	],
+	#category : #'Hierarchical-Roassal3-Tests'
+}
+
+{ #category : #running }
+HMenuBuilderTest >> setUp [
+	super setUp.
+
+	menuBuilder := HMenuBuilder new.
+]
+
+{ #category : #tests }
+HMenuBuilderTest >> testMenuForCanvas [
+
+	| items |
+	items := menuBuilder menuItemsFor: RSCanvas new.
+	self assert: items size equals: HCanvasMenuItem subclasses size + 1.
+	self assert:
+		(items anySatisfy: [ :i | i class = HInspectorMenuItem ])
+]
+
+{ #category : #tests }
+HMenuBuilderTest >> testMenuForGroup [
+
+	| items shapes canvas |
+	canvas := RSCanvas new.
+	shapes := { 
+		          RSComposite new.
+		          RSComposite new }.
+	canvas addAll: shapes.
+	canvas selectedShapes: shapes.
+	items := menuBuilder menuItemsFor: shapes first.
+	self assert: items size equals: HGroupMenuItem subclasses size + 1.
+]
+
+{ #category : #tests }
+HMenuBuilderTest >> testMenuForLine [
+
+	| items |
+	items := menuBuilder menuItemsFor: RSLine new.
+	self assert: items size equals: HLineMenuItem subclasses size + 1.
+	self assert:
+		(items anySatisfy: [ :i | i class = HInspectorMenuItem ])
+]
+
+{ #category : #tests }
+HMenuBuilderTest >> testMenuForNode [
+
+	| items canvas shape |
+	canvas := RSCanvas new.
+	shape := RSComposite new.
+	canvas add: shape.
+	items := menuBuilder menuItemsFor: shape.
+
+	self assert: items size equals: HNodeMenuItem subclasses size + 1.
+	self assert:
+		(items anySatisfy: [ :i | i class = HInspectorMenuItem ])
+]

src/Hierarchical-Roassal3/HSimpleVisualizationBuilder.class.st

@@ -297,7 +297,7 @@ HSimpleVisualizationBuilder >> linkStyler: anHLinkStyler [
 HSimpleVisualizationBuilder >> menuInteraction [
 	^ menuInteraction ifNil: [ 
 		menuInteraction := RSMenuActivable new
-			menuDo: [ :menu :aShape | HAbstractMenuItem 
+			menuDo: [ :menu :aShape | HMenuBuilder new 
 				buildIn: menu 
 				shape: aShape 
 				visualization: self ];