support autoScroll during drag operation
authorca
Fri, 17 Oct 2003 14:49:57 +0200
changeset 1834 fe5dd53e3a80
parent 1833 531d2469999c
child 1835 d6db8466019b
support autoScroll during drag operation
DragAndDropManager.st
--- a/DragAndDropManager.st	Thu Oct 16 16:23:19 2003 +0200
+++ b/DragAndDropManager.st	Fri Oct 17 14:49:57 2003 +0200
@@ -16,7 +16,7 @@
 Object subclass:#DragAndDropManager
 	instanceVariableNames:'dropContext dragView dropAction dragOffset handler restoreBlock
 		alienCursor enabledCursor disabledCursor canDrop escapePressed
-		passiveAction'
+		passiveAction autoScrollTask'
 	classVariableNames:'DragContextQuerySignal DragOriginatorQuerySignal
 		DragOffsetQuerySignal ActiveDragAndDropManagers'
 	poolDictionaries:''
@@ -1240,6 +1240,27 @@
     ].
 !
 
+processAutoScroll
+    "process an autoScroll event
+    "
+    |targetWidget targetPoint|
+
+    self isActive ifFalse:[^ self].
+
+    dropContext isNil ifTrue:[ ^ self ].
+
+    targetWidget := dropContext targetWidget.
+    targetWidget isNil ifTrue:[ ^ self ].
+
+    targetPoint := dropContext targetPoint.
+    targetPoint isNil ifTrue:[ ^ self ].
+
+    (targetWidget dragAutoScroll: dropContext) ifFalse:[
+        ^ self
+    ].
+    self buttonMotion:256 x:(targetPoint x) y:(targetPoint y) view:targetWidget.
+!
+
 processEvent:event
     |evView|
 
@@ -1384,6 +1405,11 @@
     restoreBlock := [
         restoreBlock := nil.
 
+        autoScrollTask notNil ifTrue:[
+            autoScrollTask terminate.
+            autoScrollTask := nil.
+        ].
+
         ActiveDragAndDropManagers removeKey:device ifAbsent:nil.
         escapePressed ifFalse:[ aHandler postDragging ].
 
@@ -1397,6 +1423,26 @@
     device sync.        
     dragView sensor flushMotionEventsFor:nil.
 
+    autoScrollTask := Process for:[
+        [   |sensor|
+
+            sensor := windowGroup sensor.
+
+            [ self isActive ] whileTrue:[
+                Delay waitForSeconds:0.4.
+
+                self isActive ifTrue:[
+                    sensor pushUserEvent:#processAutoScroll for:self.
+                ].
+            ].
+        ]ensure:[
+            autoScrollTask := nil.
+        ]
+     ] priority:(Processor userSchedulingPriority).
+
+    autoScrollTask name:'Drag-AutoScroll'.
+    autoScrollTask resume.
+
     "/ start with a first draw at the current mouse position
     screenPoint := device pointerPosition.
     self buttonMotion:1 x:(screenPoint x) y:(screenPoint y) view:(device rootView).
@@ -1411,6 +1457,13 @@
     restoreBlock value.
 !
 
+isActive
+    "returns true if a drag operation is active
+    "
+    restoreBlock isNil ifTrue:[ ^ false ].
+    ^ escapePressed ~~ true
+!
+
 saveDraw:aBlock
     handler postDragging.
     aBlock value.
@@ -1425,7 +1478,7 @@
 !DragAndDropManager class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.52 2003-10-06 15:41:00 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/DragAndDropManager.st,v 1.53 2003-10-17 12:49:57 ca Exp $'
 ! !
 
 DragAndDropManager initialize!