Merge pull request #1678 from pharo-spec/dev-3.0

add drag transfer customization

src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st

@@ -658,10 +658,9 @@ SpAbstractMorphicAdapter >> takeKeyboardFocus [
 { #category : 'drag and drop' }
 SpAbstractMorphicAdapter >> transferFor: passenger from: source [
 
-	^ SpTransferPresenter new
-		transfer: passenger;
-		from: source;
-		yourself
+	^ self presenter 
+		dragTransferFor: passenger
+		from: source
 ]
 
 { #category : 'emulating' }

src/Spec2-Adapters-Morphic/SpTransferMorph.class.st

@@ -12,6 +12,15 @@ Class {
 	#tag : 'Support'
 }
 
+{ #category : 'private' }
+SpTransferMorph >> initDraggedMorph [
+	draggedMorph ifNotNil: [^self].
+	draggedMorph := ((self valueOfProperty: #presenter) description ifNil: [ self passenger ]) asDraggableMorph.
+	self addMorphBack: draggedMorph.
+	self updateCopyIcon.
+	self changed; fullBounds
+]
+
 { #category : 'initialization' }
 SpTransferMorph >> initialize [
 

src/Spec2-Core/SpAbstractWidgetPresenter.class.st

@@ -274,6 +274,23 @@ SpAbstractWidgetPresenter >> dragEnabled: aBoolean [
 	dragEnabled := aBoolean
 ]
 
+{ #category : 'private - drag and drop' }
+SpAbstractWidgetPresenter >> dragTransferFor: passenger from: source [
+	"answer a transfer presenter ready to be dragged away from this presenter to 
+	 its destination. Allows user to modify elements of it by using the whenDragWillStartDo: 
+	 event and touching the transfer object."
+	| transfer |
+
+	transfer := SpTransferPresenter new
+		transfer: passenger;
+		from: source;
+		yourself.
+
+	self announce: (SpDragStartAnnouncement newTransfer: transfer). 
+
+	^ transfer
+]
+
 { #category : 'drag and drop' }
 SpAbstractWidgetPresenter >> dropEnabled [
 	^ dropEnabled
@@ -401,6 +418,17 @@ SpAbstractWidgetPresenter >> whenBorderWidthChangedDo: aBlock [
 	self property: #borderWidth whenChangedDo: aBlock
 ]
 
+{ #category : 'api - events' }
+SpAbstractWidgetPresenter >> whenDragStartDo: aBlock [
+	"Informs user a drag is taking place. 
+	 `aBlock` receives an SpDragStartAnnouncement as argument."
+
+	self announcer 
+		when: SpDragStartAnnouncement 
+		do: aBlock
+		for: aBlock receiver
+]
+
 { #category : 'api - events' }
 SpAbstractWidgetPresenter >> whenEnabledChangedDo: aBlock [
 	"Inform when enabled status has changed. 

src/Spec2-Core/SpDragStartAnnouncement.class.st

@@ -0,0 +1,33 @@
+"
+Announces when a drag starts passing to the listener a transfer presenter (that can be modified to user intents).
+"
+Class {
+	#name : 'SpDragStartAnnouncement',
+	#superclass : 'Announcement',
+	#instVars : [
+		'transfer'
+	],
+	#category : 'Spec2-Core-Widgets',
+	#package : 'Spec2-Core',
+	#tag : 'Widgets'
+}
+
+{ #category : 'instance creation' }
+SpDragStartAnnouncement class >> newTransfer: aTransferPresenter [
+
+	^ self new 
+		transfer: aTransferPresenter;
+		yourself
+]
+
+{ #category : 'accessing' }
+SpDragStartAnnouncement >> transfer [
+
+	^ transfer
+]
+
+{ #category : 'accessing' }
+SpDragStartAnnouncement >> transfer: aTransferPresenter [
+
+	transfer := aTransferPresenter
+]

src/Spec2-Core/SpTransferPresenter.class.st

@@ -5,6 +5,7 @@ Class {
 	#name : 'SpTransferPresenter',
 	#superclass : 'SpAbstractWidgetPresenter',
 	#instVars : [
+		'#description',
 		'#passenger => ObservableSlot',
 		'#source => ObservableSlot'
 	],
@@ -19,6 +20,18 @@ SpTransferPresenter class >> adapterName [
 	^ #TransferAdapter
 ]
 
+{ #category : 'accessing' }
+SpTransferPresenter >> description [
+
+	^ description
+]
+
+{ #category : 'accessing' }
+SpTransferPresenter >> description: aString [
+
+	description := aString
+]
+
 { #category : 'accessing' }
 SpTransferPresenter >> from: aModel [
 	source := aModel

src/Spec2-Examples/SpExampleBrowser.class.st

@@ -128,7 +128,7 @@ SpExampleBrowser >> listMenuActions [
 			action: [ self browseSelectedExample ] ];
 		addActionWith: [ :item | item
 			name: 'Run';
-			enabled: runButton isEnabled;
+			actionEnabled: [ runButton isEnabled ];
 			action: [ self runSelectedExample ] ];
 		yourself
 ]

src/Spec2-Examples/SpListPresenter.extension.st

@@ -15,7 +15,9 @@ SpListPresenter class >> exampleDragAndDrop [
 
 	(list1 := self new)
 		items: #( 'abc' 'def' 'xyz' );
-		dragEnabled: true.
+		dragEnabled: true;
+		whenDragStartDo: [ :ann | 
+			ann transfer description: ('Passing "{1}" element' format: ann transfer passenger) ].
 
 	(list2 := self new)
 		dropEnabled: true;