Add new feature for editing element tree drag and drop

README.md

@@ -39,7 +39,7 @@ To install a version of Pyramid, use one of the following scripts inside a playg
 [[
 	Metacello new
 	baseline: 'Pyramid';
-	repository: 'github://OpenSmock/Pyramid:stage-dev-shortcuts/src';
+	repository: 'github://OpenSmock/Pyramid:devStage/src';
 	onConflict: [ :ex :loaded :incoming | ex useLoaded ];
 	onUpgrade: [ :ex :loaded :incoming | ex useLoaded ];
 	ignoreImage;
@@ -54,7 +54,7 @@ Only with Bloc (without Toplo features):
 [[
 	Metacello new
 	baseline: 'Pyramid';
-	repository: 'github://OpenSmock/Pyramid:stage-dev-shortcuts/src';
+	repository: 'github://OpenSmock/Pyramid:devStage/src';
 	onConflict: [ :ex :loaded :incoming | ex useLoaded ];
 	onUpgrade: [ :ex :loaded :incoming | ex useLoaded ];
 	ignoreImage;

src/Pyramid-Bloc/PyramidEditElementTreeDragAndDropPlugin.class.st

@@ -0,0 +1,112 @@
+"
+This class add to a treetable the possibilities to drag and drop one or many selected element to edit the tree structure of the targeted element.
+"
+Class {
+	#name : #PyramidEditElementTreeDragAndDropPlugin,
+	#superclass : #Object,
+	#traits : 'TPyramidPlugin',
+	#classTraits : 'TPyramidPlugin classTrait',
+	#instVars : [
+		'editor',
+		'navigationPlugin',
+		'navigationSelectionPanel',
+		'navigationPresenter'
+	],
+	#category : #'Pyramid-Bloc-plugin-edit-element-tree'
+}
+
+{ #category : #adding }
+PyramidEditElementTreeDragAndDropPlugin >> addEditElementTreeDragAndDrop [
+
+	| selectionPanelTreeTable |
+
+	selectionPanelTreeTable := navigationSelectionPanel treeTable.
+	selectionPanelTreeTable dragEnabled: true;
+				dropEnabled: true;
+				acceptDrop: [ :transfer | 
+					(transfer target)
+						"Move dragged element to root space (workplace)"
+						ifNil: [ self navigationPlugin removeSelectedElements.
+									self moveElementToRootSpace: transfer passenger.
+									self editor projectModel updateSelection.
+									selectionPanelTreeTable expandAll.  ]
+						"Move dragged element to targeted element"
+						ifNotNil: [ (self canMoveSelectedElement: (transfer passenger) target: (transfer target))
+										 "Dragged element put as a child of the targeted element"
+										 ifTrue: [ self navigationPlugin removeSelectedElements.
+													self moveElementDragToChild: transfer passenger
+																					 target: transfer target.
+													self editor projectModel updateSelection.
+													selectionPanelTreeTable expandAll. ]
+										 ifFalse: [ self inform: 'cannot move selected element to his child or himself'] ] ].
+]
+
+{ #category : #testing }
+PyramidEditElementTreeDragAndDropPlugin >> canMoveSelectedElement: anArrayOfElementDragged target: aElementTarget [
+	"
+	anArrayOfElementDragged = Tous les élements en train d'être drag (candidat déplacement)
+	aElementTarget = l'élément cible qui recevra les auters (cible)
+
+	Conditions pour valider le déplacement:
+	1) Aucun candidat dépacement n'est la cible (on ne se rajoute pas sur sois même)
+	2) La cible n'est l'enfant d'aucun candidat déplacement. ()
+	"
+	aElementTarget ifNil: [ ^ true ].
+	^ anArrayOfElementDragged allSatisfy: [ :elementDrag |
+		  elementDrag ~= aElementTarget and: [
+			  (aElementTarget allParentsInclude: elementDrag) not ] ]
+]
+
+{ #category : #connecting }
+PyramidEditElementTreeDragAndDropPlugin >> connectOn: aPyramidEditor [
+
+	editor := aPyramidEditor.
+
+	self navigationPluginFromPyramid: aPyramidEditor.
+	self navigationPlugin ifNil: [ ^ self ].
+	navigationPresenter := self navigationPlugin navigation.
+	navigationSelectionPanel := navigationPresenter selectionPanel.
+	self addEditElementTreeDragAndDrop.
+]
+
+{ #category : #accessing }
+PyramidEditElementTreeDragAndDropPlugin >> editor [ 
+
+	^ editor
+]
+
+{ #category : #actions }
+PyramidEditElementTreeDragAndDropPlugin >> moveElementDragToChild: arrayOfElementDragged target: aElementTarget [
+
+	self editor commandExecutor
+		use: PyramidAddChildrenCommand new
+		on: { aElementTarget }
+		with: arrayOfElementDragged.
+]
+
+{ #category : #actions }
+PyramidEditElementTreeDragAndDropPlugin >> moveElementToRootSpace: arrayOfElementDragged [
+
+	self editor commandExecutor
+		use: PyramidAddAllToCollectionCommand new
+		on: { self editor projectModel firstLevelElements }
+		with: arrayOfElementDragged.
+]
+
+{ #category : #accessing }
+PyramidEditElementTreeDragAndDropPlugin >> navigationPlugin [
+
+	^ navigationPlugin
+]
+
+{ #category : #accessing }
+PyramidEditElementTreeDragAndDropPlugin >> navigationPlugin: aPlugin [
+
+	navigationPlugin := aPlugin
+]
+
+{ #category : #accessing }
+PyramidEditElementTreeDragAndDropPlugin >> navigationPluginFromPyramid: aPyramidEditor [
+
+	self navigationPlugin: (aPyramidEditor findPlugin: PyramidNavigationPlugin).
+]

src/Pyramid-Bloc/PyramidMoveChildInParentCommand.class.st

@@ -0,0 +1,27 @@
+Class {
+	#name : #PyramidMoveChildInParentCommand,
+	#superclass : #PyramidAbstractBlocCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildInParentCommand >> getValueFor: aBlElement [
+
+	^ nil
+]
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildInParentCommand >> 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/PyramidMoveChildInParentPlugin.class.st

@@ -0,0 +1,163 @@
+"
+This class is used to modify the place of child between each child in his parent.
+"
+Class {
+	#name : #PyramidMoveChildInParentPlugin,
+	#superclass : #Object,
+	#traits : 'TPyramidPlugin',
+	#classTraits : 'TPyramidPlugin classTrait',
+	#instVars : [
+		'editor',
+		'projectModel',
+		'contextMenuPlugin',
+		'navigationPlugin'
+	],
+	#category : #'Pyramid-Bloc-plugin-edit-element-tree'
+}
+
+{ #category : #adding }
+PyramidMoveChildInParentPlugin >> addPanelsOn: aPyramidSimpleWindow [
+
+	aPyramidSimpleWindow
+		at: #selectionMenu
+		addItem: [ :builder | self contextMenuMoveChildInParent: builder ].
+]
+
+{ #category : #connecting }
+PyramidMoveChildInParentPlugin >> connectOn: aPyramidEditor [
+
+	editor := aPyramidEditor.
+	projectModel := aPyramidEditor projectModel.
+	self navigationFromPyramid: aPyramidEditor.
+]
+
+{ #category : #adding }
+PyramidMoveChildInParentPlugin >> contextMenuMoveChildInParent: aBuilder [
+
+	aBuilder
+		addGroupSingleSelection: [ :group :single |
+			group
+				addItem: [ :item |
+					item
+						icon: (Smalltalk ui icons iconNamed: #up);
+						name: 'Move index child up';
+						action: [ self moveChildIndexUpInParent ];
+						yourself ];
+
+				addItem: [ :item |
+					item
+						icon: (Smalltalk ui icons iconNamed: #down);
+						name: 'Move index child down';
+						action: [ self moveChildIndexDownInParent ];
+						yourself ];
+				yourself ]
+		order: 10.
+]
+
+{ #category : #accessing }
+PyramidMoveChildInParentPlugin >> editor [ 
+
+	^ editor
+]
+
+{ #category : #initialization }
+PyramidMoveChildInParentPlugin >> initialize [ 
+
+	"Do nothing"
+]
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildInParentPlugin >> moveChildIndexDownCommand: aBlElementParent with: aBlElementChildToMove [
+
+	self editor commandExecutor
+		use: PyramidMoveChildIndexDownCommand new
+		on: { aBlElementParent }
+		with: aBlElementChildToMove
+
+
+]
+
+{ #category : #action }
+PyramidMoveChildInParentPlugin >> moveChildIndexDownInParent [
+
+	| childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel |
+
+	childToMoveCollection := projectModel selection collection.
+	navigationSelectionPanel := navigationPlugin navigation selectionPanel.
+
+	childToMoveCollection size = 1
+	ifFalse: [ ^ self ].
+	childToMove := childToMoveCollection first.
+
+	childToMove hasParent 
+	ifFalse: [ ^ self ].
+	parentChild := childToMove parent.
+
+	childIndexToMove := (parentChild childIndexOf: childToMove).
+
+	childIndexToMove > 1
+		ifTrue: [ self moveChildIndexDownCommand: parentChild with: childToMove.
+			self refreshTreeTable ]
+		ifFalse: [ self inform: 'Cannot move down' ].
+
+
+
+
+]
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildInParentPlugin >> moveChildIndexUpCommand: aBlElementParent with: aBlElementChildToMove [
+
+	self editor commandExecutor
+		use: PyramidMoveChildIndexUpCommand new
+		on: { aBlElementParent }
+		with: aBlElementChildToMove
+
+]
+
+{ #category : #action }
+PyramidMoveChildInParentPlugin >> moveChildIndexUpInParent [
+
+	| childToMoveCollection childToMove childIndexToMove parentChild navigationSelectionPanel |
+
+	childToMoveCollection := projectModel selection collection.
+	navigationSelectionPanel := navigationPlugin navigation selectionPanel.
+
+	childToMoveCollection size = 1
+	ifFalse: [ ^ self ].
+	childToMove := childToMoveCollection first.
+
+	childToMove hasParent 
+	ifFalse: [ ^ self ].
+	parentChild := childToMove parent.
+
+	childIndexToMove := (parentChild childIndexOf: childToMove).
+
+	childIndexToMove < (parentChild children size)
+		ifTrue: [ self moveChildIndexUpCommand: parentChild with: childToMove.
+			self refreshTreeTable ]
+		ifFalse: [ self inform: 'Cannot move up' ].
+
+
+
+]
+
+{ #category : #accessing }
+PyramidMoveChildInParentPlugin >> navigationFromPyramid: aPyramidEditor [
+
+	navigationPlugin := aPyramidEditor findPlugin: PyramidNavigationPlugin.
+]
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildInParentPlugin >> refreshTreeTable [
+
+	| navigationSelectionPanel selectedItems |
+
+	navigationSelectionPanel := navigationPlugin navigation selectionPanel.
+	"Keep the selection on the movedChild from here"
+	selectedItems := navigationSelectionPanel treeTable selectedItems first.
+	navigationSelectionPanel treeTable unselectAll.
+	"Refresh the treeTable"
+	navigationSelectionPanel treeTable roots: navigationSelectionPanel treeTable roots.
+	navigationSelectionPanel treeTable selectItem: selectedItems
+]

src/Pyramid-Bloc/PyramidMoveChildIndexDownCommand.class.st

@@ -0,0 +1,23 @@
+Class {
+	#name : #PyramidMoveChildIndexDownCommand,
+	#superclass : #PyramidMoveChildInParentCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildIndexDownCommand >> commandInverse [
+
+	^ PyramidMoveChildIndexUpCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildIndexDownCommand >> setValueFor: aBlElementParent with: aBlElementToMove [
+
+	| childIndexToMove |
+
+	childIndexToMove := aBlElementParent childIndexOf: aBlElementToMove.
+
+	aBlElementParent
+		swapChildAt: childIndexToMove
+		with: childIndexToMove - 1
+]

src/Pyramid-Bloc/PyramidMoveChildIndexUpCommand.class.st

@@ -0,0 +1,23 @@
+Class {
+	#name : #PyramidMoveChildIndexUpCommand,
+	#superclass : #PyramidMoveChildInParentCommand,
+	#category : #'Pyramid-Bloc-plugin-bloc'
+}
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildIndexUpCommand >> commandInverse [
+
+	^ PyramidMoveChildIndexDownCommand new
+]
+
+{ #category : #'as yet unclassified' }
+PyramidMoveChildIndexUpCommand >> setValueFor: aBlElementParent with: aBlElementToMove [
+
+	| childIndexToMove |
+
+	childIndexToMove := aBlElementParent childIndexOf: aBlElementToMove.
+
+	aBlElementParent
+		swapChildAt: childIndexToMove
+		with: childIndexToMove + 1
+]

src/Pyramid-Bloc/PyramidSpaceShortcutInspectSelectedElement.class.st

@@ -1,3 +1,6 @@
+"
+This class is use to inspect the current selected element
+"
 Class {
 	#name : #PyramidSpaceShortcutInspectSelectedElement,
 	#superclass : #PyramidSpaceShortcutManagerPlugin,