From a0b0b4227f5a9562a900da7b3c8c112b9c8743c0 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Fri, 29 Nov 2024 14:12:44 +0100 Subject: [PATCH 1/2] add drag transfer customization --- .../SpAbstractMorphicAdapter.class.st | 7 ++-- .../SpTransferMorph.class.st | 9 +++++ .../SpAbstractWidgetPresenter.class.st | 28 ++++++++++++++++ .../SpDragStartAnnouncement.class.st | 33 +++++++++++++++++++ src/Spec2-Core/SpTransferPresenter.class.st | 13 ++++++++ .../SpListPresenter.extension.st | 4 ++- 6 files changed, 89 insertions(+), 5 deletions(-) create mode 100644 src/Spec2-Core/SpDragStartAnnouncement.class.st diff --git a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st b/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st index f4c4ddae..1f9411a6 100644 --- a/src/Spec2-Adapters-Morphic/SpAbstractMorphicAdapter.class.st +++ b/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' } diff --git a/src/Spec2-Adapters-Morphic/SpTransferMorph.class.st b/src/Spec2-Adapters-Morphic/SpTransferMorph.class.st index ad357371..51b36d69 100644 --- a/src/Spec2-Adapters-Morphic/SpTransferMorph.class.st +++ b/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 [ diff --git a/src/Spec2-Core/SpAbstractWidgetPresenter.class.st b/src/Spec2-Core/SpAbstractWidgetPresenter.class.st index 9e5bb893..26427aeb 100644 --- a/src/Spec2-Core/SpAbstractWidgetPresenter.class.st +++ b/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. diff --git a/src/Spec2-Core/SpDragStartAnnouncement.class.st b/src/Spec2-Core/SpDragStartAnnouncement.class.st new file mode 100644 index 00000000..540b6747 --- /dev/null +++ b/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 +] diff --git a/src/Spec2-Core/SpTransferPresenter.class.st b/src/Spec2-Core/SpTransferPresenter.class.st index 8c1ef25f..f0eae6fa 100644 --- a/src/Spec2-Core/SpTransferPresenter.class.st +++ b/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 diff --git a/src/Spec2-Examples/SpListPresenter.extension.st b/src/Spec2-Examples/SpListPresenter.extension.st index fb78f03d..ab7867e8 100644 --- a/src/Spec2-Examples/SpListPresenter.extension.st +++ b/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; From e954ede70646235fe0dd8197cc80ffe8256706b0 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Fri, 29 Nov 2024 14:13:02 +0100 Subject: [PATCH 2/2] fix an action system modification error --- src/Spec2-Examples/SpExampleBrowser.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Spec2-Examples/SpExampleBrowser.class.st b/src/Spec2-Examples/SpExampleBrowser.class.st index 9b3c0bce..a15c9a78 100644 --- a/src/Spec2-Examples/SpExampleBrowser.class.st +++ b/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 ]