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

Philippe Brochard pbrochard at common-lisp.net
Tue Dec 15 21:23:07 UTC 2009


Author: pbrochard
Date: Tue Dec 15 16:23:06 2009
New Revision: 272

Log:
Add a loop-hook parameter and a loop timeout.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-generic-mode.lisp
   clfswm/src/clfswm.lisp
   clfswm/src/package.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Dec 15 16:23:06 2009
@@ -1,3 +1,11 @@
+2009-12-15  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm.lisp (main-loop): Add a *loop-hook* parameter and a
+	loop timeout.
+
+	* src/clfswm-generic-mode.lisp (generic-mode): Add a loop-hook
+	parameter and a loop timeout.
+
 2009-12-05  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm.lisp (main): Add an alternate configuration filename

Modified: clfswm/src/clfswm-generic-mode.lisp
==============================================================================
--- clfswm/src/clfswm-generic-mode.lisp	(original)
+++ clfswm/src/clfswm-generic-mode.lisp	Tue Dec 15 16:23:06 2009
@@ -27,6 +27,7 @@
 
 
 (defun generic-mode (exit-tag &key enter-function loop-function leave-function
+		     (loop-hook *loop-hook*)
 		     (button-press-hook *button-press-hook*)
 		     (button-release-hook *button-release-hook*)
 		     (motion-notify-hook *motion-notify-hook*)
@@ -69,8 +70,9 @@
     (unwind-protect
 	 (catch exit-tag
 	   (loop
+	      (call-hook loop-hook)
 	      (nfuncall loop-function)
 	      (xlib:display-finish-output *display*)
-	      (xlib:process-event *display* :handler #'handler-function)
+	      (xlib:process-event *display* :handler #'handler-function :timeout *loop-timeout*)
 	      (xlib:display-finish-output *display*)))
       (nfuncall leave-function))))

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Tue Dec 15 16:23:06 2009
@@ -205,8 +205,9 @@
 (defun main-loop ()
   (loop
      (with-xlib-protect
+	 (call-hook *loop-hook*)
        (xlib:display-finish-output *display*)
-       (xlib:process-event *display* :handler #'handle-event))))
+       (xlib:process-event *display* :handler #'handle-event :timeout *loop-timeout*))))
 ;;(dbg "Main loop finish" c)))))
 
 

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Tue Dec 15 16:23:06 2009
@@ -59,6 +59,9 @@
 (defparameter *root* nil)
 (defparameter *no-focus-window* nil)
 
+(defparameter *loop-timeout* 0.1
+  "Config(): Maximum time (in seconds) to wait before calling *loop-hook*")
+
 (defparameter *pixmap-buffer* nil)
 
 (defparameter *contrib-dir* "")
@@ -166,6 +169,7 @@
 
 (defparameter *menu* (make-menu :name 'main :doc "Main menu"))
 
+
 ;;; Main mode hooks (set in clfswm.lisp)
 (defparameter *button-press-hook* nil
   "Config(Hook group):")
@@ -233,7 +237,10 @@
 
 
 (defparameter *binding-hook* nil
-  "Config(Hook group):")
+  "Config(Hook group): Hook executed when keys/buttons are bounds")
+
+(defparameter *loop-hook* nil
+  "Config(Hook group): Kook executed on each event loop")
 
 
 (defparameter *in-second-mode* nil)




More information about the clfswm-cvs mailing list