DragAndDropManager.st
author Claus Gittinger <cg@exept.de>
Sat, 08 Aug 1998 13:42:06 +0200
changeset 1035 308004d24f3d
parent 881 981e0791ca36
child 1072 be90bc383d83
permissions -rw-r--r--
*** empty log message ***

"
 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:'dropContext dragView dropAction dragOffset handler restoreBlock
		alienCursor enabledCursor disabledCursor canDrop'
	classVariableNames:'DragOriginatorQuerySignal DragOffsetQuerySignal'
	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.

    "
     self initialize
    "

    "Modified: 11.8.1997 / 00:54:21 / cg"
!

new
    ^ self basicNew initialize
! !

!DragAndDropManager class methodsFor:'Signal constants'!

dragOffsetQuerySignal
    ^ DragOffsetQuerySignal

    "Created: 11.8.1997 / 00:54:10 / cg"
!

dragOriginatorQuerySignal
    ^ DragOriginatorQuerySignal
! !

!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 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


!

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 dispObj 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| dispObjs do:[:el| (el at:1) displayOn:v at:p + (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 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 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 icon s1 s2|

    obj := (anObject respondsTo:#displayObject) ifTrue:[anObject displayObject]
                                               ifFalse:[anObject].

    obj isString ifTrue:[
        ^ obj
    ].

    obj messageNotUnderstoodSignal handle:[:ex|] do:[
        obj := obj on: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:button x:x y:y view:aView
    "handle a button motion event
    "
    |oldPt oldTgt oldWg oldId newWg newId newTgt point rootId cursor device isDroppable|

    device := dragView device.
    rootId := device rootView id.
    point  := self translatePointToScreen:(x @ y) from:dragView.
    oldWg  := dropContext targetWidget.
    oldId  := dropContext targetId.
    oldPt  := dropContext rootPoint.

    dropContext rootPoint:point.

    "/
    "/ search view the drop is in
    "/
    [   newId := rootId.
        (rootId := device viewIdFromPoint:point in:newId) notNil
    ] whileTrue.

    newWg := device viewFromId:newId.
    dropContext targetWidget:newWg id:newId.

    handler isInterestedInDropTarget ifFalse:[
        "/
        "/ line or arrow handler
        "/
        handler dragTo:point.
        ^ self
    ].

    oldWg ~~ newWg ifTrue:[
        "/
        "/ widget has changed: drop target might change
        "/
        oldTgt := dropContext dropTarget.
        newTgt := self doFindDropTargetIn:newWg at:point.

        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:point) < 2 ]) ifTrue:[
            "/
            "/ ignorre 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:point.
!

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
    ].
    "/
    "/ update the context
    "/
    self buttonMotion:button x:x y:y view:aView.

    "/
    "/ restore source view
    "/
    restoreBlock value.

    "/
    "/ 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).
    ]
!

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
! !

!DragAndDropManager methodsFor:'initialization'!

initialize
    super initialize.

    dragOffset     := 0 @ 0.
    dropContext    := DropContext new.
    alienCursor    := Cursor questionMark.
    enabledCursor  := Cursor thumbsUp.
    disabledCursor := Cursor thumbsDown.
    canDrop        := false.
! !

!DragAndDropManager methodsFor:'private'!

doDrop:aContext in:aWidget
    "old drop mechanism
    "
    |point|

    DragOriginatorQuerySignal answer:dragView do:[
        DragOffsetQuerySignal answer:dragOffset do:[
            aContext targetWidget == aWidget ifTrue:[
                point := aContext targetPoint
            ] ifFalse:[
                point := nil.
                "/
                "/ FeedBack: set the widget which handles the drop
                "/
                aContext targetWidget:aWidget id:(aWidget id).
            ].
            aWidget drop:(aContext dropObjects) at:point
        ]
    ].

!

doFindDropTargetIn:aView at:aPoint
    "get the drop target for a view and source at a point or nil
    "
    |target view dobj|

    aView isNil ifTrue:[ ^ nil ].
    "/
    "/ new mechanism to get a dropTarget
    "/
    aView messageNotUnderstoodSignal handle:[:ex|
        target := nil.
    ] do:[
        target := aView dropTarget
    ].
    target notNil ifTrue:[ ^ target ].
    "/
    "/ old mechanism to get a dropTarget
    "/
    view := aView.
    dobj := dropContext dropObjects.

    DragOriginatorQuerySignal answer:dragView do:[
        DragOffsetQuerySignal answer:dragOffset do:[
            [   (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
    "
    |cursor delegate|

    dropContext sourceWidget:aView.

    dragOffset  isNil ifTrue:[ dragOffset  := 0 @ 0 ].
    alienCursor isNil ifTrue:[ alienCursor := disabledCursor ].

    dragView   := aView.
    dropAction := aFourArgEndBlock.
    cursor     := aView cursor.
    delegate   := aView delegate.
    handler    := aHandler.

    restoreBlock := [
        aHandler postDragging.
        aView delegate:delegate.
        aView cursor:cursor now:true.
        aView device ungrabPointer
    ].

    aHandler preDraggingIn:aView.
    aView delegate:self.
    aView device grabPointerInView:aView.

! !

!DragAndDropManager methodsFor:'translation'!

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 from:(aView id) to:(device rootView id).
  ^ offset + point

! !

!DragAndDropManager class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.20 1998-03-31 09:42:45 cg Exp $'
! !
DragAndDropManager initialize!