Merge pull request #1611 from koendehondt/gh1601-pharo12-fillWith

Add SpMenuPresenter>>#fillWith: that applies for SpMenuBarPresenter as well, and add tests and example

src/Spec2-Commander2/SpMenuBarPresenter.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'SpMenuBarPresenter' }
+
+{ #category : '*Spec2-Commander2' }
+SpMenuBarPresenter >> presenterBuilderClass [
+
+	^ SpMenuBarPresenterBuilder
+]

src/Spec2-Commander2/SpMenuPresenter.extension.st

@@ -0,0 +1,16 @@
+Extension { #name : 'SpMenuPresenter' }
+
+{ #category : '*Spec2-Commander2' }
+SpMenuPresenter >> fillWith: aCommandGroup [
+
+	self removeAllItems.
+	self presenterBuilderClass new
+		menuPresenter: self;
+		visit: aCommandGroup
+]
+
+{ #category : '*Spec2-Commander2' }
+SpMenuPresenter >> presenterBuilderClass [
+
+	^ SpMenuPresenterBuilder
+]

src/Spec2-Commander2/SpMenuPresenterBuilder.class.st

@@ -37,10 +37,7 @@ SpMenuPresenterBuilder >> fillItem: aMenuItem with: aCommand [
 SpMenuPresenterBuilder >> initialize [
 
 	super initialize.
-	self menuPresenter: self class menuPresenterClass new.
-	stack := Stack new
-		push: self menuPresenter;
-		yourself
+	self menuPresenter: self class menuPresenterClass new
 ]
 
 { #category : 'accessing' }
@@ -50,7 +47,11 @@ SpMenuPresenterBuilder >> menuPresenter [
 
 { #category : 'accessing' }
 SpMenuPresenterBuilder >> menuPresenter: anObject [
-	menuPresenter := anObject
+
+	menuPresenter := anObject.
+	stack := Stack new
+		push: self menuPresenter;
+		yourself
 ]
 
 { #category : 'visiting' }

src/Spec2-Core/SpMenuPresenter.class.st

@@ -219,6 +219,12 @@ SpMenuPresenter >> printOn: aStream [
 				nextPutAll: '''' ]
 ]
 
+{ #category : 'private' }
+SpMenuPresenter >> removeAllItems [
+
+	groups := OrderedCollection new
+]
+
 { #category : 'accessing' }
 SpMenuPresenter >> rootMenu [
 

src/Spec2-Examples/SpCommandGroupExample.class.st

@@ -0,0 +1,118 @@
+"
+I am an example presenter to show how commands can be used as the basis for adding a menubar and a toolbar.
+"
+Class {
+	#name : 'SpCommandGroupExample',
+	#superclass : 'SpPresenter',
+	#instVars : [
+		'menuBar',
+		'toolBar',
+		'list'
+	],
+	#category : 'Spec2-Examples-Demo-CommandGroup',
+	#package : 'Spec2-Examples',
+	#tag : 'Demo-CommandGroup'
+}
+
+{ #category : 'commands' }
+SpCommandGroupExample class >> buildCommandsGroupWith: presenter forRoot: rootCommandGroup [
+
+	rootCommandGroup
+		register: (self buildMenuBarGroupWith: presenter);
+		register: (self buildToolBarGroupWith: presenter);
+		register: (self buildListMenuWith: presenter)
+]
+
+{ #category : 'commands' }
+SpCommandGroupExample class >> buildListMenuWith: presenter [
+
+	^ (CmCommandGroup named: 'List') asSpecGroup
+		beRoot;
+		register: (SpExampleNewCommand forSpec context: presenter);
+		yourself
+]
+
+{ #category : 'commands' }
+SpCommandGroupExample class >> buildMenuBarGroupWith: presenter [
+
+	^ (CmCommandGroup named: 'MenuBar') asSpecGroup
+		beRoot;
+		register: (self buildMenuWith: presenter);
+		yourself
+]
+
+{ #category : 'commands' }
+SpCommandGroupExample class >> buildMenuWith: presenter [
+
+	^ (CmCommandGroup named: 'Menu') asSpecGroup
+		register: (SpExampleNewCommand forSpec context: presenter);
+		yourself
+]
+
+{ #category : 'commands' }
+SpCommandGroupExample class >> buildToolBarGroupWith: presenter [
+
+	^ (CmCommandGroup named: 'ToolBar') asSpecGroup
+		beRoot;
+		register: (SpExampleNewCommand forSpec context: presenter);
+		yourself
+]
+
+{ #category : 'examples' }
+SpCommandGroupExample class >> example [
+	"This example opens a presenter with a menubar and a toolbar created from commands."
+
+	^ self new open
+]
+
+{ #category : 'layout' }
+SpCommandGroupExample >> defaultLayout [
+
+	^ SpBoxLayout newTopToBottom
+		add: list;
+		yourself
+]
+
+{ #category : 'initialization' }
+SpCommandGroupExample >> initializeList [
+
+	| contextMenu |
+	list := self newList.
+	contextMenu := self newMenu.
+	contextMenu fillWith: self rootCommandsGroup / 'List'.
+	list contextMenu: contextMenu
+]
+
+{ #category : 'initialization' }
+SpCommandGroupExample >> initializeMenuBar [
+
+	menuBar := self newMenuBar.
+	menuBar fillWith: self rootCommandsGroup / 'MenuBar'
+]
+
+{ #category : 'initialization' }
+SpCommandGroupExample >> initializePresenters [
+
+	super initializePresenters.
+	self initializeList.
+	self initializeMenuBar.
+	self initializeToolBar
+]
+
+{ #category : 'initialization' }
+SpCommandGroupExample >> initializeToolBar [
+
+	toolBar := self newToolbar.
+	toolBar fillWith: self rootCommandsGroup / 'ToolBar'
+]
+
+{ #category : 'initialization' }
+SpCommandGroupExample >> initializeWindow: aWindowPresenter [
+
+	super initializeWindow: aWindowPresenter.
+	aWindowPresenter
+		title: 'Example with context menu, menubar and toolbar based on commands';
+		initialExtent: 600@300;
+		menu: menuBar;
+		toolbar: toolBar
+]

src/Spec2-Examples/SpExampleNewCommand.class.st

@@ -0,0 +1,31 @@
+Class {
+	#name : 'SpExampleNewCommand',
+	#superclass : 'CmCommand',
+	#category : 'Spec2-Examples-Demo-CommandGroup',
+	#package : 'Spec2-Examples',
+	#tag : 'Demo-CommandGroup'
+}
+
+{ #category : 'converting' }
+SpExampleNewCommand >> asSpecCommand [
+
+	^ super asSpecCommand
+		iconName: #smallNew;
+		shortcutKey: $n meta;
+		yourself
+]
+
+{ #category : 'executing' }
+SpExampleNewCommand >> execute [
+
+	self inform: 'This command is not implemented yet.'
+]
+
+{ #category : 'initialization' }
+SpExampleNewCommand >> initialize [
+
+	super initialize.
+	self
+		name: 'New';
+		description: 'Create a new thing'
+]

src/Spec2-Tests/SpMenuBarPresenterTest.class.st

@@ -5,3 +5,37 @@ Class {
 	#package : 'Spec2-Tests',
 	#tag : 'Core-Widgets'
 }
+
+{ #category : 'accessing' }
+SpMenuBarPresenterTest >> classToTest [
+	^ SpMenuBarPresenter
+]
+
+{ #category : 'tests' }
+SpMenuBarPresenterTest >> testFillWith [
+
+	| menuCommandGroup menuBarCommandGroup menuBarGroup command menuItem menu topMenu menuGroup |
+	command := CmCommand new
+		name: 'Test';
+		context: presenter;
+		asSpecCommand.
+	menuCommandGroup := (CmCommandGroup named: 'Menu') asSpecGroup
+		register: command;
+		yourself.
+	menuBarCommandGroup := (CmCommandGroup named: 'MenuBar') asSpecGroup
+		beRoot;
+		register: menuCommandGroup;
+		yourself.
+	presenter fillWith: menuBarCommandGroup.
+	self assert: presenter menuGroups size equals: 1.
+	menuBarGroup := presenter menuGroups first.
+	self assert: menuBarGroup menuItems size equals: 1.
+	topMenu := menuBarGroup menuItems first.
+	self assert: topMenu name equals: 'Menu'.
+	menu := topMenu subMenu.
+	self assert: menu menuGroups size equals: 1.
+	menuGroup := menu menuGroups first.
+	self assert: menuGroup menuItems size equals: 1.
+	menuItem := menuGroup menuItems first.
+	self assert: menuItem name equals: 'Test'
+]

src/Spec2-Tests/SpMenuPresenterTest.class.st

@@ -11,6 +11,26 @@ SpMenuPresenterTest >> classToTest [
 	^ SpMenuPresenter
 ]
 
+{ #category : 'tests' }
+SpMenuPresenterTest >> testFillWith [
+
+	| menuCommandGroup  command menuItem menuGroup |
+	command := CmCommand new
+		name: 'Test';
+		context: presenter;
+		asSpecCommand.
+	menuCommandGroup := (CmCommandGroup named: 'Menu') asSpecGroup
+		beRoot;
+		register: command;
+		yourself.
+	presenter fillWith: menuCommandGroup.
+	self assert: presenter menuGroups size equals: 1.
+	menuGroup := presenter menuGroups first.
+	self assert: menuGroup menuItems size equals: 1.
+	menuItem := menuGroup menuItems first.
+	self assert: menuItem name equals: 'Test'
+]
+
 { #category : 'tests' }
 SpMenuPresenterTest >> testValue [