"
COPYRIGHT (c) 1996 by eXept Software AG / Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libview2' }"
Object subclass:#DragAndDropManager
instanceVariableNames:'dropContext dragView dropAction dragOffset handler restoreBlock
alienCursor enabledCursor disabledCursor canDrop escapePressed
passiveAction'
classVariableNames:'DragContextQuerySignal DragOriginatorQuerySignal
DragOffsetQuerySignal ActiveDragAndDropManagers'
poolDictionaries:''
category:'Interface-DragAndDrop'
!
!DragAndDropManager class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1996 by eXept Software AG / Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
this class provides low-level drag & drop mechanisms.
Easy to use interface interfaces:
A drag is usually initiated by a view or its application model,
when a selection is moved (for example, SelectionInListView can
be initializd to do so).
There, the view creates a collection of dropObjects from its selection,
and starts the drag operation with:
DragAndDropManager startDrag:collectionOfDragObjects from:aView.
This easy to use interface starts a drag and also drops the collection
into the target view.
While dragging, a thumbsUp cursor is shown, if the view-under-the-drag
can handle a drop, a thumbsDown is shown if not, and a question mark
is shown for alien views (which means: we dont know).
Alien view drop is supported (but no 'canDrop' query).
For rubber-band line dragging, two more easy-to-use startup methods are
provided:
DragAndDropManager
startLineDragIn:aView at:position
atEnd:aFourArgEndBlock
and:
DragAndDropManager
startArrowDragIn:aView at:position
atEnd:aFourArgEndBlock
both of the above expect a 4-arg block to be passed, which will be
evaluated at end-drag, with the target view, its viewID, the drop position
on the screen and within the target view as arguments.
Expert interface:
More control over the dragging (i.e. the drawing procedure)
can be optained, by passing a dragBlock and an endDrag action:
aDragAndDropMgr := DragAndDropManager new.
aDragAndDropMgr dropObjects:(self collectionOfDragObjects).
aDragAndDropMgr
startOpaqueDrag:[:aPoint :aView :dropObjects |
self
showDragging:dropObjects
in:aView
at:aPoint - (xOffset@0)
]
offset:clickOffset
extent:saveUnderExtent
in:self
at:clickPoint
atEnd:[:v :vId :posScreen :posView | ... ]
the arguments are:
startOpaqueDrag:
a 3-arg block, which is evaluated by the d&d manager whenever the
mouse moves; it is supposed to draw the dropObjects at some position
in the passed view.
offset:
a clickOffset; drawing is offset by this amount
extent:
a save extent; the size of the screen area that must be saved during
the drag operation
in:
initiating view
at:
position where d&d operation starts
atEnd:
a 4-arg block that is evaluated when the d&d is finished.
It gets the target view (or nil, for alien views), the targets
view ID (needed if its an alien view), the screen position and the
relative position within the target view of the drop as arguments.
For internal (ST/X) views, the dropBlock should perform
a simple canDrop:/doDrop message.
For alien views, the Displays d&d functions can be used.
[author:]
Claus Gittinger
[see also:]
DemoView1, DemoView2, ...
SelectionInListView FileBrowser - for a concrete example
"
!
examples
"
a button, which initiates dragging of a file-object
Notice that this can be dropped into the launchers panel,
to open a fileBrowser on that directory ...
[exBegin]
|o top v|
top := StandardSystemView new.
v := Button label:'press for drag' in:top.
v pressAction:[
|o|
o := DropObject newFile:('/etc').
DragAndDropManager startDrag:o from:v.
v turnOff
].
top openWithExtent:200@200
[exEnd]
initiate a drag with some offset:
[exBegin]
|o top v|
top := StandardSystemView new.
v := Button label:'press for drag' in:top.
v pressAction:[
|o|
o := DropObject newFile:('.').
DragAndDropManager startDrag:o from:v offset:10@10.
v turnOff
].
top openWithExtent:200@200
[exEnd]
initiate a line drag:
[exBegin]
|o top v endAction|
endAction := [ :v :vID :sPos :vPos |
Transcript show:'end drag in '.
v isNil ifTrue:[
Transcript show:'alien view'
] ifFalse:[
Transcript show:v
].
Transcript show:' at screen: '; show:sPos;
show:' in view: '; showCR:vPos
].
top := StandardSystemView new.
v := Button label:'press for drag' in:top.
v pressAction:[
DragAndDropManager
startLineDragIn:v at:10@10 atEnd:endAction.
v turnOff
].
top openWithExtent:200@200
[exEnd]
more drag & drop; offset, displayObjects, ...
[exBegin]
|dropObj topView pannel icon buttonAction addButton|
topView := StandardSystemView new.
pannel := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.
pannel horizontalLayout:#fit.
pannel verticalLayout:#fitSpace.
icon := Image fromFile:('xpmBitmaps/QUESTION3.xpm').
dropObj := DropObject newFile:('.').
addButton := [:offset :label :dispObj| |button|
button := Button label:label in:pannel.
button pressAction:[
DragAndDropManager startDrag:dropObj from:button offset:offset display:dispObj.
button turnOff.
]
].
addButton value:(0@-5) value:'String' value:'String'.
addButton value:#topLeft value:'String' value:'String'.
addButton value:#topRight value:'Text' value:(Text string:'hello' emphasis:#bold).
addButton value:#bottomLeft value:'Icon' value:icon.
addButton value:#bottomRight value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').
addButton value:#center value:'Mixed' value:(Array with:'String' with:icon).
topView label:'Drag & Drop'.
topView openWithExtent:200@200.
[exEnd]
"
! !
!DragAndDropManager class methodsFor:'initialization'!
initialize
DragOriginatorQuerySignal := QuerySignal new.
DragOffsetQuerySignal := QuerySignal new.
DragContextQuerySignal := QuerySignal new.
ActiveDragAndDropManagers := IdentityDictionary new.
"
self initialize
"
"Modified: 11.8.1997 / 00:54:21 / cg"
! !
!DragAndDropManager class methodsFor:'instance creation'!
new
^ self basicNew initialize
! !
!DragAndDropManager class methodsFor:'Signal constants'!
dragContextQuerySignal
^ DragContextQuerySignal
!
dragOffsetQuerySignal
^ DragOffsetQuerySignal
"Created: 11.8.1997 / 00:54:10 / cg"
!
dragOriginatorQuerySignal
^ DragOriginatorQuerySignal
! !
!DragAndDropManager class methodsFor:'helpers'!
saveDraw:aBlock device:aDevice
|activeManager|
activeManager := ActiveDragAndDropManagers at:aDevice ifAbsent:nil.
activeManager isNil ifTrue:[
aBlock value
] ifFalse:[
activeManager saveDraw:aBlock
].
! !
!DragAndDropManager class methodsFor:'queries'!
isDragAndDropActiveOnDevice:aDevice
^ ActiveDragAndDropManagers includesKey:aDevice
! !
!DragAndDropManager class methodsFor:'simple start - drop source'!
startDragFrom:aView dropSource:aDropSource
"start a drop at the current pointer position.
"
^ (self new) startDragFrom:aView dropSource:aDropSource
! !
!DragAndDropManager class methodsFor:'simple start - generic'!
startDrag:draggableObjects from:aView
"start a drop at the current pointer position
"
^ self startDrag:draggableObjects
from:aView
offset:0@0
atEnd:nil
display:draggableObjects
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
DragAndDropManager startDrag:(DropObject newFile:('.')) from:button.
button turnOff
].
button openAt:100@100
"
!
startDrag:draggableObjects from:aView atEnd:aFourArgEndBlock
"start a drop at the current pointer position
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
^ self startDrag:draggableObjects
from:aView
offset:0@0
atEnd:aFourArgEndBlock
display:draggableObjects
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
DragAndDropManager startDrag:(DropObject newFile:('.'))
from:button
atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
Transcript showCR:'target view: ', targetView printString.
Transcript showCR:'target id: ', targetViewId printString.
Transcript showCR:'point screen: ', screenPoint printString.
Transcript showCR:'point target: ', targetPoint printString.
].
button turnOff
].
button openAt:100@100
"
!
startDrag:draggableObjects from:aView atEnd:aFourArgEndBlock display:something
"start a drop at the current pointer position
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
^ self startDrag:draggableObjects
from:aView
offset:0@0
atEnd:aFourArgEndBlock
display:something
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
DragAndDropManager startDrag:(DropObject newFile:('.'))
from:button
atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
Transcript showCR:'target view: ', targetView printString.
Transcript showCR:'target id: ', targetViewId printString.
Transcript showCR:'point screen: ', screenPoint printString.
Transcript showCR:'point target: ', targetPoint printString.
]
display:(Array with:'String' with:(Image fromFile:('xpmBitmaps/QUESTION3.xpm'))).
button turnOff
].
button openAt:100@100
"
!
startDrag:draggableObjects from:aView display:something
"start a drop at the current pointer position
"
^ self startDrag:draggableObjects
from:aView
offset:0@0
atEnd:nil
display:something
"
EXAMPLE:
|dropObj topView pannel icon buttonAction addButton|
topView := StandardSystemView new.
pannel := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.
pannel horizontalLayout:#fit.
pannel verticalLayout:#fitSpace.
icon := Image fromFile:('xpmBitmaps/QUESTION3.xpm').
dropObj := DropObject newFile:('.').
addButton := [:label :dispObj| |button|
button := Button label:label in:pannel.
button pressAction:[
DragAndDropManager startDrag:dropObj from:button display:dispObj.
button turnOff.
]
].
addButton value:'String' value:'String'.
addButton value:'Text' value:(Text string:'hello' emphasis:#bold).
addButton value:'Icon' value:icon.
addButton value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').
addButton value:'Mixed' value:(Array with:'String' with:icon).
topView label:'Drag & Drop'.
topView openWithExtent:200@200.
"
!
startDrag:draggableObjects from:aView offset:anOffset
"start a drop at the current pointer position
"
^ self startDrag:draggableObjects
from:aView
offset:anOffset
atEnd:nil
display:draggableObjects
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
DragAndDropManager startDrag:(DropObject newFile:('.')) from:button offset:(-10 @ -10).
button turnOff
].
button openAt:100@100
"
!
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgEndBlock
"start a drop at the current pointer position
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
^ self startDrag:draggableObjects
from:aView
offset:anOffset
atEnd:aFourArgEndBlock
display:draggableObjects
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
DragAndDropManager startDrag:(DropObject newFile:('.'))
from:button
offset:(-10 @ -10)
atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
Transcript showCR:'target view: ', targetView printString.
Transcript showCR:'target id: ', targetViewId printString.
Transcript showCR:'point screen: ', screenPoint printString.
Transcript showCR:'point target: ', targetPoint printString.
].
button turnOff
].
button openAt:100@100
"
!
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgEndBlock display:something
"start a drop at the current pointer position
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
|manager|
manager := self new.
manager startDrag:draggableObjects
from:aView
offset:anOffset
atEnd:aFourArgEndBlock
display:something.
^ manager
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
DragAndDropManager startDrag:(DropObject newFile:('.'))
from:button
offset:(-10 @ -10)
atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
Transcript showCR:'target view: ', targetView printString.
Transcript showCR:'target id: ', targetViewId printString.
Transcript showCR:'point screen: ', screenPoint printString.
Transcript showCR:'point target: ', targetPoint printString.
]
display:(Array with:'String' with:(Image fromFile:('xpmBitmaps/QUESTION3.xpm'))).
button turnOff
].
button openAt:100@100
"
!
startDrag:draggableObjects from:aView offset:anOffset display:something
"start a drop at the current pointer position
"
^ self startDrag:draggableObjects
from:aView
offset:anOffset
atEnd:nil
display:something
"
EXAMPLE:
|dropObj topView pannel icon buttonAction addButton|
topView := StandardSystemView new.
pannel := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.
pannel horizontalLayout:#fit.
pannel verticalLayout:#fitSpace.
icon := Image fromFile:('xpmBitmaps/QUESTION3.xpm').
dropObj := DropObject newFile:('.').
addButton := [:offset :label :dispObj| |button|
button := Button label:label in:pannel.
button pressAction:[
DragAndDropManager startDrag:dropObj from:button offset:offset display:dispObj.
button turnOff.
]
].
addButton value:#topLeft value:'String' value:'String'.
addButton value:#topRight value:'Text' value:(Text string:'hello' emphasis:#bold).
addButton value:#bottomLeft value:'Icon' value:icon.
addButton value:#bottomRight value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').
addButton value:#center value:'Mixed' value:(Array with:'String' with:icon).
topView label:'Drag & Drop'.
topView openWithExtent:200@200.
"
! !
!DragAndDropManager class methodsFor:'simple start - lines'!
startArrowDragIn:aView at:dragPoint atEnd:aFourArgBlock
"start a rubber-arrow-line dragging in aView at dragPoint.
When finished, evaluate the fourArgBlock with targetView,
targetID, screenPosition and targetViewPosition as arguments
"
^ self new startArrowDragIn:aView at:dragPoint atEnd:aFourArgBlock
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
button turnOff.
DragAndDropManager startArrowDragIn:button
at:(button preferredExtent // 2)
atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
targetView isNil ifTrue:[
Transcript show:'alien view'
] ifFalse:[
Transcript showCR:'target: ', targetView printString
].
Transcript showCR:'point screen: ', screenPoint printString.
Transcript showCR:'point target: ', targetPoint printString.
]
].
button openAt:100@100
"
!
startLineDragIn:aView at:dragPoint atEnd:aFourArgBlock
"start a rubber-line dragging in aView at dragPoint.
When finished, evaluate the fourArgBlock with targetView,
targetID, screenPosition and targetViewPosition as arguments
"
^ self new startLineDragIn:aView at:dragPoint atEnd:aFourArgBlock
"
EXAMPLE:
|button|
button := (Button label:'press me').
button pressAction:[
button turnOff.
DragAndDropManager startLineDragIn:button
at:(button preferredExtent // 2)
atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
targetView isNil ifTrue:[
Transcript show:'alien view'
] ifFalse:[
Transcript showCR:'target: ', targetView printString
].
Transcript showCR:'point screen: ', screenPoint printString.
Transcript showCR:'point target: ', targetPoint printString.
]
].
button openAt:100@100
"
! !
!DragAndDropManager class methodsFor:'translation'!
translatePointFromScreen:aPoint toView:aView
"translate a point to screen
"
|device trans point offset|
device := aView device.
"/
"/ translate to view
"/
offset := device translatePoint:0@0 fromView:(device rootView) toView:aView.
point := aPoint + offset.
"/
"/ get device coordinates
"/
(trans := aView transformation) notNil ifTrue:[
point := trans applyInverseTo:point
].
^ point
!
translatePointToScreen:aPoint from:aView
"translate a point to screen
"
|device trans point offset|
device := aView device.
"/
"/ get device coordinates
"/
(trans := aView transformation) notNil ifTrue:[
point := trans applyTo:aPoint
] ifFalse:[
point := aPoint
].
"/
"/ translate to screen
"/
offset := device translatePoint:0@0 fromView:aView toView:(device rootView).
^ offset + point
! !
!DragAndDropManager methodsFor:'accessing'!
device
"returns the device of the source view
"
^ dragView device
!
dropContext
"return the current context
"
^ dropContext
!
dropObjects
"return the current dropObject collection"
^ dropContext dropObjects
"Modified: 19.4.1997 / 10:19:06 / cg"
!
dropObjects:aCollectionOfDropObjects
"set the current dropObject collection"
^ dropContext dropObjects:aCollectionOfDropObjects
!
font
"returns the font of the source view
"
^ dragView font
!
passiveAction:aBlockOrNil
self removePassiveAction.
aBlockOrNil notNil ifTrue:[
passiveAction := Processor addTimedBlock:aBlockOrNil afterMilliseconds:100
].
!
removePassiveAction
passiveAction notNil ifTrue:[
Processor removeTimeoutWithID:passiveAction.
passiveAction := nil.
].
!
sourceWidget
^ dragView
! !
!DragAndDropManager methodsFor:'accessing-cursor'!
alienCursor:aCursorOrImage
"set the cursor used for an alien widget; not an ST/X view
"
aCursorOrImage isImage ifTrue:[
alienCursor := Cursor fromImage:aCursorOrImage
] ifFalse:[
(aCursorOrImage isMemberOf:Cursor) ifTrue:[
alienCursor := aCursorOrImage
] ifFalse:[
"/
"/ use disabled cursor
"/
alienCursor := nil
]
]
!
disabledCursor:aCursorOrImage
"set the cursor for an ST/X view, which can not drop the objects
"
aCursorOrImage isImage ifTrue:[
disabledCursor := Cursor fromImage:aCursorOrImage
] ifFalse:[
(aCursorOrImage isMemberOf:Cursor) ifTrue:[
disabledCursor := aCursorOrImage
]
]
!
enabledCursor:aCursorOrImage
"set the cursor for an ST/X view, which can drop the objects
"
aCursorOrImage isImage ifTrue:[
enabledCursor := Cursor fromImage:aCursorOrImage
] ifFalse:[
(aCursorOrImage isMemberOf:Cursor) ifTrue:[
enabledCursor := aCursorOrImage
]
]
! !
!DragAndDropManager methodsFor:'dragging - drop source'!
startDragFrom:aView dropSource:aDropSource
"start a drop at the current pointer position.
"
^ self startDragFrom:aView dropSource:aDropSource offset:#topLeft "/ #center
!
startDragFrom:aView dropSource:aDropSource offset:anOffset
"start a drop at the current pointer position.
"
dropContext dropSource:aDropSource.
^ self startDrag:(aDropSource dropObjects)
from:aView
offset:anOffset
atEnd:nil
display:(aDropSource displayObjects)
! !
!DragAndDropManager methodsFor:'dragging - easy startup'!
startDrag:draggableObjects from:aView
"start a drop at the current pointer position
"
^ self startDrag:draggableObjects
from:aView
offset:0@0
!
startDrag:draggableObjects from:aView display:something
"start a drop at the current pointer position.
"
^ self startDrag:draggableObjects
from:aView
offset:nil
atEnd:nil
display:something
!
startDrag:draggableObjects from:aView offset:anOffset
"start a drop at the current pointer position with an offset
"
^ self startDrag:draggableObjects
from:aView
offset:anOffset
atEnd:nil
!
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgEndBlock
"start a drop at the current pointer position.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
^ self startDrag:draggableObjects
from:aView
offset:anOffset
atEnd:aFourArgEndBlock
display:draggableObjects
!
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgBlock display:something
"start a drop at the current pointer position.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView.
"
|height width fontWdt offset ascent device dispObjs list space|
self dropObjects:draggableObjects.
self dropObjects size == 0 ifTrue:[
^ self
].
device := aView device.
space := 1.
height := space negated.
width := 0.
fontWdt := aView font width.
ascent := aView font ascent.
(list := something) isNil ifTrue:[
list := self dropObjects
] ifFalse:[
(list isCollection not or:[list isString]) ifTrue:[
list := Array with:something
]
].
dispObjs := OrderedCollection new.
list do:[:el|
|obj asc|
obj := self displayObjectFor:el on:device.
asc := (obj respondsTo:#string) ifTrue:[ascent] ifFalse:[0].
height := height + space.
dispObjs add:(Array with:obj with:(0 @ (height + asc))).
width := width max:(obj widthOn:aView).
height := height + (obj heightOn:aView).
].
anOffset isSymbol ifTrue:[
offset := (0@0 extent:(width @ height)) perform:anOffset.
] ifFalse:[
offset := anOffset ? (0@0).
].
offset := offset rounded.
dispObjs do:[:el| el at:2 put:((el at:2) - offset) ].
self startOpaqueDrag:[:p :v|
|cursor hX hY pDraw|
cursor := dragView cursor.
hX := cursor hotX.
hY := cursor hotY.
pDraw := p "- (hX@hY) + cursor extent".
dispObjs do:[:el| (el at:1) displayOn:v
at:pDraw + (el at:2)
]
]
offset:offset
extent:width @ height
in:aView
at:nil
atEnd:aFourArgBlock
"Modified: / 31.3.1998 / 11:18:04 / cg"
!
startDrag:draggableObjects from:aView offset:anOffset display:something
"start a drop at the current pointer position.
"
^ self startDrag:draggableObjects
from:aView
offset:anOffset
atEnd:nil
display:something
! !
!DragAndDropManager methodsFor:'dragging - generic'!
startGenericDrag:aTwoArgDragBlock in:aView at:p atEnd:aFourArgEndBlock
"start a generic (caller-provided drag);
Here, an inverting drag is initiated (i.e. the drawing is undone
by inverting again). See startOpaqueDrag for another variant.
the dragBlock, aTwoArgDragBlock will be called with two args
aPoint and a drawingGC, to perform the drawing at some dragPoint.
The drag starts in aView at point p.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
^ self startOpaqueDrag:aTwoArgDragBlock
offset:nil
extent:nil
in:aView
at:nil
atEnd:aFourArgEndBlock
!
startOpaqueDrag:aDragBlock offset:offs extent:anExtent in:aView at:aDummyPoint atEnd:aFourArgEndBlock
"start an opaque or generic opaque (caller-provided drag);
opaque drag means, that the drawing cannot be undone by two inverting
draws, but instead, the area under the dragged object must be saved
and restored. The areas size to be saved/restored is passed in anExtent.
the dragBlock, aDragBlock will be called with up to three args aPoint, a
drawingGC and the display objects, to perform the drawing at some dragPoint.
The drag starts in aView at point p.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
|handler numArgs dragBlock dobjs|
dragOffset := offs ? (Point x:0 y:0).
numArgs := aDragBlock numArgs.
numArgs == 3 ifTrue:[
dobjs := self dropObjects.
dragBlock := [:p :v| aDragBlock value:p value:v value:dobjs ]
] ifFalse:[
numArgs == 1 ifTrue:[
dragBlock := [:p :v| aDragBlock value:p ]
] ifFalse:[
dragBlock := aDragBlock
]
].
anExtent isNil ifTrue:[
handler := DragHandler startGenericDrag:dragBlock.
] ifFalse:[
handler := DragHandler startOpaqueDrag:dragBlock extent:anExtent offset:dragOffset.
].
self doStart:handler for:aView atEnd:aFourArgEndBlock.
! !
!DragAndDropManager methodsFor:'dragging - lines'!
startArrowDragIn:aView at:aStartPoint atEnd:aFourArgEndBlock
"start a line-drag of an arrow-line.
The drag starts in aView at point aStartPoint.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
|p|
p := self class translatePointToScreen:aStartPoint from:aView.
self doStart:(DragHandler startArrowDragAt:p)
for:aView
atEnd:aFourArgEndBlock
!
startLineDragIn:aView at:aStartPoint atEnd:aFourArgEndBlock
"start a line-drag of a normal line.
The drag starts in aView at point aStartPoint.
When finished, the endAction is called with four args:
the targetView, the targetViews windowID (useful, if its an alien view),
the dropPoint in root-coordinates and the dropPoint within the targetView
"
|p|
p := self class translatePointToScreen:aStartPoint from:aView.
self doStart:(DragHandler startLineDragAt:p)
for:aView
atEnd:aFourArgEndBlock
! !
!DragAndDropManager methodsFor:'drawing'!
displayObjectFor:anObject on:aDevice
"converts an object to a display object
"
|obj s1 s2|
obj := (anObject respondsTo:#displayObject) ifTrue:[anObject displayObject]
ifFalse:[anObject].
obj isString ifTrue:[
^ obj
].
MessageNotUnderstood
ignoreNotUnderstoodOf:#'onDevice:'
in:[
obj := obj onDevice:aDevice
].
obj isImage ifTrue:[
^ obj clearMaskedPixels
].
obj class == LabelAndIcon ifTrue:[
obj image notNil ifTrue:[obj image clearMaskedPixels].
obj icon notNil ifTrue:[obj icon clearMaskedPixels].
^ obj
].
(obj class == MultiColListEntry) ifFalse:[
^ obj
].
s1 := obj colAt:1.
s2 := obj colAt:2.
s1 isImage ifTrue:[
s2 isImage ifTrue:[ ^ self displayObjectFor:(LabelAndIcon form:s1 image:s2) on:aDevice ].
s2 isString ifTrue:[ ^ self displayObjectFor:(LabelAndIcon icon:s1 string:s2) on:aDevice ].
^ (s1 on:aDevice) clearMaskedPixels
].
s2 isImage ifTrue:[
s1 isString ifTrue:[ ^ self displayObjectFor:(LabelAndIcon icon:s2 string:s1) on:aDevice ].
^ (s2 on:aDevice) clearMaskedPixels
].
s1 isString ifTrue:[^ s1].
s2 isString ifTrue:[^ s2].
^ obj
!
showDragging:items in:aView at:p
"helper for dragging dragObjects: draw them all"
|offs|
offs := 0.
items do:[:item |
item displayOn:aView at:p + (0@offs).
offs := offs + (item heightOn:self)
]
"Modified: 19.4.1997 / 12:41:24 / cg"
! !
!DragAndDropManager methodsFor:'event catching'!
buttonMotion:buttonState x:x y:y view:aView
"handle a button motion event
"
|oldPt oldTgt oldWg oldId newWg newId newTgt screenPoint cursor device isDroppable|
self removePassiveAction.
escapePressed == true ifTrue:[^ self].
device := dragView device.
screenPoint := self class translatePointToScreen:(x @ y) from:dragView.
"/ cursor := dragView cursor.
"/ screenPoint := screenPoint + (cursor hotX @ cursor hotY).
oldWg := dropContext targetWidget.
oldId := dropContext targetId.
oldPt := dropContext rootPoint.
dropContext rootPoint:screenPoint.
newId := device viewIdFromPoint:screenPoint.
newWg := device viewFromId:newId.
dropContext targetWidget:newWg id:newId.
handler isInterestedInDropTarget ifFalse:[
"/
"/ line or arrow handler
"/
handler dragTo:screenPoint.
^ self
].
true "oldWg ~~ newWg" ifTrue:[
"/
"/ widget has changed: drop target might change
"/
oldTgt := dropContext dropTarget.
newTgt := self doFindDropTargetIn:newWg at:screenPoint.
newTgt ~= oldTgt ifTrue:[
"/
"/ drop target changed: handler might restore the screen
"/
handler dropTargetWillChange.
oldTgt notNil ifTrue:[
"/
"/ setup old context
"/
dropContext targetWidget:oldWg id:oldId.
oldTgt leave:dropContext.
dropContext targetWidget:newWg id:newId.
].
dropContext dropTarget:newTgt.
newTgt notNil ifTrue:[ newTgt enter:dropContext ]
] ifFalse:[
dropContext dropTarget:newTgt
]
] ifFalse:[
(oldPt notNil and:[(oldPt dist:screenPoint) < 2 ]) ifTrue:[
"/
"/ ignore the button motion event; restore old rootPoint
"/
dropContext rootPoint:oldPt.
^ self
].
newTgt := dropContext dropTarget
].
"/
"/ update the cursor
"/
(isDroppable := dropContext canDrop) ifTrue:[
cursor := enabledCursor
] ifFalse:[
cursor := dropContext isAlienView ifFalse:[disabledCursor]
ifTrue:[alienCursor]
].
dragView cursor:cursor now:true.
"/
"/ test if droppable state changed
"/
canDrop == isDroppable ifFalse:[
"/
"/ droppable state changed: handler might restore the screen
"/
canDrop := isDroppable.
handler dropTargetWillChange
].
newTgt notNil ifTrue:[ newTgt over:dropContext ].
handler dragTo:screenPoint.
!
buttonMultiPress:button x:x y:y view:aView
"discard each buttonMultiPress event
"
!
buttonPress:button x:x y:y view:aView
"discard each buttonPress event
"
!
buttonRelease:button x:x y:y view:aView
"button released; do the drop
"
((button == 2) or:[button == #menu]) ifTrue:[
^ self
].
self removePassiveAction.
"/
"/ update the context
"/
self buttonMotion:button x:x y:y view:aView.
"/
"/ restore source view
"/
restoreBlock value.
escapePressed == true ifTrue:[^ self].
"/
"/ at least do the drop operation
"/
dropAction isNil ifTrue:[
dropContext doDrop
] ifFalse:[
"/
"/ initiator wants to do it himself, manually.
"/ Thus, no feedBack operation invoked.
"/
dropAction value:(dropContext targetWidget)
value:(dropContext targetId)
value:(dropContext rootPoint)
value:(dropContext targetPoint).
]
!
delegatesTo:someone
^false
!
handlesButtonMotion:button inView:aView
"query from event processor: am I interested in button-events ?
yes I am (to activate the clicked-on field)."
^ dragView == aView
!
handlesButtonMultiPress:button inView:aView
"query from event processor: am I interested in button-events ?
yes I am (to activate the clicked-on field)."
^ dragView == aView
!
handlesButtonPress:button inView:aView
"query from event processor: am I interested in button-events ?
yes I am (to activate the clicked-on field)."
^ dragView == aView
!
handlesButtonRelease:button inView:aView
"query from event processor: am I interested in button-events ?
yes I am (to activate the clicked-on field)."
^ dragView == aView
!
handlesKeyPress:aKey inView:aView
"query from event processor: am I interested in key-events ?
yes I am (to activate the clicked-on field)."
^ dragView == aView
!
keyPress:aKey x:x y:y view:aView
"any key is pressed:
#Escape cancel drag & drop operation
"
|dropTarget|
escapePressed == true ifTrue:[^ self ]. "/ already canceled
aKey == #Escape ifTrue:[
"/ cancel drag & drop operation
escapePressed := true.
handler ifNotNil:[
"/ restore handler
dropTarget := dropContext dropTarget.
handler postDragging.
dropTarget ifNotNil:[
"/ invoke leave operation
dropTarget leave:dropContext.
dropContext dropTarget:nil.
].
].
^ self
].
! !
!DragAndDropManager methodsFor:'initialization'!
initialize
super initialize.
dragOffset := 0 @ 0.
dropContext := DropContext new.
dropContext manager:self.
alienCursor := Cursor questionMark.
enabledCursor := Cursor thumbsUp.
disabledCursor := Cursor thumbsDown.
canDrop := false.
! !
!DragAndDropManager methodsFor:'private'!
doDrop:aContext in:aWidget
"old drop mechanism
"
|point|
DragContextQuerySignal answer:aContext do:[
DragOriginatorQuerySignal answer:dragView do:[
DragOffsetQuerySignal answer:dragOffset do:[
aContext targetWidget == aWidget ifTrue:[
point := aContext targetPoint
] ifFalse:[
point := 0@0. "/ nil.
"/
"/ FeedBack: set the widget which handles the drop
"/
aContext targetWidget:aWidget id:(aWidget id).
].
aWidget drop:(aContext dropObjects) at:point
]
].
].
"Modified: / 11.9.1998 / 00:53:22 / cg"
!
doFindDropTargetIn:aView at:aPoint
"get the drop target for a view and source at a point or nil
"
aView isNil ifTrue:[ ^ nil ].
"/
"/ new mechanism to get a dropTarget
"/
MessageNotUnderstood
ignoreNotUnderstoodOf:#dropTarget
in:[ |target|
target := aView dropTarget.
target notNil ifTrue:[ ^ target ].
].
"/
"/ old mechanism to get a dropTarget
"/
DragContextQuerySignal answer:dropContext do:[
DragOriginatorQuerySignal answer:dragView do:[
DragOffsetQuerySignal answer:dragOffset do:[
|view dobj|
view := aView.
dobj := dropContext dropObjects.
[
(view canDrop:dobj) ifTrue:[
^ DropTarget receiver:self argument:view dropSelector:#doDrop:in:.
].
(view := view superView) notNil
] whileTrue.
]
].
].
^ nil
!
doStart:aHandler for:aView atEnd:aFourArgEndBlock
"setup a handler and a restore block
"
|device savedCursor savedDelegate prevGrab prevKeyb sensor p|
device := aView device.
(ActiveDragAndDropManagers at:device ifAbsent:nil) notNil ifTrue:[
self error:'oops - two dnd managers active' mayProceed:true.
].
ActiveDragAndDropManagers at:device put:self.
dropContext sourceWidget:aView.
dragOffset isNil ifTrue:[ dragOffset := 0 @ 0 ].
alienCursor isNil ifTrue:[ alienCursor := disabledCursor ].
dragView := aView.
dropAction := aFourArgEndBlock.
savedCursor := aView cursor.
savedDelegate := aView delegate.
handler := aHandler.
escapePressed := false.
prevGrab := prevKeyb := nil.
dropContext dragHandler:aHandler.
restoreBlock := [
ActiveDragAndDropManagers removeKey:device ifAbsent:nil.
escapePressed ifFalse:[
aHandler postDragging
].
aView delegate:savedDelegate.
aView cursor:savedCursor now:true.
prevGrab notNil ifTrue:[
aView forceUngrabPointer.
prevGrab grabPointer.
] ifFalse:[
aView ungrabPointer.
].
prevKeyb notNil ifTrue:[
aView forceUngrabKeyboard.
prevKeyb grabKeyboard.
] ifFalse:[
aView ungrabKeyboard.
].
].
aHandler preDraggingIn:aView.
aView delegate:self.
prevGrab := device activePointerGrab.
prevKeyb := device activeKeyboardGrab.
aView grabPointer.
aView grabKeyboard.
"/ must wait for all pending motion events to arrive, and ignore them
(sensor := aView sensor) notNil ifTrue:[
device sync.
sensor flushMotionEventsFor:nil.
].
"/ start with a first draw at the current mouse position
p := device pointerPosition.
p := device translatePoint:p fromView:nil toView:aView.
self buttonMotion:1 x:p x y:p y view:aView
"Modified: / 10.10.2001 / 14:45:22 / cg"
!
saveDraw:aBlock
handler postDragging.
aBlock value.
escapePressed == true ifFalse:[
"/ reread and show drag items
handler rereadSaveArea.
handler restoreFromSaveArea.
].
!
xx
Transcript showCR:([-3] on:Error do:[0]).
Transcript showCR:([5 printString. 7] on:Error do:[])
"
self new xx
"
! !
!DragAndDropManager class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.44 2002-11-04 14:29:55 cg Exp $'
! !
DragAndDropManager initialize!