Ft ad delete group

src/Pyramid-Bloc/PyramidBlocCommand.class.st → src/Pyramid-Bloc/PyramidAbstractBlocCommand.class.st

@@ -1,17 +1,17 @@
 Class {
-	#name : #PyramidBlocCommand,
+	#name : #PyramidAbstractBlocCommand,
 	#superclass : #PyramidCommand,
 	#category : #'Pyramid-Bloc-plugin-bloc'
 }
 
 { #category : #testing }
-PyramidBlocCommand class >> isAbstract [
+PyramidAbstractBlocCommand class >> isAbstract [
 
-	^ self == PyramidBlocCommand
+	^ self == PyramidAbstractBlocCommand
 ]
 
 { #category : #testing }
-PyramidBlocCommand >> canBeUsedFor: anObject [
+PyramidAbstractBlocCommand >> canBeUsedFor: anObject [
 
 	^ anObject class = BlElement or: [anObject class inheritsFrom: BlElement]
 ]

src/Pyramid-Bloc/PyramidAbstractGroupCommand.class.st

@@ -0,0 +1,33 @@
+Class {
+	#name : #PyramidAbstractGroupCommand,
+	#superclass : #PyramidCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #testing }
+PyramidAbstractGroupCommand class >> isAbstract [
+
+	^ self == PyramidAbstractGroupCommand
+]
+
+{ #category : #'as yet unclassified' }
+PyramidAbstractGroupCommand >> getValueFor: aBlElement [
+
+	^ nil
+]
+
+{ #category : #'as yet unclassified' }
+PyramidAbstractGroupCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [
+
+	| mementos |
+	mementos := aCollection asArray collect: [ :each |
+		            PyramidCommandMemento new
+			            command: aCommand;
+			            target: each;
+			            arguments: anArguments;
+			            yourself ].
+	mementos size = 1 ifTrue: [ ^ mementos first ].
+	^ PyramidCompositeMemento new
+		  mementos: mementos;
+		  yourself
+]

src/Pyramid-Bloc/PyramidAddChildCommand.class.st

@@ -0,0 +1,17 @@
+Class {
+	#name : #PyramidAddChildCommand,
+	#superclass : #PyramidChildrenCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #'as yet unclassified' }
+PyramidAddChildCommand >> commandInverse [
+
+	^ PyramidRemoveChildCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidAddChildCommand >> setValueFor: aBlElement with: aChildToAdd [
+
+	aBlElement addChild: aChildToAdd
+]

src/Pyramid-Bloc/PyramidBackgroundCommand.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : #PyramidBackgroundCommand,
-	#superclass : #PyramidBlocCommand,
+	#superclass : #PyramidAbstractBlocCommand,
 	#category : #'Pyramid-Bloc-plugin-bloc'
 }
 

src/Pyramid-Bloc/PyramidBlocPlugin.class.st

@@ -3,6 +3,10 @@ Class {
 	#superclass : #Object,
 	#traits : 'TPyramidPlugin',
 	#classTraits : 'TPyramidPlugin classTrait',
+	#instVars : [
+		'editor',
+		'groupCommand'
+	],
 	#category : #'Pyramid-Bloc-plugin-bloc'
 }
 
@@ -73,11 +77,92 @@ PyramidBlocPlugin class >> position [
 	^ property
 ]
 
+{ #category : #adding }
+PyramidBlocPlugin >> addPanelsOn: aPyramidSimpleWindow [
+
+
+	aPyramidSimpleWindow at: #selectionMenu addItem: [ :builder |
+		self menuGroupOn: builder ]
+
+]
+
 { #category : #'as yet unclassified' }
 PyramidBlocPlugin >> connectOn: aPyramidEditor [
-aPyramidEditor propertiesManager addProperty: self class elementId.
+
+	self editor: aPyramidEditor.
+	aPyramidEditor propertiesManager addProperty: self class elementId.
 	aPyramidEditor propertiesManager addProperty: self class clipChildren.
 	aPyramidEditor propertiesManager addProperty: self class position.
-	aPyramidEditor propertiesManager addProperty: self class background.
-
+	aPyramidEditor propertiesManager addProperty: self class background
+]
+
+{ #category : #accessing }
+PyramidBlocPlugin >> editor [
+
+	^ editor
+]
+
+{ #category : #accessing }
+PyramidBlocPlugin >> editor: anObject [
+
+	editor := anObject
+]
+
+{ #category : #'as yet unclassified' }
+PyramidBlocPlugin >> groupCollection: aCollection [
+
+	self editor ifNil: [ ^ self ].
+	self editor propertiesManager commandExecutor
+		use: self groupCommand
+		on: { aCollection }
+		with: self editor projectModel roots
+]
+
+{ #category : #accessing }
+PyramidBlocPlugin >> groupCommand [
+
+	^ groupCommand
+]
+
+{ #category : #'as yet unclassified' }
+PyramidBlocPlugin >> groupMenuBlock: group for: aCollection [
+
+	group addItem: [ :item |
+		item
+			icon: (self iconNamed: #collection);
+			name: 'Group selection';
+			enabled: true;
+			action: [ self groupCollection: aCollection ];
+			yourself ]
+]
+
+{ #category : #'as yet unclassified' }
+PyramidBlocPlugin >> groupMenuBlockMulti [
+
+	^ [ :group :multi | | copy |
+		copy := multi asArray.
+	  (self groupCommand canBeUsedFor: copy) ifTrue: [
+		  self groupMenuBlock: group for: copy ] ]
+]
+
+{ #category : #'as yet unclassified' }
+PyramidBlocPlugin >> groupMenuBlockSingle [
+
+	^ [ :group :single | | copy |
+		copy := { single }.
+	  (self groupCommand canBeUsedFor: copy) ifTrue: [
+		  self groupMenuBlock: group for: copy ] ]
+]
+
+{ #category : #initialization }
+PyramidBlocPlugin >> initialize [
+
+	groupCommand := PyramidGroupCommand new.
+]
+
+{ #category : #'as yet unclassified' }
+PyramidBlocPlugin >> menuGroupOn: aBuilder [
+
+	aBuilder addGroupSingleSelection: self groupMenuBlockSingle order: 20.
+	aBuilder addGroupMultiSelection: self groupMenuBlockMulti order: 20
 ]

src/Pyramid-Bloc/PyramidChildrenCommand.class.st

@@ -0,0 +1,33 @@
+Class {
+	#name : #PyramidChildrenCommand,
+	#superclass : #PyramidAbstractBlocCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #testing }
+PyramidChildrenCommand class >> isAbstract [
+
+	^ self == PyramidChildrenCommand
+]
+
+{ #category : #'as yet unclassified' }
+PyramidChildrenCommand >> getValueFor: aBlElement [
+
+	^ nil
+]
+
+{ #category : #'as yet unclassified' }
+PyramidChildrenCommand >> saveStatesOf: aCollection withCommand: aCommand withArguments: anArguments [
+
+	| mementos |
+	mementos := aCollection asArray collect: [ :each |
+		            PyramidCommandMemento new
+			            command: aCommand;
+			            target: each;
+			            arguments: anArguments;
+			            yourself ].
+	mementos size = 1 ifTrue: [ ^ mementos first ].
+	^ PyramidCompositeMemento new
+		  mementos: mementos;
+		  yourself
+]

src/Pyramid-Bloc/PyramidClipChildrenCommand.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : #PyramidClipChildrenCommand,
-	#superclass : #PyramidBlocCommand,
+	#superclass : #PyramidAbstractBlocCommand,
 	#category : #'Pyramid-Bloc-plugin-bloc'
 }
 

src/Pyramid-Bloc/PyramidElementIdCommand.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : #PyramidElementIdCommand,
-	#superclass : #PyramidBlocCommand,
+	#superclass : #PyramidAbstractBlocCommand,
 	#category : #'Pyramid-Bloc-plugin-bloc'
 }
 

src/Pyramid-Bloc/PyramidGroupCommand.class.st

@@ -0,0 +1,74 @@
+Class {
+	#name : #PyramidGroupCommand,
+	#superclass : #PyramidAbstractGroupCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #testing }
+PyramidGroupCommand >> canBeUsedFor: anObject [
+
+	^ anObject isCollection and: [
+		  anObject isNotEmpty and: [
+			  | parent |
+			  parent := anObject first parent.
+			  anObject allSatisfy: [ :each | each parent = parent ] ] ]
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> commandInverse [
+
+	^ PyramidGroupInverseCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> makeGroupElement [
+
+	^ BlElement new id: #group; clipChildren: false; yourself
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> saveStatesOf: aCollection with: arguments [
+
+	| mementos |
+	mementos := aCollection asArray collect: [ :each |
+		            PyramidCommandMemento new
+			            command: self;
+			            target: each;
+			            arguments: arguments;
+			            yourself ].
+	mementos size = 1 ifTrue: [ ^ mementos first ].
+	^ PyramidCompositeMemento new
+		  mementos: mementos;
+		  yourself
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> saveStatesWithCommandInverseOf: aCollection with: arguments [
+
+	| mementos |
+	mementos := aCollection asArray collect: [ :each |
+		            PyramidCommandMemento new
+			            command: self commandInverse;
+			            target: each;
+			            arguments: arguments;
+			            yourself ].
+	mementos size = 1 ifTrue: [ ^ mementos first ].
+	^ PyramidCompositeMemento new
+		  mementos: mementos;
+		  yourself
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupCommand >> setValueFor: aCollection with: roots [
+
+	| parent groupElement |
+	parent := aCollection first parent.
+	parent ifNotNil: [ parent removeChildren: aCollection ].
+	groupElement := self makeGroupElement.
+	groupElement addChildren: aCollection.
+	parent ifNotNil: [ parent addChild: groupElement ].
+
+	(roots includesAny: aCollection) ifFalse: [ ^ self ].
+	roots removeAll: aCollection.
+	roots add: groupElement
+]

src/Pyramid-Bloc/PyramidGroupInverseCommand.class.st

@@ -0,0 +1,40 @@
+Class {
+	#name : #PyramidGroupInverseCommand,
+	#superclass : #PyramidAbstractGroupCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #testing }
+PyramidGroupInverseCommand >> canBeUsedFor: anObject [
+
+	^ anObject isCollection and: [
+		  anObject isNotEmpty and: [
+			  | parent |
+			  parent := anObject first parent.
+			parent isNotNil and: [ 
+			  anObject allSatisfy: [ :each | each parent = parent ] ] ] ]
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupInverseCommand >> commandInverse [
+
+	^ PyramidGroupCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidGroupInverseCommand >> setValueFor: aCollection with: roots [
+
+	| elements groupElement |
+	groupElement := aCollection first parent.
+	elements := groupElement children asArray.
+	(roots includesAny: elements) ifTrue: [ ^ self ].
+	groupElement removeChildren.
+
+	groupElement hasParent ifTrue: [
+		groupElement parent addChildren: elements.
+		groupElement parent removeChild: groupElement ].
+
+	(roots includes: groupElement) ifFalse: [ ^ self ].
+	roots remove: groupElement.
+	roots addAll: elements
+]

src/Pyramid-Bloc/PyramidLibraryViewForElement.class.st

@@ -10,9 +10,10 @@ Class {
 { #category : #'as yet unclassified' }
 PyramidLibraryViewForElement >> buttonAction [
 
-	self editor projectModel selection do: [ :each |
-		each addChild: self list selectedItem blockMaker value ].
-	self editor projectModel informRootsChanged
+	self editor propertiesManager commandExecutor
+		use: PyramidAddChildCommand new
+		on: self editor projectModel selection
+		with: self list selectedItem blockMaker value
 ]
 
 { #category : #private }

src/Pyramid-Bloc/PyramidLibraryViewForRoot.class.st

@@ -10,7 +10,7 @@ Class {
 { #category : #'as yet unclassified' }
 PyramidLibraryViewForRoot >> buttonAction [
 
-	self editor projectModel roots add: self list selectedItem blockMaker value
+	self editor propertiesManager commandExecutor use: PyramidAddToCollectionCommand new on: { 	self editor projectModel roots } with: self list selectedItem blockMaker value
 ]
 
 { #category : #private }