[Sawfish] On interactive viewport-drag

[Christopher Roy Bratusek <nano@xxxxxxxxxxxxx>]

Hi all,

as I saw the `drag-screen-viewport' script on Wiki today, I thought we
could add interactive VP to Sawfish (as the function as such is already in).

Now I cooked up a test-patch and wanted to hear your opinions on it.
Especially on the direction thing, I couldn't come up with something
better as what you can see in the patch.

Chris

diff --git a/lisp/sawfish/wm/edge/viewport-drag.jl b/lisp/sawfish/wm/edge/viewport-drag.jl
index 14a61e2..3dead5c 100644
--- a/lisp/sawfish/wm/edge/viewport-drag.jl
+++ b/lisp/sawfish/wm/edge/viewport-drag.jl
@@ -16,10 +16,13 @@
 
 (define-structure sawfish.wm.edge.viewport-drag
 
-    (export viewport-drag-invoke)
+    (export viewport-drag-invoke
+	    viewport-drag-interactive)
 
     (open rep
+	  rep.io.timers
           rep.system
+	  sawfish.wm.events
           sawfish.wm.misc
           sawfish.wm.custom
           sawfish.wm.commands.move-cursor
@@ -80,4 +83,62 @@
       ((left) (drag-left))
       ((top) (drag-up))
       ((right) (drag-right))
-      ((bottom) (drag-down)))))
+      ((bottom) (drag-down))))
+
+  (define old-pos)
+  (define new-pos)
+
+  (define (viewport-drag-interactive)
+    (move-cursor-center)
+    (setq old-pos (query-pointer))
+
+    (make-timer (lambda ()
+		  (setq new-pos (query-pointer))) 1)
+
+    (make-timer (lambda ()
+      (let ((old-x (car old-pos))
+	    (new-x (car new-pos))
+	    (old-y (cdr old-pos))
+	    (new-y (cdr new-pos))
+	    (moved-x) (diff-x)
+	    (moved-y) (diff-y)
+	    (drag-viewport-direction))
+
+	;; get x-direction and difference in pixels
+	(if (> old-x new-x)
+	    (progn
+	      (setq moved-x 'left)
+	      (setq diff-x (- old-x new-x)))
+	  (setq moved-x 'right)
+	  (setq diff-x (- new-x old-x)))
+
+	;; get y-direction and difference in pixels
+	(if (> old-y new-y)
+	    (progn
+	      (setq moved-y 'up)
+	      (setq diff-y (- old-y new-y)))
+	  (setq moved-y 'down)
+	  (setq diff-y (- new-y old-y)))
+
+	;; now let the b-f begin!!
+	(if (eq moved-x 'left)
+	    (if (eq moved-y 'up)
+	        ;; left and up
+	        (if (> diff-x diff-y)
+		    (setq drag-viewport-direction 'left)
+		  (setq drag-viewport-direction 'top))
+	      ;; left and down
+	      (if (> diff-x diff-y)
+		  (setq drag-viewport-direction 'left)
+		(setq drag-viewport-direction 'bottom)))
+	  (if (eq moved-y 'up)
+	      ;; right and up
+	      (if (> diff-x diff-y)
+		  (setq drag-viewport-direction 'right)
+		(setq drag-viewport-direction 'top))
+	    ;; right and down
+	    (if (> diff-x diff-y)
+	        (setq drag-viewport-direction 'right)
+	      (setq drag-viewport-direction 'bottom))))
+
+	(viewport-drag-invoke drag-viewport-direction))) 2)))