[clfswm-cvs] r296 - in clfswm: . contrib/server src

[Philippe Brochard]

Author: pbrochard
Date: Tue Aug 17 17:14:53 2010
New Revision: 296

Log:
src/xlib-util.lisp (compress-motion-notify): Use a loop instead of an event-case.

Modified:
   clfswm/ChangeLog
   clfswm/contrib/server/server.lisp
   clfswm/load.lisp
   clfswm/src/xlib-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Aug 17 17:14:53 2010
@@ -1,5 +1,8 @@
 2010-08-17  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/xlib-util.lisp (compress-motion-notify): Use a loop instead
+	of an event-case.
+
 	* src/clfswm-internal.lisp (with-find-in-all-frames): New macro.
 	(find-parent-frame, find-frame-window, find-frame-by-name)
 	(find-frame-by-number): Use with-find-in-all-frames to search in

Modified: clfswm/contrib/server/server.lisp
==============================================================================
--- clfswm/contrib/server/server.lisp	(original)
+++ clfswm/contrib/server/server.lisp	Tue Aug 17 17:14:53 2010
@@ -48,6 +48,7 @@
 (defparameter *server-socket* nil)
 (defparameter *server-port* 33333)
 (defparameter *server-allowed-host* '("127.0.0.1"))
+(defparameter *server-wait-timeout* 0.001d0)
 
 (defparameter *server-connection* nil)
 
@@ -130,7 +131,7 @@
 
 (defun server-handle-new-connection ()
   (handler-case
-      (let ((stream (and *server-socket* (port:socket-accept *server-socket* :wait 0.01d0))))
+      (let ((stream (and *server-socket* (port:socket-accept *server-socket* :wait *server-wait-timeout*))))
 	(when stream
 	  (if (server-is-allowed-host stream)
 	      (multiple-value-bind (local-host local-port remote-host remote-port)

Modified: clfswm/load.lisp
==============================================================================
--- clfswm/load.lisp	(original)
+++ clfswm/load.lisp	Tue Aug 17 17:14:53 2010
@@ -29,16 +29,13 @@
 #+CMU
 (setf ext:*gc-verbose* nil)
 
-#+CMU
-(require :clx)
-
 #+SBCL
 (require :asdf)
 
 #+SBCL
 (require :sb-posix)
 
-#+(or SBCL ECL)
+#+(or CMU SBCL ECL)
 (require :clx)
 
 #-ASDF

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Tue Aug 17 17:14:53 2010
@@ -70,7 +70,7 @@
 	 , at body)
      ((or xlib:match-error xlib:window-error xlib:drawable-error) (c)
        (declare (ignore c)))))
-;;(dbg c ',body))))
+       ;;(dbg c ',body))))
 
 
 
@@ -757,8 +757,8 @@
 
 (defun compress-motion-notify ()
   (when *have-to-compress-notify*
-    (xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
-      (:motion-notify () t))))
+    (loop while (xlib:event-cond (*display* :timeout 0)
+		  (:motion-notify () t)))))
 
 
 (defun display-all-cursors (&optional (display-time 1))