sawfish r4299 - in trunk: . lisp/sawfish/wm

[chrisb svn gnome org]

Author: chrisb
Date: Tue Nov 18 21:00:51 2008
New Revision: 4299
URL: http://svn.gnome.org/viewvc/sawfish?rev=4299&view=rev

Log:
Added Animated Viewport Scrolling [Fernando Carmona Varo] 


Modified:
   trunk/ChangeLog
   trunk/lisp/sawfish/wm/viewport.jl

Modified: trunk/lisp/sawfish/wm/viewport.jl
==============================================================================
--- trunk/lisp/sawfish/wm/viewport.jl	(original)
+++ trunk/lisp/sawfish/wm/viewport.jl	Tue Nov 18 21:00:51 2008
@@ -56,6 +56,12 @@
   (defvar uniconify-to-current-viewport t
     "Windows uniconify to the current viewport.")
 
+  (defcustom scroll-viewport-steps 1
+    "Number of steps in which to scroll between viewports (less steps = faster scrolling)."
+    :group workspace
+    :type number
+    :range (1 . 50))
+
 
 ;;; raw viewport handling
 
@@ -89,8 +95,20 @@
 	      (t (loop (cdr rest) (cons (car rest) inside) outside))))
 
       (setq viewport-x-offset x)
-      (setq viewport-y-offset y)
-      (call-hook 'viewport-moved-hook)))
+      (setq viewport-y-offset y)))
+
+  (define (set-viewport x y)
+    "Scroll viewport view by incrementing the coordinates of the x,y position.
+The scrolling makes a number of increments equal to `scroll-viewport-steps'."
+    (unless (= scroll-viewport-steps 1) ; fast skip if scroll is unwanted
+      (let* ((xstep (quotient (- x viewport-x-offset) scroll-viewport-steps))
+             (ystep (quotient (- y viewport-y-offset) scroll-viewport-steps))
+             (step-count (if (= xstep ystep 0) 0 scroll-viewport-steps)))
+        (while (> step-count 1)
+          (warp-viewport (+ viewport-x-offset xstep) (+ viewport-y-offset ystep))
+          (setq step-count (1- step-count)))))
+    (warp-viewport x y)
+    (call-hook 'viewport-moved-hook))
 
   (define (viewport-before-exiting)
     (set-screen-viewport 0 0))