"
 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.
"


Object subclass:#DragAndDropManager
	instanceVariableNames:'dragView motionAction releaseAction initialPoint previousPoint
		rememberedDelegate dragBlock lineMode dropAction opaque saveUnder
		dragSize dragOffset dropObjects saveCursor lastView
		lastScreenPosition'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Support'
!

View subclass:#DemoView
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:DragAndDropManager
!

View subclass:#DemoView3
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:DragAndDropManager
!

View subclass:#DemoView2
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:DragAndDropManager
!

!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:]
        DemoView DemoView2 DemoView3 - examples
        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]

"
! !

!DragAndDropManager class methodsFor:'simple start'!

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

    "
     |o v|

     v := Button label:'press me'.
     v pressAction:[
                |o|
                o := DropObject newFile:('.').
                v turnOff; repairDamage.
                DragAndDropManager 
                    startArrowDragIn:v 
                    at:0@0 
                    atEnd:[:v :vID :sPos :vPos |
                                v isNil ifTrue:[
                                    Transcript show:'alien view'
                                ] ifFalse:[
                                    Transcript show:'view: ';
                                               show:v
                                ].
                                Transcript show:' screen: '; show:sPos;
                                           show:' inView: '; showCR:vPos.
                          ].
              ].
     v openAt:100@100
    "

    "Modified: 19.4.1997 / 12:04:08 / cg"
!

startDrag:anObjectOrCollection from:aView
    "start a drop at the current pointer position"

    (self new) startDrag:anObjectOrCollection from:aView offset:0@0

    "
     |o v|

     v := (Button label:'press me').
     v pressAction:[
                |o|
                o := DropObject newFile:('.').
                DragAndDropManager startDrag:o from:v.
                v turnOff
              ].
     v openAt:100@100
    "

    "Modified: 19.4.1997 / 11:42:40 / cg"
!

startDrag:anObjectOrCollection from:aView offset:offset
    "start a drop at the current pointer position"

    (self new) startDrag:anObjectOrCollection from:aView offset:offset

    "
     |o v|

     v := (Button label:'press me').
     v pressAction:[
                |o|
                o := DropObject newFile:('.').
                DragAndDropManager startDrag:o from:v offset:10@10.
                v turnOff
              ].
     v openAt:100@100
    "

    "Modified: 19.4.1997 / 11:42:45 / cg"
!

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

    "
     |o v|

     v := (Button label:'press me').
     v pressAction:[
                |o|
                o := DropObject newFile:('.').
                v turnOff; repairDamage.
                DragAndDropManager 
                    startLineDragIn:v 
                    at:0@0 
                    atEnd:[:v :vID :sPos :vPos |
                                v isNil ifTrue:[
                                    Transcript show:'alien view'
                                ] ifFalse:[
                                    Transcript show:'view: ';
                                               show:v
                                ].
                                Transcript show:' screen: '; show:sPos;
                                           show:' inView: '; showCR:vPos.
                          ].
              ].
     v openAt:100@100
    "

    "Modified: 19.4.1997 / 12:02:02 / cg"
! !

!DragAndDropManager methodsFor:'accessing'!

dropObjects
    "return the current dropObject collection"

    ^ dropObjects

    "Modified: 19.4.1997 / 10:19:06 / cg"
!

dropObjects:aCollectionOfDropObjects
    "set the current dropObject collection"

    aCollectionOfDropObjects isCollection ifTrue:[
        dropObjects := aCollectionOfDropObjects
    ] ifFalse:[
        dropObjects := Array with:aCollectionOfDropObjects
    ].

    "Modified: 19.4.1997 / 10:19:33 / cg"
! !

!DragAndDropManager methodsFor:'dragging - generic'!

doGenericDragX:x y:y
    "drag to x/y; see if the target view allows a drop
     and change the mouse pointer as appropriate"

    |view newCursor|

    previousPoint notNil ifTrue:[
        (opaque and:[dragSize notNil]) ifTrue:[
            self restoreGenericAt:previousPoint
        ] ifFalse:[
            self invertGenericAt:previousPoint
        ]
    ].
    previousPoint := x @ y.
    lastScreenPosition := nil.

    view := self destinationViewAt:previousPoint.
    view ~~ lastView ifTrue:[
        view isNil ifTrue:[
            "/ alien view - dont know if it likes a drop
            newCursor := Cursor questionMark
        ] ifFalse:[
            "/ ST/X view - ask it.
            (view canDrop:dropObjects) ifTrue:[
                newCursor := Cursor thumbsUp
            ] ifFalse:[
                newCursor := Cursor thumbsDown
            ]
        ].
        dragView cursor:newCursor now:true.
        lastView := view
    ].

    (opaque and:[dragSize notNil]) ifTrue:[
        self drawGenericAt:previousPoint.
    ] ifFalse:[
        self invertGenericAt:previousPoint
    ].

    "Modified: 19.4.1997 / 11:33:54 / cg"
!

endGenericDragX:x y:y
    "finish a drag; restore from saveUnder (or reinvert),
     then call for the endAction"

    previousPoint notNil ifTrue:[
        (opaque and:[dragSize notNil]) ifTrue:[
            self restoreGenericAt:previousPoint
        ] ifFalse:[
            self invertGenericAt:previousPoint
        ]
    ].
    previousPoint := nil.
    self uncatchEvents.
    self endDragAt:x @ y

    "Created: 26.10.1996 / 15:17:20 / cg"
    "Modified: 19.4.1997 / 10:41:57 / cg"
!

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 catchEventsFrom:aView.
    motionAction := #doGenericDragX:y:.
    releaseAction := #endGenericDragX:y:.
    initialPoint := p.
    previousPoint := nil.
    dragBlock := aTwoArgDragBlock.
    dropAction := aFourArgEndBlock.

    "Created: 26.10.1996 / 15:16:13 / cg"
    "Modified: 19.4.1997 / 10:44:32 / cg"
!

startOpaqueDrag:aTwoArgDragBlock offset:offs extent:ext in:aView at:p atEnd:aFourArgEndBlock
    "start a 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 ext.
     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 catchEventsFrom:aView.
    motionAction := #doGenericDragX:y:.
    releaseAction := #endGenericDragX:y:.
    initialPoint := p.
    previousPoint := nil.
    dragBlock := aTwoArgDragBlock.
    dropAction := aFourArgEndBlock.
    opaque := true.
    dragSize := ext.
    dragOffset := offs.

    "Modified: 26.10.1996 / 15:09:26 / cg"
    "Created: 26.10.1996 / 15:16:13 / cg"

! !

!DragAndDropManager methodsFor:'dragging - generic - inverting'!

invertGenericAt:ip
    "draw for a generic inverting drag"

    |t offs p rootView|

    rootView := dragView device rootView.

    (p := lastScreenPosition) isNil ifTrue:[
        p := ip.

        "
         get device coordinates
        "
        (t := dragView transformation) notNil ifTrue:[
            p := t applyTo:p.
        ].

        "
         translate to screen
        "
        offs := dragView device 
                    translatePoint:0@0 
                    from:(dragView id) to:(rootView id).
        p := p + offs.

        lastScreenPosition := p.
    ].

    rootView clippedByChildren:false.
    rootView xoring:[
        rootView lineWidth:0. 
        self callForDragActionAt:p in:rootView.
        rootView flush
    ].

    "Created: 26.10.1996 / 15:15:26 / cg"
    "Modified: 19.4.1997 / 11:35:33 / cg"
! !

!DragAndDropManager methodsFor:'dragging - generic - opaque'!

drawGenericAt:ip
    "draw for a generic opaque drag"

    |t offs p rootView szX szY|

    rootView := dragView device rootView.

    p := ip.

    "/
    "/ get device coordinates
    "/
    (t := dragView transformation) notNil ifTrue:[
        p := t applyTo:p.
    ].

    "/
    "/ translate to screen
    "/
    offs := dragView device 
                translatePoint:0@0 
                from:(dragView id) to:(rootView id).
    p := p + offs.

    rootView clippedByChildren:false.

    "/
    "/ copy from screen to saveUnder
    "/
    szX := dragSize x.
    szY := dragSize y.
    saveUnder isNil ifTrue:[
        saveUnder := Form 
                            width:szX 
                            height:szY 
                            depth:rootView device depth 
                            on:dragView device.
        saveUnder clippedByChildren:false.
    ].

    lastScreenPosition := p - dragOffset.
    saveUnder 
        copyFrom:rootView 
        x:lastScreenPosition x 
        y:lastScreenPosition y
        toX:0 
        y:0 
        width:szX 
        height:szY.

    "/
    "/ draw using the dragAction block
    "/
    rootView lineWidth:0. 
    self callForDragActionAt:p in:rootView.
    rootView flush

    "Modified: 19.4.1997 / 10:45:48 / cg"
!

restoreGenericAt:ip
    "restore from saveUnder for a generic opaque drag"

    |rootView|

    rootView := dragView device rootView.

    "/
    "/ copy from saveUnder back to screen
    "/
    rootView clippedByChildren:false.
    rootView 
        copyFrom:saveUnder 
        x:0 y:0 
        toX:lastScreenPosition x y:lastScreenPosition y
        width:dragSize x 
        height:dragSize y.

    "Modified: 19.4.1997 / 10:46:39 / cg"
! !

!DragAndDropManager methodsFor:'dragging - lines'!

doLineDragX:x y:y
    "do a line drag - invert previous and draw at new position"

    previousPoint notNil ifTrue:[
        self invertLineFrom:initialPoint to:previousPoint
    ].
    previousPoint := x @ y.
    self invertLineFrom:initialPoint to:previousPoint

    "Modified: 19.4.1997 / 12:39:43 / cg"
!

endLineDragX:x y:y
    "end a line drag - invert previous, deinstall event catcher 
     and call for endDrag action"

    previousPoint notNil ifTrue:[
        self invertLineFrom:initialPoint to:previousPoint
    ].

    previousPoint := nil.
    dragView device sync.

    self uncatchEvents.
    self endDragAt:x @ y.

    "Created: 26.10.1996 / 15:17:20 / cg"
    "Modified: 19.4.1997 / 12:40:14 / cg"
!

invertLineFrom:ip1 to:ip2
    "invert for a line drag"

    |t offs p1 p2 rootView a|

    rootView := dragView device rootView.

    p1 := ip1.
    p2 := ip2.

    "
     get device coordinates
    "
    (t := dragView transformation) notNil ifTrue:[
        p1 := t applyTo:p1.
        p2 := t applyTo:p2.
    ].

    "
     translate to screen
    "
    offs := dragView device 
                translatePoint:0@0 
                from:(dragView id) to:(rootView id).
    p1 := p1 + offs.
    p2 := p2 + offs.

    rootView clippedByChildren:false.
    rootView xoring:[
        rootView lineWidth:0. 
        lineMode == #arrow ifTrue:[
            a := Arrow from:p1 to:p2.
            a arrowHeadLength:(rootView device horizontalPixelPerMillimeter * 4) rounded.
            a displayFilledOn:rootView.
        ] ifFalse:[
            rootView displayLineFrom:p1 to:p2.
        ].
        rootView flush
    ].

    "Created: 26.10.1996 / 15:15:26 / cg"
    "Modified: 19.4.1997 / 12:40:29 / cg"
!

startArrowDragIn:aView at:p atEnd:aBlock
    "start a line-drag of an arrow-line.
     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 catchEventsFrom:aView.
    motionAction := #doLineDragX:y:.
    releaseAction := #endLineDragX:y:.
    initialPoint := p.
    previousPoint := nil.
    dragBlock := nil.
    lineMode := #arrow.
    dropAction := aBlock.

    "Modified: 26.10.1996 / 15:09:26 / cg"
    "Created: 26.10.1996 / 15:16:13 / cg"

!

startLineDragIn:aView at:p atEnd:aFourArgEndBlock
    "start a line-drag of a normal line.
     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 catchEventsFrom:aView.
    motionAction := #doLineDragX:y:.
    releaseAction := #endLineDragX:y:.
    initialPoint := p.
    previousPoint := nil.
    dragBlock := nil.
    lineMode := nil.
    dropAction := aFourArgEndBlock.

    "Modified: 26.10.1996 / 15:09:26 / cg"
    "Created: 26.10.1996 / 15:16:13 / cg"

! !

!DragAndDropManager methodsFor:'drawing'!

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:'dropping'!

drop:something in:targetView at:aPoint from:sourceView ifOk:okAction ifFail:failAction
    "try to drop some object in a targetView;
     if any view along the targetViews superView chain takes it, 
     the okAction is evaluated; if not, failAction is evaluated.
     This may be sent from a drag initiators endDrag block."

    |v pnt|

    v := targetView.
    pnt := aPoint.

    [v notNil] whileTrue:[
        (v canDrop:something) ifTrue:[
            v 
                drop:something 
                at:aPoint 
                from:sourceView 
                with:[:o | okAction. ^ true]
                ifFail:[:o | failAction. ^ false].
        ].
        v := v superView.
        pnt := nil
    ].
    failAction value.
    ^ false

    "Modified: 19.4.1997 / 12:42:36 / cg"
! !

!DragAndDropManager methodsFor:'easy drag & drop'!

startDrag:anObjectOrCollection from:aView offset:offset
    "start a drop at the current pointer position"

    |pos displayObjects device width height|

    self dropObjects:anObjectOrCollection.

    device := aView device.
    pos := device translatePoint:(device pointerPosition)
                            from:(device rootView id) 
                              to:(aView id).

    displayObjects := dropObjects collect:[:each | each displayObject on:device].
    height := displayObjects inject:0 into:[:sum :each | sum + (each heightOn:aView)].
    width  := displayObjects inject:0 into:[:max :each | max max:(each widthOn:aView)].

    self startOpaqueDrag:[:aPoint :aView|self showDragging:displayObjects in:aView at:(aPoint - offset)]
                  offset:offset
                  extent:(width @ height)
                      in:aView
                      at:pos
                   atEnd:nil.
! !

!DragAndDropManager methodsFor:'event catching'!

buttonMotion:button x:x y:y view:aView
    self perform:motionAction with:x with:y

    "Created: 26.10.1996 / 15:09:00 / cg"


!

buttonRelease:button x:x y:y view:aView
    self perform:releaseAction with:x with:y.

    "Modified: 19.4.1997 / 12:37:02 / cg"
!

handlesButtonMotion:button inView:aView
    "query from event processor: am I interested in button-events ?
     yes I am (to activate the clicked-on field)."

    ^ aView == dragView

    "Created: 26.10.1996 / 15:05:36 / cg"

!

handlesButtonRelease:button inView:aView
    "query from event processor: am I interested in button-events ?
     yes I am (to activate the clicked-on field)."

    ^ aView == dragView

    "Created: 26.10.1996 / 15:05:48 / cg"

! !

!DragAndDropManager methodsFor:'private'!

callForDragActionAt:aPoint in:aView
    "evaluate the user supplied dragAction.
     Look how many args it expects and invoke with
        position
        dragView
        dragObjects"

    |numArgs|

    (numArgs := dragBlock numArgs) == 1 ifTrue:[
        dragBlock value:aPoint
    ] ifFalse:[
        numArgs == 2 ifTrue:[
            dragBlock value:aPoint value:aView
        ] ifFalse:[
            dragBlock value:aPoint value:aView value:dropObjects.
        ]
    ]

    "Created: 19.4.1997 / 10:05:55 / cg"
!

catchEventsFrom:aView
    dragView   := aView.
    saveCursor := dragView cursor.

    rememberedDelegate := aView delegate.
    aView delegate:self.
    aView device grabPointerInView:aView.

    "Modified: 19.4.1997 / 12:36:04 / cg"
!

destinationViewAt:ip
    |rootPoint t viewId offs destinationId lastViewId destinationView
     rootView destinationPoint device|

    device    := dragView device.
    rootView  := device rootView.
    rootPoint := ip.

    "
     get device coordinates
    "
    (t := dragView transformation) notNil ifTrue:[
        rootPoint := t applyTo:ip.
    ].
    viewId := rootView id.

    "
     translate to screen
    "
    offs := device translatePoint:0@0 from:(dragView id) to:viewId.
    rootPoint := rootPoint + offs.

    "search view the drop is in"

    [viewId notNil] whileTrue:[
        destinationId := device viewIdFromPoint:rootPoint in:viewId.
        lastViewId := viewId.
        viewId := destinationId
    ].
    ^ device viewFromId:lastViewId
!

endDragAt:ip
    |rootPoint t rootId viewId offs destinationId lastViewId destinationView
     rootView destinationPoint device|

    dragView cursor:saveCursor now:true.
    device := dragView device.
    device ungrabPointer.
    rootView := device rootView.
    rootPoint := ip.

    "
     get device coordinates
    "
    (t := dragView transformation) notNil ifTrue:[
        rootPoint := t applyTo:ip.
    ].
    viewId := rootId := rootView id.

    "
     translate to screen
    "
    offs := device translatePoint:0@0 from:(dragView id) to:rootId.
    rootPoint := rootPoint + offs.

    "search view the drop is in"

    [viewId notNil] whileTrue:[
        destinationId := device viewIdFromPoint:rootPoint in:viewId.
        lastViewId := viewId.
        viewId := destinationId
    ].
    destinationView := device viewFromId:lastViewId.
    destinationId := lastViewId.

    "/
    "/ translate to destination view
    "/
    destinationPoint := device translatePoint:rootPoint from:rootId to:destinationId.

    dropAction notNil ifTrue:[
        "/ initiator wants to do it himself, manually.

        dropAction value:destinationView
                   value:destinationId
                   value:rootPoint
                   value:destinationPoint.
        ^ self
    ].

    "/ default drop behavior:
    "/ if its one of my own views, ask if dropping is ok.
    "/ if not, ask the device to drop it.

    destinationView notNil ifTrue:[
        "/
        "/ one of my views
        "/
        destinationPoint := device translatePoint:rootPoint
                                             from:(rootView id) 
                                               to:(destinationView id).
        destinationView transformation notNil ifTrue:[
            destinationPoint := destinationView transformation applyInverseTo:destinationPoint
        ].

        (destinationView canDrop:dropObjects) ifTrue:[
            destinationView drop:dropObjects at:destinationPoint.
            ^ self.
        ].

        "/ try superViews along the chain ...
        destinationView := destinationView superView.
        [destinationView notNil] whileTrue:[
            (destinationView canDrop:dropObjects) ifTrue:[
                destinationView drop:dropObjects at:nil.
                ^ self.
            ].
            destinationView := destinationView superView.
        ].
        ^ self
    ].

    "/
    "/ not one of my views
    "/

    "/ XXX add external clipboard mechanism via display
    device 
        drop:dropObjects 
        inWindowID:destinationId 
        position:destinationPoint 
        rootPosition:rootPoint

    "Modified: 19.4.1997 / 12:36:29 / cg"
!

uncatchEvents
    dragView delegate:rememberedDelegate.

    "Created: 26.10.1996 / 15:22:29 / cg"

    "
     DragAndDropManager allInstancesDo:[:m |
        m uncatchEvents
     ]
    "
! !

!DragAndDropManager::DemoView class methodsFor:'documentation'!

documentation
"
    demonstrates rubber-line dragging.

    See the buttonPress method, where a drag is initiated.
    At endDrop, look at the transcript.

    [author:]
        Claus Gittinger

    [start with:]
        DemoView new open
"
! !

!DragAndDropManager::DemoView methodsFor:'events'!

buttonPress:button x:x y:y
    DragAndDropManager new
        startLineDragIn:self at:(x@y) 
        atEnd:[:view
               :viewID
               :rootPoint
               :viewPoint | 

               Transcript show:'dropped at ';
                          show:viewPoint;
                          show:' (screen: ';
                          show:rootPoint;
                          show:') in '.
               view notNil ifTrue:[
                   Transcript showCR:view
               ] ifFalse:[
                   Transcript show:'alien view ';
                              showCR:viewID address
               ] 
        ].

    "
     self new open
    "

    "Modified: 19.4.1997 / 11:40:46 / cg"
! !

!DragAndDropManager::DemoView3 class methodsFor:'documentation'!

documentation
"
    demonstrates arrow-line dragging.

    See the buttonPress method, where a drag is initiated.
    At endDrop, look at the transcript.

    [author:]
        Claus Gittinger

    [start with:]
        DemoView3 new open
"


! !

!DragAndDropManager::DemoView3 methodsFor:'events'!

buttonPress:button x:x y:y
    DragAndDropManager new
        startArrowDragIn:self 
        at:(x@y)
        atEnd:[:view
               :viewID
               :rootPoint
               :viewPoint | 

               Transcript show:'dropped at ';
                          show:viewPoint;
                          show:' (screen: ';
                          show:rootPoint;
                          show:') in '.
               view notNil ifTrue:[
                   Transcript showCR:view
               ] ifFalse:[
                   Transcript show:'alien view ';
                              showCR:viewID address
               ] 
        ].

    "
     self new open
    "

    "Modified: 19.4.1997 / 12:45:29 / cg"
! !

!DragAndDropManager::DemoView2 class methodsFor:'documentation'!

documentation
"
    demonstrates string dragging.

    See the buttonPress method, where a drag is initiated.
    At endDrop, look at the transcript.


    [author:]
        Claus Gittinger

    [start with:]
        DemoView2 new open
"


! !

!DragAndDropManager::DemoView2 methodsFor:'events'!

buttonPress:button x:x y:y
    DragAndDropManager new
        startGenericDrag:[:p :v | v displayString:'hello' at:p]
        in:self 
        at:(x@y) 
        atEnd:[:view
               :viewID
               :rootPoint
               :viewPoint | ]


    "
     self new open
    "


! !

!DragAndDropManager class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.14 1997-04-19 15:24:51 cg Exp $'
! !