[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-62-gf9c2f34

[Philippe Brochard]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, test has been updated
       via  f9c2f34e12e8ff76170edc0732514dcc61362938 (commit)
      from  76075c217d62ae600da3460ef62687966d6e3fbc (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit f9c2f34e12e8ff76170edc0732514dcc61362938
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Fri Jun 8 22:23:06 2012 +0200

    src/tools.lisp (process-timers): Call get-internal-real-time only once for all times.

diff --git a/ChangeLog b/ChangeLog
index e0ffc64..d58317a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-06-08  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/tools.lisp (process-timers): Call get-internal-real-time
+	only once for all times.
+
 2012-06-07  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* contrib/toolbar.lisp (define-toolbar-hooks): Add auto-hide
diff --git a/src/package.lisp b/src/package.lisp
index b06f767..3979c96 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -76,7 +76,7 @@ It is particulary useful with CLISP/MIT-CLX.")
 (defparameter *background-image* nil)
 (defparameter *background-gc* nil)
 
-(defconfig *loop-timeout* 0.1 nil
+(defconfig *loop-timeout* 1 nil
            "Maximum time (in seconds) to wait before calling *loop-hook*")
 
 (defparameter *pixmap-buffer* nil)
diff --git a/src/tools.lisp b/src/tools.lisp
index 40af0b9..e958fb9 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -278,8 +278,8 @@ Return the result of the last hook"
   "Start the function fun at delay seconds."
   (push (list id
 	      (let ((time (+ (get-internal-real-time) (s->realtime delay))))
-		(lambda ()
-		  (when (>= (get-internal-real-time) time)
+		(lambda (current-time)
+		  (when (>= current-time time)
 		    (funcall fun)
 		    t))))
 	*timer-list*)
@@ -299,34 +299,31 @@ Return the result of the last hook"
 
 (defun process-timers ()
   "Call each timers in *timer-list* if needed"
-  (dolist (timer *timer-list*)
-    (when (funcall (second timer))
-      (setf *timer-list* (remove timer *timer-list* :test #'equal)))))
+  (let ((current-time (get-internal-real-time)))
+    (dolist (timer *timer-list*)
+      (when (funcall (second timer) current-time)
+        (setf *timer-list* (remove timer *timer-list* :test #'equal))))))
 
 (defun erase-timer (id)
   "Erase the timer identified by its id"
-  (dolist (timer *timer-list*)
-    (when (equal id (first timer))
-      (setf *timer-list* (remove timer *timer-list* :test #'equal)))))
+  (setf *timer-list* (remove id *timer-list* :test (lambda (x y)
+                                                     (equal x (first y))))))
 
 (defun timer-test-loop ()
-  (loop
-     (princ ".") (force-output)
-     (process-timers)
-     (sleep 0.5)))
-
-;;(defun plop ()
-;;  (princ 'plop)
-;;  (erase-timer :toto))
-;;
-;;(defun toto ()
-;;  (princ 'toto)
-;;  (add-timer 5 #'toto :toto))
-;;
-;;(add-timer 5 #'toto :toto)
-;;(add-timer 30 #'plop)
-;;
-;;(timer-test-loop)
+  (let ((count 0))
+    (labels ((plop ()
+               (format t "Plop-~A" count)
+               (erase-timer :toto))
+             (toto ()
+               (format t "Toto-~A" count)
+               (add-timer 3 #'toto :toto)))
+      (add-timer 3 #'toto :toto)
+      (add-timer 13 #'plop)
+      (loop
+         (princ ".") (force-output)
+         (process-timers)
+         (sleep 0.5)
+         (incf count)))))
 
 
 

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog        |    5 +++++
 src/package.lisp |    2 +-
 src/tools.lisp   |   47 ++++++++++++++++++++++-------------------------
 3 files changed, 28 insertions(+), 26 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager