From 6b10b56ccfa1cd839fe79facfab75bd2e15ab487 Mon Sep 17 00:00:00 2001
From: frese <frese>
Date: Tue, 15 Apr 2003 15:53:57 +0000
Subject: [PATCH] delayed dragging with a timer, to prevent the window from
 'hanging behind the cursor'

---
 src/drag-window.scm | 69 +++++++++++++++++++++++++++------------------
 1 file changed, 41 insertions(+), 28 deletions(-)

diff --git a/src/drag-window.scm b/src/drag-window.scm
index 70d29e5..6900d1d 100644
--- a/src/drag-window.scm
+++ b/src/drag-window.scm
@@ -107,32 +107,45 @@
 		
 		  (drag
 		   (lambda (dwin click-x click-y win-x win-y)
-		     (let ((xevent (receive event-channel)))
-		       (cond
-			((eq? (event-type button-release)
-			      (any-event-type xevent))
-			 (let ((x (+ (window-x dpy dragged-window)
-				     (- (button-event-x xevent)
-					click-x)))
-			       (y (+ (window-y dpy dragged-window)
-				     (- (button-event-y xevent)
-					click-y))))
-			   (destroy-drag-window dwin)
-			   (send channel (list 'drop x y
-					       (button-event-x-root xevent)
-					       (button-event-y-root xevent)))
-			   ;;(ungrab-server dpy)
-			   (idle)))
-
-			((motion-event? xevent)
-			 (let ((x (motion-event-x xevent))
-			       (y (motion-event-y xevent)))
-			   (move-drag-window dwin
-					     (+ win-x (- x click-x))
-					     (+ win-y (- y click-y)))
-			   (drag dwin click-x click-y win-x win-y)))
-			
-			((destroy-window-event? xevent) #t)
-			(else
-			 (drag dwin click-x click-y win-x win-y)))))))
+		     (let loop ((move-timer #f))
+		       (select
+			(cons
+			 (wrap (receive-rv event-channel)
+			       (lambda (xevent)
+				 (cond
+				  ((eq? (event-type button-release)
+					(any-event-type xevent))
+				   (let ((x (+ (window-x dpy dragged-window)
+					       (- (button-event-x xevent)
+						  click-x)))
+					 (y (+ (window-y dpy dragged-window)
+					       (- (button-event-y xevent)
+						  click-y))))
+				     (destroy-drag-window dwin)
+				     (send channel
+					   (list 'drop x y
+						 (button-event-x-root xevent)
+						 (button-event-y-root xevent)))
+				     ;;(ungrab-server dpy)
+				     (idle)))
+				  
+				  ((motion-event? xevent)
+				   (let ((x (motion-event-x xevent))
+					 (y (motion-event-y xevent)))
+				     (loop (list 0.2
+						 (+ win-x (- x click-x))
+						 (+ win-y (- y click-y))))))
+				  
+				  ((destroy-window-event? xevent) #t)
+				  (else (loop move-timer)))))
+			 (if move-timer
+			     (list
+			      (wrap (after-time-rv (first move-timer))
+				    (lambda (_)
+				      (move-drag-window dwin
+							(second move-timer)
+							(third move-timer))
+				      (loop #f))))
+			     '()))))))
+		  )
 	  (idle)))))))