[graphic-forms-cvs] r122 - trunk/src/uitoolkit/widgets

[junrue at common-lisp.net]

Author: junrue
Date: Sun May  7 19:30:01 2006
New Revision: 122

Modified:
   trunk/src/uitoolkit/widgets/event.lisp
   trunk/src/uitoolkit/widgets/timer.lisp
Log:
timer initial-delay bug fix

Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp	(original)
+++ trunk/src/uitoolkit/widgets/event.lisp	Sun May  7 19:30:01 2006
@@ -412,11 +412,17 @@
          (timer (get-timer tc wparam)))
     (if (null timer)
       (gfs::kill-timer hwnd wparam)
-      (progn
-        (if (<= (delay-of timer) 0)
-          (enable timer nil)
-          (reset-timer-to-delay timer (delay-of timer)))
-        (event-timer (dispatcher timer) timer (event-time tc)))))
+      (cond
+        ((<= (delay-of timer) 0)
+          (event-timer (dispatcher timer) timer (event-time tc))
+          (gfs:dispose timer))
+        ((/= (delay-of timer) (initial-delay-of timer))
+          (let ((delay (reset-timer-to-delay timer (delay-of timer))))
+            (setf (slot-value timer 'delay) delay)
+            (setf (slot-value timer 'initial-delay) delay))
+          (event-timer (dispatcher timer) timer (event-time tc)))
+        (t
+          (event-timer (dispatcher timer) timer (event-time tc))))))
   0)
 
 ;;;

Modified: trunk/src/uitoolkit/widgets/timer.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/timer.lisp	(original)
+++ trunk/src/uitoolkit/widgets/timer.lisp	Sun May  7 19:30:01 2006
@@ -57,8 +57,6 @@
   (values init-delay delay))
 
 (defun reset-timer-to-delay (timer delay)
-  (if (and (> (id-of timer) 0) (= (delay-of timer) delay))
-    (return-from reset-timer-to-delay nil))
   (multiple-value-bind (init-delay clamped)
       (clamp-delay-values 0 delay)
     (declare (ignore init-delay))
@@ -79,7 +77,9 @@
   (setf (slot-value self 'delay) (reset-timer-to-delay self value)))
 
 (defmethod gfs:dispose ((self timer))
-  (enable self nil))
+  (let ((tc (thread-context)))
+    (remove-timer tc self)
+    (gfs::kill-timer (utility-hwnd tc) (id-of self))))
 
 (defmethod initialize-instance :after ((self timer) &key)
   (if (null (delay-of self))
@@ -102,7 +102,7 @@
         (if (> init-delay 0)
           (reset-timer-to-delay self init-delay)
           (setf (delay-of self) (delay-of self)))))
-    (remove-timer (thread-context) self))) ;; kill-timer will be called on the next tick
+    (gfs:dispose self)))
 
 (defmethod enabled-p ((self timer))
   (get-timer (thread-context) (id-of self)))