[clfswm-cvs] r326 - in clfswm: . src

[Philippe Brochard]

Author: pbrochard
Date: Fri Sep 24 17:47:27 2010
New Revision: 326

Log:
src/clfswm-util.lisp (speed-mouse-reset, speed-mouse-left, speed-mouse-right, speed-mouse-up, speed-mouse-down, speed-mouse-undo, speed-mouse-first-history): New functions to quickly move the mouse. Implemented for the second mode.

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-second-mode.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/xlib-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri Sep 24 17:47:27 2010
@@ -1,3 +1,10 @@
+2010-09-24  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (speed-mouse-reset, speed-mouse-left)
+	(speed-mouse-right, speed-mouse-up, speed-mouse-down)
+	(speed-mouse-undo, speed-mouse-first-history): New functions to
+	quickly move the mouse. Implemented for the second mode.
+
 2010-09-16  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* contrib/clfswm: Move clfswm sources to $tmp_dir if there is no

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Fri Sep 24 17:47:27 2010
@@ -7,12 +7,6 @@
 ===============
 Should handle these soon.
 
-Nothing here yet :)
-
-- contrib/clfswm: Test if source directory is writable to compile clfswm.
-if not copy clfswm source in $XDG_CACHE_HOME/clfswm/sources and set
-$clfswm_asd_path to it then compile from here.
-
 - configure: copy contrib/clfswm in . and set default values in it.
 
 MAYBE

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Fri Sep 24 17:47:27 2010
@@ -104,6 +104,15 @@
   (define-second-key ("Left" :mod-1) 'select-previous-brother)
   (define-second-key ("Down" :mod-1) 'select-previous-level)
   (define-second-key ("Up" :mod-1) 'select-next-level)
+
+  (define-second-key ("Right") 'speed-mouse-right)
+  (define-second-key ("Left") 'speed-mouse-left)
+  (define-second-key ("Down") 'speed-mouse-down)
+  (define-second-key ("Up") 'speed-mouse-up)
+  (define-second-key ("Left" :control) 'speed-mouse-undo)
+  (define-second-key ("Up" :control) 'speed-mouse-first-history)
+  (define-second-key ("Down" :control) 'speed-mouse-reset)
+
   (define-second-key ("Tab" :mod-1) 'select-next-child)
   (define-second-key ("Tab" :mod-1 :shift) 'select-previous-child)
   (define-second-key (#\Tab :shift) 'switch-to-last-child)

Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp	(original)
+++ clfswm/src/clfswm-second-mode.lisp	Fri Sep 24 17:47:27 2010
@@ -119,7 +119,8 @@
   (no-focus)
   (ungrab-main-keys)
   (xgrab-keyboard *root*)
-  (xgrab-pointer *root* 66 67))
+  (xgrab-pointer *root* 66 67)
+  (speed-mouse-reset))  ;; PHIL here
 
 (defun sm-loop-function ()
   (raise-window *sm-window*))
@@ -150,7 +151,7 @@
 (defun leave-second-mode ()
   "Leave second mode"
   (cond (*in-second-mode*
-	 (banish-pointer)
+	 ;; (banish-pointer)  ;; PHIL here
 	 (setf *in-second-mode* nil)
 	 (throw 'exit-second-loop nil))
 	(t (setf *in-second-mode* nil)

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Fri Sep 24 17:47:27 2010
@@ -1375,3 +1375,60 @@
   "Show unmanaged windows by default. This is overriden by functions above"
   (setf *hide-unmanaged-window* nil)
   (leave-second-mode))
+
+
+;;; Speed mouse movement
+;;(let (minx miny maxx maxy history lx ly)
+;;  (labels ((middle (x1 x2)
+;;	     (round (/ (+ x1 x2) 2)))
+;;	   (reset-if-moved (x y)
+;;	     (when (or (/= x (or lx x)) (/= y (or ly y)))
+;;	       (speed-mouse-reset)))
+;;	   (add-in-history (x y)
+;;	     (push (list x y) history)))
+    (defun speed-mouse-reset ()
+      (setf minx nil miny nil maxx nil maxy nil history nil lx nil ly nil))
+    (defun speed-mouse-left ()
+      (with-x-pointer
+	(reset-if-moved x y)
+	(setf maxx x)
+	(add-in-history x y)
+	(setf lx (middle (or minx 0) maxx))
+	(xlib:warp-pointer *root* lx y)))
+    (defun speed-mouse-right ()
+      (with-x-pointer
+	(reset-if-moved x y)
+	(setf minx x)
+	(add-in-history x y)
+	(setf lx (middle minx (or maxx 1280)))
+	(xlib:warp-pointer *root* lx y)))
+    (defun speed-mouse-up ()
+      (with-x-pointer
+	(reset-if-moved x y)
+	(setf maxy y)
+	(add-in-history x y)
+	(setf ly (middle (or miny 0) maxy))
+	(xlib:warp-pointer *root* x ly)))
+    (defun speed-mouse-down ()
+      (with-x-pointer
+	(reset-if-moved x y)
+	(setf miny y)
+	(add-in-history x y)
+	(setf ly (middle miny (or maxy 800)))
+	(xlib:warp-pointer *root* x ly)))
+    (defun speed-mouse-undo ()
+      (when history
+	(let ((h (pop history)))
+	  (when h
+	    (destructuring-bind (bx by) h
+	      (setf lx bx ly by
+		    minx nil  maxx nil
+		    miny nil  maxy nil)
+	      (xlib:warp-pointer *root* lx ly))))))
+    (defun speed-mouse-first-history ()
+      (when history
+	(let ((h (first (last history))))
+	  (when h
+	    (setf lx (first h)
+		  ly (second h))
+	    (xlib:warp-pointer *root* lx ly)))))))

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Fri Sep 24 17:47:27 2010
@@ -74,7 +74,11 @@
 
 
 
-
+(defmacro with-x-pointer (&body body)
+  "Bind (x y) to mouse pointer positions"
+  `(multiple-value-bind (x y)
+       (xlib:query-pointer *root*)
+     , at body))