DragAndDropManager.st
author Claus Gittinger <cg@exept.de>
Wed, 15 Aug 2001 14:52:20 +0200
changeset 1490 b2e1f907060c
parent 1487 6cefff982779
child 1497 dff682eb74fc
permissions -rw-r--r--
care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     1
"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     2
 COPYRIGHT (c) 1996 by eXept Software AG / Claus Gittinger
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
     3
	      All Rights Reserved
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     4
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     5
 This software is furnished under a license and may be used
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     6
 only in accordance with the terms of that license and with the
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     8
 be provided or otherwise made available to, or used by, any
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
     9
 other person.  No title to or ownership of the software is
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    10
 hereby transferred.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    11
"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    12
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    13
1397
47ac1d3e1df1 category changes
Claus Gittinger <cg@exept.de>
parents: 1289
diff changeset
    14
"{ Package: 'stx:libview2' }"
47ac1d3e1df1 category changes
Claus Gittinger <cg@exept.de>
parents: 1289
diff changeset
    15
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
Object subclass:#DragAndDropManager
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
    17
	instanceVariableNames:'dropContext dragView dropAction dragOffset handler restoreBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
    18
		alienCursor enabledCursor disabledCursor canDrop'
1487
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
    19
	classVariableNames:'DragOriginatorQuerySignal DragOffsetQuerySignal
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
    20
		ActiveDragAndDropManagers'
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
    21
	poolDictionaries:''
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
    22
	category:'Interface-DragAndDrop'
342
7563cbf04502 added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents: 341
diff changeset
    23
!
7563cbf04502 added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents: 341
diff changeset
    24
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
!DragAndDropManager class methodsFor:'documentation'!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    27
copyright
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    28
"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    29
 COPYRIGHT (c) 1996 by eXept Software AG / Claus Gittinger
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    30
	      All Rights Reserved
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    31
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    32
 This software is furnished under a license and may be used
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    33
 only in accordance with the terms of that license and with the
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    34
 inclusion of the above copyright notice.   This software may not
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    35
 be provided or otherwise made available to, or used by, any
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    36
 other person.  No title to or ownership of the software is
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    37
 hereby transferred.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    38
"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    39
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    40
!
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    41
348
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
    42
documentation
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
    43
"
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
    44
    this class provides low-level drag & drop mechanisms.
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
    45
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    46
    Easy to use interface interfaces:
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    47
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    48
    A drag is usually initiated by a view or its application model,
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    49
    when a selection is moved (for example, SelectionInListView can
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    50
    be initializd to do so). 
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    51
    There, the view creates a collection of dropObjects from its selection,
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    52
    and starts the drag operation with:
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    53
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    54
	DragAndDropManager startDrag:collectionOfDragObjects from:aView.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    55
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    56
    This easy to use interface starts a drag and also drops the collection
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    57
    into the target view.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    58
    While dragging, a thumbsUp cursor is shown, if the view-under-the-drag
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    59
    can handle a drop, a thumbsDown is shown if not, and a question mark
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    60
    is shown for alien views (which means: we dont know).
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    61
    Alien view drop is supported (but no 'canDrop' query).
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    62
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    63
    For rubber-band line dragging, two more easy-to-use startup methods are
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    64
    provided:
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    65
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    66
	DragAndDropManager
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    67
		startLineDragIn:aView at:position
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    68
		atEnd:aFourArgEndBlock
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    69
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    70
    and:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    71
	DragAndDropManager
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    72
		startArrowDragIn:aView at:position
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    73
		atEnd:aFourArgEndBlock
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    74
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    75
    both of the above expect a 4-arg block to be passed, which will be
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    76
    evaluated at end-drag, with the target view, its viewID, the drop position
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    77
    on the screen and within the target view as arguments.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    78
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    79
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    80
    Expert interface:
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    81
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    82
    More control over the dragging (i.e. the drawing procedure)
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    83
    can be optained, by passing a dragBlock and an endDrag action:
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    84
        
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    85
	aDragAndDropMgr := DragAndDropManager new.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    86
	aDragAndDropMgr dropObjects:(self collectionOfDragObjects).
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    87
	aDragAndDropMgr 
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    88
	    startOpaqueDrag:[:aPoint :aView :dropObjects | 
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    89
				self 
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    90
				    showDragging:dropObjects
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    91
				    in:aView 
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    92
				    at:aPoint - (xOffset@0)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    93
			    ]
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    94
	    offset:clickOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    95
	    extent:saveUnderExtent
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    96
	    in:self
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    97
	    at:clickPoint
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
    98
	    atEnd:[:v :vId :posScreen :posView | ... ]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
    99
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   100
    the arguments are:
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   101
      startOpaqueDrag:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   102
	a 3-arg block, which is evaluated by the d&d manager whenever the
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   103
	mouse moves; it is supposed to draw the dropObjects at some position
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   104
	in the passed view.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   105
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   106
      offset:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   107
	a clickOffset; drawing is offset by this amount
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   108
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   109
      extent:  
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   110
	a save extent; the size of the screen area that must be saved during
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   111
	the drag operation
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   112
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   113
      in:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   114
	initiating view
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   115
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   116
      at:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   117
	position where d&d operation starts
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   118
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   119
      atEnd:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   120
	a 4-arg block that is evaluated when the d&d is finished.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   121
	It gets the target view (or nil, for alien views), the targets
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   122
	view ID (needed if its an alien view), the screen position and the
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   123
	relative position within the target view of the drop as arguments.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   124
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   125
	For internal (ST/X) views, the dropBlock should perform
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   126
	a simple canDrop:/doDrop message.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   127
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   128
	For alien views, the Displays d&d functions can be used.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   129
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   130
348
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   131
    [author:]
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   132
	Claus Gittinger
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   133
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   134
    [see also:]
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   135
	DemoView1, DemoView2, ...
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   136
	SelectionInListView FileBrowser - for a concrete example
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   137
348
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   138
"
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   139
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   140
!
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   141
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   142
examples
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   143
"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   144
  a button, which initiates dragging of a file-object
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   145
  Notice that this can be dropped into the launchers panel,
549
51c6f1d918c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 548
diff changeset
   146
  to open a fileBrowser on that directory ...
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   147
								[exBegin]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   148
     |o top v|
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   149
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   150
     top := StandardSystemView new.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   151
     v := Button label:'press for drag' in:top.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   152
     v pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   153
		|o|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   154
		o := DropObject newFile:('/etc').
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   155
		DragAndDropManager startDrag:o from:v.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   156
		v turnOff
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   157
	      ].
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   158
     top openWithExtent:200@200
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   159
								[exEnd]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   160
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   161
  initiate a drag with some offset:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   162
								[exBegin]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   163
     |o top v|
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   165
     top := StandardSystemView new.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   166
     v := Button label:'press for drag' in:top.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   167
     v pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   168
		|o|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   169
		o := DropObject newFile:('.').
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   170
		DragAndDropManager startDrag:o from:v offset:10@10.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   171
		v turnOff
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   172
	      ].
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   173
     top openWithExtent:200@200
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   174
								[exEnd]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   175
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   176
  initiate a line drag:
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   177
								[exBegin]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   178
     |o top v endAction|
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   179
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   180
     endAction := [ :v :vID :sPos :vPos |
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   181
		    Transcript show:'end drag in '.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   182
		    v isNil ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   183
			Transcript show:'alien view'
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   184
		    ] ifFalse:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   185
			Transcript show:v
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   186
		    ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   187
		    Transcript show:' at screen: '; show:sPos;
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   188
			       show:' in view: '; showCR:vPos
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   189
		].
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   190
     top := StandardSystemView new.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   191
     v := Button label:'press for drag' in:top.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   192
     v pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   193
		DragAndDropManager 
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   194
		    startLineDragIn:v at:10@10 atEnd:endAction.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   195
		v turnOff
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   196
	      ].
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   197
     top openWithExtent:200@200
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   198
								[exEnd]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   199
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   200
   more drag & drop; offset, displayObjects, ...
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   201
								[exBegin]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   202
    |dropObj topView pannel icon buttonAction addButton|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   203
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   204
    topView := StandardSystemView new.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   205
    pannel  := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   206
    pannel  horizontalLayout:#fit.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   207
    pannel  verticalLayout:#fitSpace.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   208
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   209
    icon    := Image fromFile:('xpmBitmaps/QUESTION3.xpm').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   210
    dropObj := DropObject newFile:('.').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   211
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   212
    addButton := [:offset :label :dispObj| |button|
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   213
	button := Button label:label in:pannel.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   214
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   215
	button pressAction:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   216
	    DragAndDropManager startDrag:dropObj from:button offset:offset display:dispObj.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   217
	    button turnOff.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   218
	]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   219
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   220
881
981e0791ca36 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 874
diff changeset
   221
    addButton value:(0@-5)       value:'String'       value:'String'.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   222
    addButton value:#topLeft     value:'String'       value:'String'.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   223
    addButton value:#topRight    value:'Text'         value:(Text string:'hello' emphasis:#bold).
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   224
    addButton value:#bottomLeft  value:'Icon'         value:icon.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   225
    addButton value:#bottomRight value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   226
    addButton value:#center      value:'Mixed'        value:(Array with:'String' with:icon).
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   227
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   228
    topView label:'Drag & Drop'.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   229
    topView openWithExtent:200@200.
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   230
								[exEnd]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   231
"
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
! !
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   234
!DragAndDropManager class methodsFor:'initialization'!
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   235
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   236
initialize
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   237
    DragOriginatorQuerySignal := QuerySignal new.
680
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   238
    DragOffsetQuerySignal := QuerySignal new.
1487
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   239
    ActiveDragAndDropManagers := IdentityDictionary new.
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   240
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   241
    "
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   242
     self initialize
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   243
    "
680
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   244
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   245
    "Modified: 11.8.1997 / 00:54:21 / cg"
1420
418a8f90b7bc category change
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   246
! !
418a8f90b7bc category change
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   247
418a8f90b7bc category change
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   248
!DragAndDropManager class methodsFor:'instance creation'!
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   249
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   250
new
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   251
    ^ self basicNew initialize
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   252
! !
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   253
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   254
!DragAndDropManager class methodsFor:'Signal constants'!
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   255
680
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   256
dragOffsetQuerySignal
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   257
    ^ DragOffsetQuerySignal
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   258
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   259
    "Created: 11.8.1997 / 00:54:10 / cg"
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   260
!
6157661790fd keep dragOffset - provide querySignal
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   261
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   262
dragOriginatorQuerySignal
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   263
    ^ DragOriginatorQuerySignal
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   264
! !
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
   265
1487
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   266
!DragAndDropManager class methodsFor:'helpers'!
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   267
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   268
saveDraw:aBlock device:aDevice
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   269
    |activeManager|
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   270
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   271
    activeManager := ActiveDragAndDropManagers at:aDevice ifAbsent:nil.
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   272
    activeManager isNil ifTrue:[
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   273
        aBlock value
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   274
    ] ifFalse:[
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   275
        activeManager saveDraw:aBlock
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   276
    ].
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   277
! !
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   278
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   279
!DragAndDropManager class methodsFor:'queries'!
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   280
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   281
isDragAndDropActiveOnDevice:aDevice
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   282
    ^ ActiveDragAndDropManagers includesKey:aDevice
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   283
! !
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
   284
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   285
!DragAndDropManager class methodsFor:'simple start - drop source'!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   286
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   287
startDragFrom:aView dropSource:aDropSource
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   288
    "start a drop at the current pointer position.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   289
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   290
    ^ (self new) startDragFrom:aView dropSource:aDropSource
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   291
! !
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   292
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   293
!DragAndDropManager class methodsFor:'simple start - generic'!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   294
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   295
startDrag:draggableObjects from:aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   296
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   297
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   298
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   299
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   300
	      offset:0@0
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   301
	       atEnd:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   302
	     display:draggableObjects
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   303
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   304
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   305
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   306
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   307
    |button|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   308
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   309
    button := (Button label:'press me').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   310
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   311
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   312
	DragAndDropManager startDrag:(DropObject newFile:('.')) from:button.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   313
	button turnOff
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   314
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   315
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   316
    button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   317
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   318
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   319
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   320
startDrag:draggableObjects from:aView atEnd:aFourArgEndBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   321
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   322
     When finished, the endAction is called with four args:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   323
     the targetView, the targetViews windowID (useful, if its an alien view),
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   324
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   325
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   326
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   327
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   328
	      offset:0@0
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   329
	       atEnd:aFourArgEndBlock
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   330
	     display:draggableObjects
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   331
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   332
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   333
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   334
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   335
    |button|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   336
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   337
    button := (Button label:'press me').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   338
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   339
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   340
	DragAndDropManager startDrag:(DropObject newFile:('.'))
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   341
				from:button
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   342
			       atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   343
					Transcript showCR:'target  view: ', targetView   printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   344
					Transcript showCR:'target    id: ', targetViewId printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   345
					Transcript showCR:'point screen: ', screenPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   346
					Transcript showCR:'point target: ', targetPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   347
				     ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   348
	button turnOff
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   349
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   350
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   351
    button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   352
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   353
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   354
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   355
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   356
startDrag:draggableObjects from:aView atEnd:aFourArgEndBlock display:something
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   357
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   358
     When finished, the endAction is called with four args:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   359
     the targetView, the targetViews windowID (useful, if its an alien view),
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   360
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   361
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   362
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   363
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   364
	      offset:0@0
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   365
	       atEnd:aFourArgEndBlock
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   366
	     display:something
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   367
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   368
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   369
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   370
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   371
    |button|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   372
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   373
    button := (Button label:'press me').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   374
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   375
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   376
	DragAndDropManager startDrag:(DropObject newFile:('.'))
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   377
				from:button
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   378
			       atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   379
					Transcript showCR:'target  view: ', targetView   printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   380
					Transcript showCR:'target    id: ', targetViewId printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   381
					Transcript showCR:'point screen: ', screenPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   382
					Transcript showCR:'point target: ', targetPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   383
				     ]
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   384
			     display:(Array with:'String' with:(Image fromFile:('xpmBitmaps/QUESTION3.xpm'))).
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   385
	button turnOff
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   386
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   387
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   388
    button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   389
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   390
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   391
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   392
startDrag:draggableObjects from:aView display:something
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   393
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   394
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   395
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   396
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   397
	      offset:0@0
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   398
	       atEnd:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   399
	     display:something
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   400
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   401
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   402
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   403
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   404
    |dropObj topView pannel icon buttonAction addButton|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   405
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   406
    topView := StandardSystemView new.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   407
    pannel  := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   408
    pannel  horizontalLayout:#fit.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   409
    pannel  verticalLayout:#fitSpace.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   410
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   411
    icon    := Image fromFile:('xpmBitmaps/QUESTION3.xpm').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   412
    dropObj := DropObject newFile:('.').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   413
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   414
    addButton := [:label :dispObj| |button|
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   415
	button := Button label:label in:pannel.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   416
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   417
	button pressAction:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   418
	    DragAndDropManager startDrag:dropObj from:button display:dispObj.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   419
	    button turnOff.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   420
	]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   421
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   422
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   423
    addButton value:'String'       value:'String'.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   424
    addButton value:'Text'         value:(Text string:'hello' emphasis:#bold).
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   425
    addButton value:'Icon'         value:icon.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   426
    addButton value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   427
    addButton value:'Mixed'        value:(Array with:'String' with:icon).
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   428
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   429
    topView label:'Drag & Drop'.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   430
    topView openWithExtent:200@200.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   431
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   432
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   433
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   434
startDrag:draggableObjects from:aView offset:anOffset
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   435
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   436
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   437
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   438
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   439
	      offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   440
	       atEnd:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   441
	     display:draggableObjects
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   442
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   443
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   444
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   445
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   446
    |button|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   447
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   448
    button := (Button label:'press me').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   449
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   450
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   451
	DragAndDropManager startDrag:(DropObject newFile:('.')) from:button offset:(-10 @ -10).
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   452
	button turnOff
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   453
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   454
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   455
    button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   456
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   457
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   458
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   459
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   460
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgEndBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   461
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   462
     When finished, the endAction is called with four args:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   463
     the targetView, the targetViews windowID (useful, if its an alien view),
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   464
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   465
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   466
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   467
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   468
	      offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   469
	       atEnd:aFourArgEndBlock
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   470
	     display:draggableObjects
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   471
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   472
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   473
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   474
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   475
    |button|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   476
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   477
    button := (Button label:'press me').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   478
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   479
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   480
	DragAndDropManager startDrag:(DropObject newFile:('.'))
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   481
				from:button
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   482
			      offset:(-10 @ -10)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   483
			       atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   484
					Transcript showCR:'target  view: ', targetView   printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   485
					Transcript showCR:'target    id: ', targetViewId printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   486
					Transcript showCR:'point screen: ', screenPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   487
					Transcript showCR:'point target: ', targetPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   488
				     ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   489
	button turnOff
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   490
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   491
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   492
    button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   493
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   494
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   495
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   496
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   497
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgEndBlock display:something
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   498
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   499
     When finished, the endAction is called with four args:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   500
     the targetView, the targetViews windowID (useful, if its an alien view),
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   501
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   502
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   503
    |manager|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   504
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   505
    manager := self new.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   506
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   507
    manager startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   508
		 from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   509
	       offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   510
		atEnd:aFourArgEndBlock
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   511
	      display:something.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   512
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   513
    ^ manager
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   514
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   515
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   516
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   517
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   518
    |button|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   519
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   520
    button := (Button label:'press me').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   521
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   522
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   523
	DragAndDropManager startDrag:(DropObject newFile:('.'))
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   524
				from:button
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   525
			      offset:(-10 @ -10)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   526
			       atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   527
					Transcript showCR:'target  view: ', targetView   printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   528
					Transcript showCR:'target    id: ', targetViewId printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   529
					Transcript showCR:'point screen: ', screenPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   530
					Transcript showCR:'point target: ', targetPoint  printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   531
				     ]
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   532
			     display:(Array with:'String' with:(Image fromFile:('xpmBitmaps/QUESTION3.xpm'))).
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   533
	button turnOff
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   534
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   535
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   536
    button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   537
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   538
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   539
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   540
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   541
startDrag:draggableObjects from:aView offset:anOffset display:something
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   542
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   543
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   544
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   545
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   546
	      offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   547
	       atEnd:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   548
	     display:something
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   549
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   550
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   551
EXAMPLE:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   552
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   553
    |dropObj topView pannel icon buttonAction addButton|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   554
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   555
    topView := StandardSystemView new.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   556
    pannel  := VerticalPanelView origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:topView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   557
    pannel  horizontalLayout:#fit.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   558
    pannel  verticalLayout:#fitSpace.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   559
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   560
    icon    := Image fromFile:('xpmBitmaps/QUESTION3.xpm').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   561
    dropObj := DropObject newFile:('.').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   562
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   563
    addButton := [:offset :label :dispObj| |button|
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   564
	button := Button label:label in:pannel.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   565
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   566
	button pressAction:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   567
	    DragAndDropManager startDrag:dropObj from:button offset:offset display:dispObj.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   568
	    button turnOff.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   569
	]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   570
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   571
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   572
    addButton value:#topLeft     value:'String'       value:'String'.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   573
    addButton value:#topRight    value:'Text'         value:(Text string:'hello' emphasis:#bold).
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   574
    addButton value:#bottomLeft  value:'Icon'         value:icon.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   575
    addButton value:#bottomRight value:'LabelAndIcon' value:(LabelAndIcon icon:icon string:'Label & Icon').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   576
    addButton value:#center      value:'Mixed'        value:(Array with:'String' with:icon).
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   577
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   578
    topView label:'Drag & Drop'.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   579
    topView openWithExtent:200@200.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   580
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   581
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   582
! !
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   583
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   584
!DragAndDropManager class methodsFor:'simple start - lines'!
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   585
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   586
startArrowDragIn:aView at:dragPoint atEnd:aFourArgBlock
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   587
    "start a rubber-arrow-line dragging in aView at dragPoint.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   588
     When finished, evaluate the fourArgBlock with targetView,
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   589
     targetID, screenPosition and targetViewPosition as arguments
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   590
    "
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   591
    ^ self new startArrowDragIn:aView at:dragPoint atEnd:aFourArgBlock
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   592
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   593
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   594
EXAMPLE:
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   595
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   596
    |button|
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   597
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   598
    button := (Button label:'press me').
861
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   599
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   600
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   601
	button turnOff.
861
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   602
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   603
	DragAndDropManager startArrowDragIn:button 
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   604
					 at:(button preferredExtent // 2)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   605
				      atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   606
						targetView isNil ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   607
						    Transcript show:'alien view'
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   608
						] ifFalse:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   609
						    Transcript showCR:'target: ', targetView printString
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   610
						].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   611
						Transcript showCR:'point screen: ', screenPoint printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   612
						Transcript showCR:'point target: ', targetPoint printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   613
					    ]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   614
     ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   615
     button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   616
"
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   617
!
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   618
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   619
startLineDragIn:aView at:dragPoint atEnd:aFourArgBlock
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   620
    "start a rubber-line dragging in aView at dragPoint.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   621
     When finished, evaluate the fourArgBlock with targetView,
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   622
     targetID, screenPosition and targetViewPosition as arguments
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   623
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   624
    ^ self new startLineDragIn:aView at:dragPoint atEnd:aFourArgBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   625
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   626
"
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   627
EXAMPLE:
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   628
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   629
    |button|
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   630
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   631
    button := (Button label:'press me').
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   632
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   633
    button pressAction:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   634
	button turnOff.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   635
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   636
	DragAndDropManager startLineDragIn:button 
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   637
					at:(button preferredExtent // 2)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   638
				     atEnd:[:targetView :targetViewId :screenPoint :targetPoint|
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   639
					       targetView isNil ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   640
						   Transcript show:'alien view'
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   641
					       ] ifFalse:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   642
						   Transcript showCR:'target: ', targetView printString
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   643
					       ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   644
					       Transcript showCR:'point screen: ', screenPoint printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   645
					       Transcript showCR:'point target: ', targetPoint printString.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   646
					   ]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   647
     ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   648
     button openAt:100@100
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   649
"
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   650
! !
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   651
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   652
!DragAndDropManager methodsFor:'accessing'!
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   653
861
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   654
device
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   655
    "returns the device of the source view
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   656
    "
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   657
    ^ dragView device
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   658
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   659
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   660
!
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   661
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   662
dropContext
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   663
    "return the current context
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   664
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   665
    ^ dropContext
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   666
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   667
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   668
dropObjects
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   669
    "return the current dropObject collection"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   670
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   671
    ^ dropContext dropObjects
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   672
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   673
    "Modified: 19.4.1997 / 10:19:06 / cg"
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   674
!
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   675
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   676
dropObjects:aCollectionOfDropObjects
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   677
    "set the current dropObject collection"
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   678
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   679
    ^ dropContext dropObjects:aCollectionOfDropObjects
861
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   680
!
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   681
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   682
font
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   683
    "returns the font of the source view
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   684
    "
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   685
    ^ dragView font
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   686
10bbb13fcb05 add more simple drag & drop functionality:
ca
parents: 680
diff changeset
   687
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   688
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   689
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   690
sourceWidget
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   691
    ^ dragView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   692
! !
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   693
1397
47ac1d3e1df1 category changes
Claus Gittinger <cg@exept.de>
parents: 1289
diff changeset
   694
!DragAndDropManager methodsFor:'accessing-cursor'!
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   695
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   696
alienCursor:aCursorOrImage
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   697
    "set the cursor used for an alien widget; not an ST/X view
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   698
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   699
    aCursorOrImage isImage ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   700
	alienCursor := Cursor fromImage:aCursorOrImage
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   701
    ] ifFalse:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   702
	(aCursorOrImage isMemberOf:Cursor) ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   703
	    alienCursor := aCursorOrImage
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   704
	] ifFalse:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   705
	    "/
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   706
	    "/ use disabled cursor
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   707
	    "/
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   708
	    alienCursor := nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   709
	]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   710
    ]
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   711
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   712
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   713
disabledCursor:aCursorOrImage
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   714
    "set the cursor for an ST/X view, which can not drop the objects
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   715
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   716
    aCursorOrImage isImage ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   717
	disabledCursor := Cursor fromImage:aCursorOrImage
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   718
    ] ifFalse:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   719
	(aCursorOrImage isMemberOf:Cursor) ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   720
	    disabledCursor := aCursorOrImage
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   721
	]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   722
    ]
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   723
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   724
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   725
enabledCursor:aCursorOrImage
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   726
    "set the cursor for an ST/X view, which can drop the objects
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   727
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   728
    aCursorOrImage isImage ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   729
	enabledCursor := Cursor fromImage:aCursorOrImage
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   730
    ] ifFalse:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   731
	(aCursorOrImage isMemberOf:Cursor) ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   732
	    enabledCursor := aCursorOrImage
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   733
	]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   734
    ]
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   735
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   736
! !
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   737
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   738
!DragAndDropManager methodsFor:'dragging - drop source'!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   739
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   740
startDragFrom:aView dropSource:aDropSource
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   741
    "start a drop at the current pointer position.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   742
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   743
    ^ self startDragFrom:aView dropSource:aDropSource offset:#topLeft "/ #center
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   744
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   745
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   746
startDragFrom:aView dropSource:aDropSource offset:anOffset
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   747
    "start a drop at the current pointer position.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   748
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   749
    dropContext dropSource:aDropSource.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   750
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   751
    ^ self startDrag:(aDropSource dropObjects)
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   752
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   753
	      offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   754
	       atEnd:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   755
	     display:(aDropSource displayObjects)
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   756
! !
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   757
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   758
!DragAndDropManager methodsFor:'dragging - easy startup'!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   759
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   760
startDrag:draggableObjects from:aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   761
    "start a drop at the current pointer position
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   762
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   763
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   764
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   765
	      offset:0@0
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   766
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   767
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   768
startDrag:draggableObjects from:aView display:something
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   769
    "start a drop at the current pointer position.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   770
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   771
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   772
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   773
	      offset:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   774
	       atEnd:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   775
	     display:something
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   776
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   777
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   778
startDrag:draggableObjects from:aView offset:anOffset
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   779
    "start a drop at the current pointer position with an offset
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   780
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   781
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   782
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   783
	      offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   784
	       atEnd:nil
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   785
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   786
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   787
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgEndBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   788
    "start a drop at the current pointer position.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   789
     When finished, the endAction is called with four args:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   790
     the targetView, the targetViews windowID (useful, if its an alien view),
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   791
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   792
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   793
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   794
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   795
	      offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   796
	       atEnd:aFourArgEndBlock
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   797
	     display:draggableObjects
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   798
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   799
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   800
startDrag:draggableObjects from:aView offset:anOffset atEnd:aFourArgBlock display:something
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   801
    "start a drop at the current pointer position.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   802
     When finished, the endAction is called with four args:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   803
     the targetView, the targetViews windowID (useful, if its an alien view),
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   804
     the dropPoint in root-coordinates and the dropPoint within the targetView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   805
    "
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   806
    |height width fontWdt offset ascent device dispObjs list space|
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   807
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   808
    self dropObjects:draggableObjects.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   809
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   810
    self dropObjects size == 0 ifTrue:[
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   811
        ^ self
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   812
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   813
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   814
    device   := aView device.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   815
    space    := 1.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   816
    height   := space negated.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   817
    width    := 0.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   818
    fontWdt  := aView font width.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   819
    ascent   := aView font ascent.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   820
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   821
    (list := something) isNil ifTrue:[
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   822
        list := self dropObjects
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   823
    ] ifFalse:[
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   824
        (list isCollection not or:[list isString]) ifTrue:[
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   825
            list := Array with:something
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   826
        ]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   827
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   828
    dispObjs := OrderedCollection new.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   829
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   830
    list do:[:el|
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   831
        |obj asc|
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   832
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   833
        obj    := self displayObjectFor:el on:device.
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   834
        asc    := (obj respondsTo:#string) ifTrue:[ascent] ifFalse:[0].
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   835
        height := height + space.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   836
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   837
        dispObjs add:(Array with:obj with:(0 @ (height + asc))).
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   838
        width  := width max:(obj widthOn:aView).
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   839
        height := height + (obj heightOn:aView).
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   840
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   841
881
981e0791ca36 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 874
diff changeset
   842
    anOffset isSymbol ifTrue:[
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   843
        offset := (0@0 extent:(width @ height)) perform:anOffset.
881
981e0791ca36 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 874
diff changeset
   844
    ] ifFalse:[
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   845
        offset := anOffset ? (0@0).
881
981e0791ca36 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 874
diff changeset
   846
    ].
981e0791ca36 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 874
diff changeset
   847
    offset := offset rounded.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   848
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   849
    dispObjs do:[:el| el at:2 put:((el at:2) - offset) ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   850
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   851
    self startOpaqueDrag:[:p :v| 
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   852
                                |cursor hX hY pDraw|
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   853
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   854
                                cursor := dragView cursor.
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   855
                                hX := cursor hotX.
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   856
                                hY := cursor hotY.
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   857
                                pDraw := p - (hX@hY) + cursor extent.
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   858
                                dispObjs do:[:el| (el at:1) displayOn:v 
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   859
                                                            at:pDraw + (el at:2)
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   860
                                            ] 
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   861
                         ]
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   862
                  offset:offset
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   863
                  extent:width @ height
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   864
                      in:aView
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   865
                      at:nil
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
   866
                   atEnd:aFourArgBlock
881
981e0791ca36 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 874
diff changeset
   867
981e0791ca36 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 874
diff changeset
   868
    "Modified: / 31.3.1998 / 11:18:04 / cg"
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   869
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   870
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   871
startDrag:draggableObjects from:aView offset:anOffset display:something
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   872
    "start a drop at the current pointer position.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   873
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   874
    ^ self startDrag:draggableObjects
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   875
		from:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   876
	      offset:anOffset
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   877
	       atEnd:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   878
	     display:something
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   879
! !
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   880
342
7563cbf04502 added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents: 341
diff changeset
   881
!DragAndDropManager methodsFor:'dragging - generic'!
7563cbf04502 added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents: 341
diff changeset
   882
348
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   883
startGenericDrag:aTwoArgDragBlock in:aView at:p atEnd:aFourArgEndBlock
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   884
    "start a generic (caller-provided drag);
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   885
     Here, an inverting drag is initiated (i.e. the drawing is undone
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   886
     by inverting again). See startOpaqueDrag for another variant.
348
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   887
     the dragBlock, aTwoArgDragBlock will be called with two args
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   888
     aPoint and a drawingGC, to perform the drawing at some dragPoint.
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   889
     The drag starts in aView at point p.
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   890
     When finished, the endAction is called with four args:
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   891
     the targetView, the targetViews windowID (useful, if its an alien view),
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   892
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   893
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   894
    ^ self startOpaqueDrag:aTwoArgDragBlock
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   895
		    offset:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   896
		    extent:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   897
			in:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   898
			at:nil
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   899
		     atEnd:aFourArgEndBlock
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   900
!
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   901
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   902
startOpaqueDrag:aDragBlock offset:offs extent:anExtent in:aView at:aDummyPoint atEnd:aFourArgEndBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   903
    "start an opaque or generic opaque (caller-provided drag);
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   904
     opaque drag means, that the drawing cannot be undone by two inverting
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   905
     draws, but instead, the area under the dragged object must be saved
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   906
     and restored. The areas size to be saved/restored is passed in anExtent.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   907
     the dragBlock, aDragBlock will be called with up to three args aPoint, a
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   908
     drawingGC and the display objects, to perform the drawing at some dragPoint.
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   909
     The drag starts in aView at point p.
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   910
     When finished, the endAction is called with four args:
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   911
     the targetView, the targetViews windowID (useful, if its an alien view),
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   912
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   913
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   914
    |handler numArgs dragBlock dobjs|
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
   915
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   916
    dragOffset := offs ? (Point x:0 y:0).
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   917
    numArgs    := aDragBlock numArgs.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   918
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   919
    numArgs == 3 ifTrue:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   920
        dobjs := self dropObjects.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   921
        dragBlock := [:p :v| aDragBlock value:p value:v value:dobjs ]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   922
    ] ifFalse:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   923
        numArgs == 1 ifTrue:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   924
            dragBlock := [:p :v| aDragBlock value:p ]
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   925
        ] ifFalse:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   926
            dragBlock := aDragBlock
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   927
        ]
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   928
    ].
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   929
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   930
    anExtent isNil ifTrue:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   931
        handler := DragHandler startGenericDrag:dragBlock.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   932
    ] ifFalse:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   933
        handler := DragHandler startOpaqueDrag:dragBlock extent:anExtent offset:dragOffset.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   934
    ].
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
   935
    self doStart:handler for:aView atEnd:aFourArgEndBlock.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   936
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   937
! !
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   938
342
7563cbf04502 added genericDrag & arrowDrag
Claus Gittinger <cg@exept.de>
parents: 341
diff changeset
   939
!DragAndDropManager methodsFor:'dragging - lines'!
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   940
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   941
startArrowDragIn:aView at:aStartPoint atEnd:aFourArgEndBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   942
    "start a line-drag of an arrow-line.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   943
     The drag starts in aView at point aStartPoint.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   944
     When finished, the endAction is called with four args:
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   945
     the targetView, the targetViews windowID (useful, if its an alien view),
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   946
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   947
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   948
    |p|
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   949
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   950
    p := self translatePointToScreen:aStartPoint from:aView.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
   951
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   952
    self doStart:(DragHandler startArrowDragAt:p)
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   953
	     for:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   954
	   atEnd:aFourArgEndBlock
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   955
!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   956
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   957
startLineDragIn:aView at:aStartPoint atEnd:aFourArgEndBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   958
    "start a line-drag of a normal line.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   959
     The drag starts in aView at point aStartPoint.
348
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   960
     When finished, the endAction is called with four args:
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   961
     the targetView, the targetViews windowID (useful, if its an alien view),
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   962
     the dropPoint in root-coordinates and the dropPoint within the targetView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   963
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   964
    |p|
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   965
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   966
    p := self translatePointToScreen:aStartPoint from:aView.
348
74f1fda9deb0 more args & comments
Claus Gittinger <cg@exept.de>
parents: 346
diff changeset
   967
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   968
    self doStart:(DragHandler startLineDragAt:p)
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   969
	     for:aView
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   970
	   atEnd:aFourArgEndBlock
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   971
! !
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   972
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   973
!DragAndDropManager methodsFor:'drawing'!
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
   974
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   975
displayObjectFor:anObject on:aDevice
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   976
    "converts an object to a display object
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   977
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   978
    |obj icon s1 s2|
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   979
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   980
    obj := (anObject respondsTo:#displayObject) ifTrue:[anObject displayObject]
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   981
					       ifFalse:[anObject].
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   982
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   983
    obj isString ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   984
	^ obj
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   985
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   986
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   987
    obj messageNotUnderstoodSignal handle:[:ex|] do:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   988
	obj := obj on:aDevice
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   989
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   990
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   991
    obj isImage ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   992
	^ obj clearMaskedPixels
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   993
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   994
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   995
    obj class == LabelAndIcon ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   996
	obj image notNil ifTrue:[obj image clearMaskedPixels].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
   997
	obj icon  notNil ifTrue:[obj icon clearMaskedPixels].
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   998
      ^ obj
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
   999
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1000
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1001
    (obj class == MultiColListEntry) ifFalse:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1002
	^ obj
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1003
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1004
    s1 := obj colAt:1.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1005
    s2 := obj colAt:2.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1006
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1007
    s1 isImage ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1008
	s2 isImage  ifTrue:[ ^ self displayObjectFor:(LabelAndIcon form:s1  image:s2) on:aDevice ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1009
	s2 isString ifTrue:[ ^ self displayObjectFor:(LabelAndIcon icon:s1 string:s2) on:aDevice ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1010
	^ (s1 on:aDevice) clearMaskedPixels
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1011
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1012
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1013
    s2 isImage ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1014
	s1 isString ifTrue:[ ^ self displayObjectFor:(LabelAndIcon icon:s2 string:s1) on:aDevice ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1015
	^ (s2 on:aDevice) clearMaskedPixels
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1016
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1017
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1018
    s1 isString ifTrue:[^ s1].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1019
    s2 isString ifTrue:[^ s2].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1020
  ^ obj
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1021
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1022
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
  1023
showDragging:items in:aView at:p
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1024
    "helper for dragging dragObjects: draw them all"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1025
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
  1026
    |offs|
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
  1027
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1028
    offs := 0.
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1029
    items do:[:item |
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
  1030
        item displayOn:aView at:p + (0@offs).
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
  1031
        offs := offs + (item heightOn:self)
397
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
  1032
    ]
7ad4e53d8f49 *** empty log message ***
ca
parents: 394
diff changeset
  1033
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1034
    "Modified: 19.4.1997 / 12:41:24 / cg"
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1035
! !
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1036
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1037
!DragAndDropManager methodsFor:'event catching'!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1038
1484
f25e9b6f8edd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
  1039
buttonMotion:buttonState x:x y:y view:aView
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1040
    "handle a button motion event
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1041
    "
1466
f6a566b26c9e Use #viewIdFromPoint: to get the drop target.
Stefan Vogel <sv@exept.de>
parents: 1430
diff changeset
  1042
    |oldPt oldTgt oldWg oldId newWg newId newTgt point cursor device isDroppable|
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1043
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1044
    device := dragView device.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1045
    point  := self translatePointToScreen:(x @ y) from:dragView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1046
    oldWg  := dropContext targetWidget.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1047
    oldId  := dropContext targetId.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1048
    oldPt  := dropContext rootPoint.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1049
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1050
    dropContext rootPoint:point.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1051
1466
f6a566b26c9e Use #viewIdFromPoint: to get the drop target.
Stefan Vogel <sv@exept.de>
parents: 1430
diff changeset
  1052
    newId := device viewIdFromPoint:point.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1053
    newWg := device viewFromId:newId.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1054
    dropContext targetWidget:newWg id:newId.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1055
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1056
    handler isInterestedInDropTarget ifFalse:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1057
        "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1058
        "/ line or arrow handler
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1059
        "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1060
        handler dragTo:point.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1061
        ^ self
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1062
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1063
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1064
    oldWg ~~ newWg ifTrue:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1065
        "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1066
        "/ widget has changed: drop target might change
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1067
        "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1068
        oldTgt := dropContext dropTarget.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1069
        newTgt := self doFindDropTargetIn:newWg at:point.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1070
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1071
        newTgt ~= oldTgt ifTrue:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1072
            "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1073
            "/ drop target changed: handler might restore the screen
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1074
            "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1075
            handler dropTargetWillChange.
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1076
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1077
            oldTgt notNil ifTrue:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1078
                "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1079
                "/ setup old context
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1080
                "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1081
                dropContext targetWidget:oldWg id:oldId.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1082
                oldTgt leave:dropContext.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1083
                dropContext targetWidget:newWg id:newId.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1084
            ].
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1085
            dropContext dropTarget:newTgt.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1086
            newTgt notNil ifTrue:[ newTgt enter:dropContext ]
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1087
        ] ifFalse:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1088
            dropContext dropTarget:newTgt
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1089
        ]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1090
    ] ifFalse:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1091
        (oldPt notNil and:[(oldPt dist:point) < 2 ]) ifTrue:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1092
            "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1093
            "/ ignore the button motion event; restore old rootPoint
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1094
            "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1095
            dropContext rootPoint:oldPt.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1096
            ^ self
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1097
        ].
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1098
        newTgt := dropContext dropTarget
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1099
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1100
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1101
    "/ update the cursor
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1102
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1103
    (isDroppable := dropContext canDrop) ifTrue:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1104
        cursor := enabledCursor
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1105
    ] ifFalse:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1106
        cursor := dropContext isAlienView ifFalse:[disabledCursor]
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1107
                                           ifTrue:[alienCursor]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1108
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1109
    dragView cursor:cursor now:true.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1110
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1111
    "/ test if droppable state changed
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1112
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1113
    canDrop == isDroppable ifFalse:[
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1114
        "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1115
        "/ droppable state changed: handler might restore the screen
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1116
        "/
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1117
        canDrop := isDroppable.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1118
        handler dropTargetWillChange
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1119
    ].
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
  1120
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1121
    newTgt notNil ifTrue:[ newTgt over:dropContext ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1122
    handler dragTo:point.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1123
!
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
  1124
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1125
buttonMultiPress:button x:x y:y view:aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1126
    "discard each buttonMultiPress event
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1127
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1128
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1129
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1130
buttonPress:button x:x y:y view:aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1131
    "discard each buttonPress event
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1132
    "
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1133
!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1134
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1135
buttonRelease:button x:x y:y view:aView
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1136
    "button released; do the drop
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1137
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1138
    ((button == 2) or:[button == #menu]) ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1139
	^ self
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1140
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1141
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1142
    "/ update the context
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1143
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1144
    self buttonMotion:button x:x y:y view:aView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1145
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1146
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1147
    "/ restore source view
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1148
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1149
    restoreBlock value.
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
  1150
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1151
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1152
    "/ at least do the drop operation
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1153
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1154
    dropAction isNil ifTrue:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1155
	dropContext doDrop
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1156
    ] ifFalse:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1157
	"/
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1158
	"/ initiator wants to do it himself, manually.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1159
	"/ Thus, no feedBack operation invoked.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1160
	"/
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1161
	dropAction value:(dropContext targetWidget)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1162
		   value:(dropContext targetId)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1163
		   value:(dropContext rootPoint)
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1164
		   value:(dropContext targetPoint).
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1165
    ]
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1166
!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1167
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1168
delegatesTo:someone
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1169
    ^false
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1170
!
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1171
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1172
handlesButtonMotion:button inView:aView
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1173
    "query from event processor: am I interested in button-events ?
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1174
     yes I am (to activate the clicked-on field)."
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1175
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1176
    ^ dragView == aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1177
!
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1178
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1179
handlesButtonMultiPress:button inView:aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1180
    "query from event processor: am I interested in button-events ?
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1181
     yes I am (to activate the clicked-on field)."
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1182
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1183
    ^ dragView == aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1184
!
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
  1185
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1186
handlesButtonPress:button inView:aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1187
    "query from event processor: am I interested in button-events ?
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1188
     yes I am (to activate the clicked-on field)."
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1189
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1190
    ^ dragView == aView
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1191
!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1192
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1193
handlesButtonRelease:button inView:aView
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1194
    "query from event processor: am I interested in button-events ?
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1195
     yes I am (to activate the clicked-on field)."
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1196
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1197
    ^ dragView == aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1198
! !
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1199
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1200
!DragAndDropManager methodsFor:'initialization'!
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1201
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1202
initialize
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1203
    super initialize.
394
0539d7b29aa7 *** empty log message ***
ca
parents: 348
diff changeset
  1204
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1205
    dragOffset     := 0 @ 0.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1206
    dropContext    := DropContext new.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1207
    alienCursor    := Cursor questionMark.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1208
    enabledCursor  := Cursor thumbsUp.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1209
    disabledCursor := Cursor thumbsDown.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1210
    canDrop        := false.
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1211
! !
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1212
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1213
!DragAndDropManager methodsFor:'private'!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1214
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1215
doDrop:aContext in:aWidget
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1216
    "old drop mechanism
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1217
    "
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1218
    |point|
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1219
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1220
    DragOriginatorQuerySignal answer:dragView do:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1221
	DragOffsetQuerySignal answer:dragOffset do:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1222
	    aContext targetWidget == aWidget ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1223
		point := aContext targetPoint
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1224
	    ] ifFalse:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1225
		point := 0@0. "/ nil.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1226
		"/
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1227
		"/ FeedBack: set the widget which handles the drop
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1228
		"/
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1229
		aContext targetWidget:aWidget id:(aWidget id).
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1230
	    ].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1231
	    aWidget drop:(aContext dropObjects) at:point
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1232
	]
609
1343bda17876 pass logical coordinates to dropAction.
Claus Gittinger <cg@exept.de>
parents: 549
diff changeset
  1233
    ].
1343bda17876 pass logical coordinates to dropAction.
Claus Gittinger <cg@exept.de>
parents: 549
diff changeset
  1234
1072
be90bc383d83 do not pas nil point to dropDestination
Claus Gittinger <cg@exept.de>
parents: 881
diff changeset
  1235
    "Modified: / 11.9.1998 / 00:53:22 / cg"
346
1612c23d9c5d pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1236
!
1612c23d9c5d pass all dropInfo to an end-action
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1237
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1238
doFindDropTargetIn:aView at:aPoint
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1239
    "get the drop target for a view and source at a point or nil
411
8b8b0128d129 *** empty log message ***
ca
parents: 401
diff changeset
  1240
    "
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1241
    |target view dobj|
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1242
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1243
    aView isNil ifTrue:[ ^ nil ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1244
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1245
    "/ new mechanism to get a dropTarget
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1246
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1247
    aView messageNotUnderstoodSignal handle:[:ex|
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1248
	target := nil.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1249
    ] do:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1250
	target := aView dropTarget
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1251
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1252
    target notNil ifTrue:[ ^ target ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1253
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1254
    "/ old mechanism to get a dropTarget
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1255
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1256
    view := aView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1257
    dobj := dropContext dropObjects.
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1258
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1259
    DragOriginatorQuerySignal answer:dragView do:[
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1260
	DragOffsetQuerySignal answer:dragOffset do:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1261
	    [   (view canDrop:dobj) ifTrue:[
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1262
		    ^ DropTarget receiver:self argument:view dropSelector:#doDrop:in:.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1263
		].
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1264
		(view := view superView) notNil
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1265
1166
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1266
	    ] whileTrue.
4892defb2ab6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1162
diff changeset
  1267
	]
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1268
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1269
    ^ nil
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1270
!
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1271
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1272
doStart:aHandler for:aView atEnd:aFourArgEndBlock
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1273
    "setup a handler and a restore block
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1274
    "
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1275
    |savedCursor savedDelegate prevGrab sensor p|
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1276
1487
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1277
    (ActiveDragAndDropManagers at:aView device ifAbsent:nil) notNil ifTrue:[
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1278
        self error:'oops - two dnd managers active'.
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1279
        ^ self.
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1280
    ].
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1281
    ActiveDragAndDropManagers at:aView device put:self.
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1282
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1283
    dropContext sourceWidget:aView.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1284
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1285
    dragOffset  isNil ifTrue:[ dragOffset  := 0 @ 0 ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1286
    alienCursor isNil ifTrue:[ alienCursor := disabledCursor ].
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1287
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1288
    dragView   := aView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1289
    dropAction := aFourArgEndBlock.
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1290
    savedCursor     := aView cursor.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1291
    savedDelegate   := aView delegate.
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1292
    handler    := aHandler.
609
1343bda17876 pass logical coordinates to dropAction.
Claus Gittinger <cg@exept.de>
parents: 549
diff changeset
  1293
1162
0539b64679ce set DragHandler in the DropContext
Claus Gittinger <cg@exept.de>
parents: 1072
diff changeset
  1294
    dropContext dragHandler:aHandler.
0539b64679ce set DragHandler in the DropContext
Claus Gittinger <cg@exept.de>
parents: 1072
diff changeset
  1295
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1296
    restoreBlock := [
1487
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1297
        ActiveDragAndDropManagers removeKey:aView device.
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1298
        aHandler postDragging.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1299
        aView delegate:savedDelegate.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1300
        aView cursor:savedCursor now:true.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1301
        prevGrab notNil ifTrue:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1302
            aView forceUngrabPointer.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1303
            prevGrab grabPointer.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1304
        ] ifFalse:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1305
            aView ungrabPointer.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1306
        ].
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1307
    ].
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1308
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1309
    aHandler preDraggingIn:aView.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1310
    aView delegate:self.
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1311
    prevGrab := aView device activePointerGrab.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1312
    aView grabPointer.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1313
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1314
    "/ must wait for all pending motion events to arrive, and ignore them
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1315
    (sensor := aView sensor) notNil ifTrue:[
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1316
        aView device sync.        
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1317
        sensor flushMotionEventsFor:nil.
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1318
    ].
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1319
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1320
    "/ start with a first draw at the current mouse position
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1321
    p := aView device pointerPosition.
1430
572d486a52b8 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 1420
diff changeset
  1322
    p := aView device translatePoint:p from:(aView device rootWindowId) to:(aView id).
1289
0f7688ddff2c grabbing changes to restore grab,
ca
parents: 1166
diff changeset
  1323
    self buttonMotion:1 x:p x y:p y view:aView
1487
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1324
!
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1325
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1326
saveDraw:aBlock
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1327
    handler postDragging.
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1328
    aBlock value.
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1329
    handler rereadSaveArea.
6cefff982779 *** empty log message ***
martin
parents: 1484
diff changeset
  1330
    handler restoreFromSaveArea.
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1331
! !
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1332
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1333
!DragAndDropManager methodsFor:'translation'!
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1334
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1335
translatePointToScreen:aPoint from:aView
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1336
    "translate a point to screen
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1337
    "
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1338
    |device trans point offset|
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1339
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1340
    device := aView device.
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1341
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1342
    "/ get device coordinates
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1343
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1344
    (trans := aView transformation) notNil ifTrue:[
1430
572d486a52b8 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 1420
diff changeset
  1345
        point := trans applyTo:aPoint
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1346
    ] ifFalse:[
1430
572d486a52b8 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 1420
diff changeset
  1347
        point := aPoint
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1348
    ].
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1349
    "/
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1350
    "/ translate to screen
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1351
    "/
1430
572d486a52b8 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 1420
diff changeset
  1352
    offset := device translatePoint:0@0 from:(aView id) to:(device rootWindowId).
874
0730cf44f593 support of Drop -Source -Target and Context
ca
parents: 861
diff changeset
  1353
  ^ offset + point
548
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1354
! !
1a81d6be65b4 added comments & docu, examples.
Claus Gittinger <cg@exept.de>
parents: 515
diff changeset
  1355
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1356
!DragAndDropManager class methodsFor:'documentation'!
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1357
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1358
version
1490
b2e1f907060c care for cursor when drawing dragObjects (avoid overdrawing the cursor)
Claus Gittinger <cg@exept.de>
parents: 1487
diff changeset
  1359
    ^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.31 2001-08-15 12:52:20 cg Exp $'
341
5afe98e6185b intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1360
! !
628
22085aaf983c DragOriginatorQuerySignal added
ca
parents: 609
diff changeset
  1361
DragAndDropManager initialize!