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

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Sat Jun 28 16:08:28 2008
New Revision: 150

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-info.lisp
   clfswm/src/config.lisp
   clfswm/src/xlib-util.lisp
Log:
Compress motion events in event loop

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Jun 28 16:08:28 2008
@@ -1,3 +1,15 @@
+2008-06-28  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/xlib-util.lisp (move-window, resize-window): Compress motion
+	events.
+
+	* src/clfswm.lisp (handle-motion-notify): Compress motion events.
+
+	* src/clfswm-second-mode.lisp (sm-handle-motion-notify): Compress
+	motion events.
+
+	* src/clfswm-info.lisp (info-mode): Compress motion events.
+
 2008-06-21  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (show-all-children): Compute geometry

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sat Jun 28 16:08:28 2008
@@ -7,10 +7,6 @@
 ===============
 Should handle these soon.
 
-- Raise Order when tile space layout
-
-- Use conpressed motion events for clisp. [Philippe]
-
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
 
 - A Gimp layout example (a main window and all others on the left) [Philippe]

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Sat Jun 28 16:08:28 2008
@@ -212,8 +212,7 @@
 		 (funcall-key-from-code *info-keys* code state info))
 	       (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
 		 (declare (ignore event-slots))
-		 (unless (xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
-			   (:motion-notify () t))
+		 (unless (compress-motion-notify)
 		   (funcall-button-from-code *info-mouse* 'motion 0 window root-x root-y *fun-press* (list info))))
 	       (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
 		 (declare (ignore event-slots))

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Sat Jun 28 16:08:28 2008
@@ -32,7 +32,7 @@
 
 
 ;;; CONFIG - Compress motion notify ?
-(defparameter *have-to-compress-notify* nil
+(defparameter *have-to-compress-notify* t
   "This variable may be useful to speed up some slow version of CLX.
 It is particulary useful with CLISP/MIT-CLX.")
   

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Sat Jun 28 16:08:28 2008
@@ -490,10 +490,11 @@
 	(pointer-grabbed-p (xgrab-pointer-p)))
     (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
 	       (declare (ignore event-slots))
-	       (setf (xlib:drawable-x window) (+ root-x dx)
-		     (xlib:drawable-y window) (+ root-y dy))
-	       (when additional-fn
-	       	 (apply additional-fn additional-arg)))
+	       (unless (compress-motion-notify)
+		 (setf (xlib:drawable-x window) (+ root-x dx)
+		       (xlib:drawable-y window) (+ root-y dy))
+		 (when additional-fn
+		   (apply additional-fn additional-arg))))
 	     (handle-event (&rest event-slots &key event-key &allow-other-keys)
 	       (case event-key
 		 (:motion-notify (apply #'motion-notify event-slots))
@@ -532,10 +533,11 @@
 	 (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) most-positive-fixnum)))
     (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
 	       (declare (ignore event-slots))
-	       (setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x orig-x)) 10 min-width) max-width)
-		     (xlib:drawable-height window) (min (max (+ orig-height (- root-y orig-y)) 10 min-height) max-height))
-	       (when additional-fn
-	       	 (apply additional-fn additional-arg)))
+	       (unless (compress-motion-notify)
+		 (setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x orig-x)) 10 min-width) max-width)
+		       (xlib:drawable-height window) (min (max (+ orig-height (- root-y orig-y)) 10 min-height) max-height))
+		 (when additional-fn
+		   (apply additional-fn additional-arg))))
 	     (handle-event (&rest event-slots &key event-key &allow-other-keys)
 	       (case event-key
 		 (:motion-notify (apply #'motion-notify event-slots))