(timer): Define as a defstruct, so we can name the fields, to make the

code clearer.  Rewrite all `aset' and `aref' using the defined accessors.
(timer--time): New pseudo-field.
(timer-set-time, timer-set-idle-time, timer-inc-time)
(timer-set-time-with-usecs, with-timeout-suspend): Use it.
(timer--time-less-p): New function.
(timer--activate): New function, extracted from timer-activate.
(timer-activate-when-idle, timer-activate): Use it.
(cancel-function-timers): Use dolist.

2 files changed, 109 insertions, 120 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 368f6034854..d7ef6135529 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,20 @@
+2008-04-03  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/timer.el (timer): Define as a defstruct, so we can
+        name the fields, to make the code clearer.
+        Rewrite all `aset' and `aref' using the defined accessors.
+        (timer--time): New pseudo-field.
+        (timer-set-time, timer-set-idle-time, timer-inc-time)
+        (timer-set-time-with-usecs, with-timeout-suspend): Use it.
+        (timer--time-less-p): New function.
+        (timer--activate): New function, extracted from timer-activate.
+        (timer-activate-when-idle, timer-activate): Use it.
+        (cancel-function-timers): Use dolist.
+
 2008-04-03  Glenn Morris  <rgm@gnu.org>
 
-        * add-log.el (c-beginning-of-defun, c-end-of-defun): Remove
-        declarations; no longer used.
+        * add-log.el (c-beginning-of-defun, c-end-of-defun):
+        Remove declarations; no longer used.
         (c-cpp-define-name, c-defun-name): Declare as functions.
 
         * calendar/diary-lib.el (diary-mail-addr): Use bound-and-true-p.
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 6ca68824d95..36f3a0ecf9a 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -35,29 +35,45 @@
 ;; triggered-p is nil if the timer is active (waiting to be triggered),
 ;;  t if it is inactive ("already triggered", in theory)
 
-(defun timer-create ()
-  "Create a timer object which can be passed to `timer-activate'."
-  (let ((timer (make-vector 8 nil)))
-    (aset timer 0 t)
-    timer))
+(eval-when-compile (require 'cl))
+
+(defstruct (timer
+            (:constructor nil)
+            (:copier nil)
+            (:constructor timer-create ())
+            (:type vector)
+            (:conc-name timer--))
+  (triggered t)
+  high-seconds low-seconds usecs repeat-delay function args idle-delay)
 
 (defun timerp (object)
   "Return t if OBJECT is a timer."
   (and (vectorp object) (= (length object) 8)))
 
+;; Pseudo field `time'.
+(defun timer--time (timer)
+  (list (timer--high-seconds timer)
+        (timer--low-seconds timer)
+        (timer--usecs timer)))
+
+(defsetf timer--time
+  (lambda (timer time)
+    (or (timerp timer) (error "Invalid timer"))
+    (setf (timer--high-seconds timer) (pop time))
+    (setf (timer--low-seconds timer)
+          (if (consp time) (car time) time))
+    (setf (timer--usecs timer) (or (and (consp time) (consp (cdr time))
+                                        (cadr time))
+                                   0))))
+
+
 (defun timer-set-time (timer time &optional delta)
   "Set the trigger time of TIMER to TIME.
 TIME must be in the internal format returned by, e.g., `current-time'.
 If optional third argument DELTA is a positive number, make the timer
 fire repeatedly that many seconds apart."
-  (or (timerp timer)
-      (error "Invalid timer"))
-  (aset timer 1 (car time))
-  (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
-  (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time)))
-                         (nth 2 time))
-                    0))
-  (aset timer 4 (and (numberp delta) (> delta 0) delta))
+  (setf (timer--time timer) time)
+  (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
   timer)
 
 (defun timer-set-idle-time (timer secs &optional repeat)
@@ -66,19 +82,11 @@ SECS may be an integer, floating point number, or the internal
 time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
 If optional third argument REPEAT is non-nil, make the timer
 fire each time Emacs is idle for that many seconds."
-  (or (timerp timer)
-      (error "Invalid timer"))
   (if (consp secs)
-      (progn (aset timer 1 (car secs))
-             (aset timer 2 (if (consp (cdr secs)) (car (cdr secs)) (cdr secs)))
-             (aset timer 3 (or (and (consp (cdr secs)) (consp (cdr (cdr secs)))
-                                    (nth 2 secs))
-                               0)))
-    (aset timer 1 0)
-    (aset timer 2 0)
-    (aset timer 3 0)
+      (setf (timer--time timer) secs)
+    (setf (timer--time timer) '(0 0 0))
     (timer-inc-time timer secs))
-  (aset timer 4 repeat)
+  (setf (timer--repeat-delay timer) repeat)
   timer)
 
 (defun timer-next-integral-multiple-of-time (time secs)
@@ -115,6 +123,7 @@ of SECS seconds since the epoch.  SECS may be a fraction."
 (defun timer-relative-time (time secs &optional usecs)
   "Advance TIME by SECS seconds and optionally USECS microseconds.
 SECS may be either an integer or a floating point number."
+  ;; FIXME: we should just use (time-add time (list 0 secs usecs))
   (let ((high (car time))
         (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
         (micro (if (numberp (car-safe (cdr-safe (cdr time))))
@@ -136,16 +145,22 @@ SECS may be either an integer or a floating point number."
 
     (list high low (and (/= micro 0) micro))))
 
+(defun timer--time-less-p (t1 t2)
+  "Say whether time value T1 is less than time value T2."
+  ;; FIXME just use time-less-p.
+  (destructuring-bind (high1 low1 micro1) (timer--time t1)
+    (destructuring-bind (high2 low2 micro2) (timer--time t2)
+      (or (< high1 high2)
+          (and (= high1 high2)
+               (or (< low1 low2)
+                   (and (= low1 low2)
+                        (< micro1 micro2))))))))
+
 (defun timer-inc-time (timer secs &optional usecs)
   "Increment the time set in TIMER by SECS seconds and USECS microseconds.
 SECS may be a fraction.  If USECS is omitted, that means it is zero."
-  (let ((time (timer-relative-time
-               (list (aref timer 1) (aref timer 2) (aref timer 3))
-               secs
-               usecs)))
-    (aset timer 1 (nth 0 time))
-    (aset timer 2 (nth 1 time))
-    (aset timer 3 (or (nth 2 time) 0))))
+  (setf (timer--time timer)
+        (timer-relative-time (timer--time timer) secs usecs)))
 
 (defun timer-set-time-with-usecs (timer time usecs &optional delta)
   "Set the trigger time of TIMER to TIME plus USECS.
@@ -153,12 +168,9 @@ TIME must be in the internal format returned by, e.g., `current-time'.
 The microsecond count from TIME is ignored, and USECS is used instead.
 If optional fourth argument DELTA is a positive number, make the timer
 fire repeatedly that many seconds apart."
-  (or (timerp timer)
-      (error "Invalid timer"))
-  (aset timer 1 (nth 0 time))
-  (aset timer 2 (nth 1 time))
-  (aset timer 3 usecs)
-  (aset timer 4 (and (numberp delta) (> delta 0) delta))
+  (setf (timer--time timer) time)
+  (setf (timer--usecs timer) usecs)
+  (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
   timer)
 (make-obsolete 'timer-set-time-with-usecs
                "use `timer-set-time' and `timer-inc-time' instead."
@@ -168,34 +180,20 @@ fire repeatedly that many seconds apart."
   "Make TIMER call FUNCTION with optional ARGS when triggering."
   (or (timerp timer)
       (error "Invalid timer"))
-  (aset timer 5 function)
-  (aset timer 6 args)
+  (setf (timer--function timer) function)
+  (setf (timer--args timer) args)
   timer)
 
-(defun timer-activate (timer &optional triggered-p reuse-cell)
-  "Put TIMER on the list of active timers.
-
-If TRIGGERED-P is t, that means to make the timer inactive
-\(put it on the list, but mark it as already triggered).
-To remove from the list, use `cancel-timer'.
-
-REUSE-CELL, if non-nil, is a cons cell to reuse instead
-of allocating a new one."
+(defun timer--activate (timer &optional triggered-p reuse-cell idle)
   (if (and (timerp timer)
-           (integerp (aref timer 1))
-           (integerp (aref timer 2))
-           (integerp (aref timer 3))
-           (aref timer 5))
-      (let ((timers timer-list)
+           (integerp (timer--high-seconds timer))
+           (integerp (timer--low-seconds timer))
+           (integerp (timer--usecs timer))
+           (timer--function timer))
+      (let ((timers (if idle timer-idle-list timer-list))
             last)
         ;; Skip all timers to trigger before the new one.
-        (while (and timers
-                    (or (> (aref timer 1) (aref (car timers) 1))
-                        (and (= (aref timer 1) (aref (car timers) 1))
-                             (> (aref timer 2) (aref (car timers) 2)))
-                        (and (= (aref timer 1) (aref (car timers) 1))
-                             (= (aref timer 2) (aref (car timers) 2))
-                             (> (aref timer 3) (aref (car timers) 3)))))
+        (while (and timers (timer--time-less-p (car timers) timer))
           (setq last timers
                 timers (cdr timers)))
         (if reuse-cell
@@ -206,12 +204,25 @@ of allocating a new one."
         ;; Insert new timer after last which possibly means in front of queue.
         (if last
             (setcdr last reuse-cell)
-          (setq timer-list reuse-cell))
-        (aset timer 0 triggered-p)
-        (aset timer 7 nil)
+          (if idle
+              (setq timer-idle-list reuse-cell)
+            (setq timer-list reuse-cell)))
+        (setf (timer--triggered timer) triggered-p)
+        (setf (timer--idle-delay timer) idle)
         nil)
     (error "Invalid or uninitialized timer")))
 
+(defun timer-activate (timer &optional triggered-p reuse-cell idle)
+  "Put TIMER on the list of active timers.
+
+If TRIGGERED-P is t, that means to make the timer inactive
+\(put it on the list, but mark it as already triggered).
+To remove from the list, use `cancel-timer'.
+
+REUSE-CELL, if non-nil, is a cons cell to reuse instead
+of allocating a new one."
+  (timer--activate timer triggered-p reuse-cell nil))
+
 (defun timer-activate-when-idle (timer &optional dont-wait reuse-cell)
   "Arrange to activate TIMER whenever Emacs is next idle.
 If optional argument DONT-WAIT is non-nil, then enable the
@@ -220,36 +231,7 @@ is already idle.
 
 REUSE-CELL, if non-nil, is a cons cell to reuse instead
 of allocating a new one."
-  (if (and (timerp timer)
-           (integerp (aref timer 1))
-           (integerp (aref timer 2))
-           (integerp (aref timer 3))
-           (aref timer 5))
-      (let ((timers timer-idle-list)
-            last)
-        ;; Skip all timers to trigger before the new one.
-        (while (and timers
-                    (or (> (aref timer 1) (aref (car timers) 1))
-                        (and (= (aref timer 1) (aref (car timers) 1))
-                             (> (aref timer 2) (aref (car timers) 2)))
-                        (and (= (aref timer 1) (aref (car timers) 1))
-                             (= (aref timer 2) (aref (car timers) 2))
-                             (> (aref timer 3) (aref (car timers) 3)))))
-          (setq last timers
-                timers (cdr timers)))
-        (if reuse-cell
-            (progn
-              (setcar reuse-cell timer)
-              (setcdr reuse-cell timers))
-          (setq reuse-cell (cons timer timers)))
-        ;; Insert new timer after last which possibly means in front of queue.
-        (if last
-            (setcdr last reuse-cell)
-          (setq timer-idle-list reuse-cell))
-        (aset timer 0 (not dont-wait))
-        (aset timer 7 t)
-        nil)
-    (error "Invalid or uninitialized timer")))
+  (timer--activate timer (not dont-wait) reuse-cell 'idle))
 
 (defalias 'disable-timeout 'cancel-timer)
 
@@ -278,16 +260,12 @@ that was removed from the timer list."
 This affects ordinary timers such as are scheduled by `run-at-time',
 and idle timers such as are scheduled by `run-with-idle-timer'."
   (interactive "aCancel timers of function: ")
-  (let ((tail timer-list))
-    (while tail
-      (if (eq (aref (car tail) 5) function)
-          (setq timer-list (delq (car tail) timer-list)))
-      (setq tail (cdr tail))))
-  (let ((tail timer-idle-list))
-    (while tail
-      (if (eq (aref (car tail) 5) function)
-          (setq timer-idle-list (delq (car tail) timer-idle-list)))
-      (setq tail (cdr tail)))))
+  (dolist (timer timer-list)
+    (if (eq (timer--function timer) function)
+        (setq timer-list (delq timer timer-list))))
+  (dolist (timer timer-idle-list)
+    (if (eq (timer--function timer) function)
+        (setq timer-idle-list (delq timer timer-idle-list)))))
 
 ;; Record the last few events, for debugging.
 (defvar timer-event-last nil
@@ -308,8 +286,9 @@ how many will really happen.")
   "Calculate number of seconds from when TIMER will run, until TIME.
 TIMER is a timer, and stands for the time when its next repeat is scheduled.
 TIME is a time-list."
-  (let ((high (- (car time) (aref timer 1)))
-        (low (- (nth 1 time) (aref timer 2))))
+  ;; FIXME: (time-to-seconds (time-subtract (timer--time timer) time))
+  (let ((high (- (car time) (timer--high-seconds timer)))
+        (low (- (nth 1 time) (timer--low-seconds timer))))
     (+ low (* high 65536))))
 
 (defun timer-event-handler (timer)
@@ -324,29 +303,30 @@ This function is called, by name, directly by the C code."
           ;; Delete from queue.  Record the cons cell that was used.
           (setq cell (cancel-timer-internal timer))
           ;; Re-schedule if requested.
-          (if (aref timer 4)
-              (if (aref timer 7)
+          (if (timer--repeat-delay timer)
+              (if (timer--idle-delay timer)
                   (timer-activate-when-idle timer nil cell)
-                (timer-inc-time timer (aref timer 4) 0)
+                (timer-inc-time timer (timer--repeat-delay timer) 0)
                 ;; If real time has jumped forward,
                 ;; perhaps because Emacs was suspended for a long time,
                 ;; limit how many times things get repeated.
                 (if (and (numberp timer-max-repeats)
                          (< 0 (timer-until timer (current-time))))
                     (let ((repeats (/ (timer-until timer (current-time))
-                                      (aref timer 4))))
+                                      (timer--repeat-delay timer))))
                       (if (> repeats timer-max-repeats)
-                          (timer-inc-time timer (* (aref timer 4) repeats)))))
+                          (timer-inc-time timer (* (timer--repeat-delay timer)
+                                                   repeats)))))
                 (timer-activate timer t cell)
                 (setq retrigger t)))
           ;; Run handler.
           ;; We do this after rescheduling so that the handler function
           ;; can cancel its own timer successfully with cancel-timer.
           (condition-case nil
-              (apply (aref timer 5) (aref timer 6))
+              (apply (timer--function timer) (timer--args timer))
             (error nil))
           (if retrigger
-              (aset timer 0 nil)))
+              (setf (timer--triggered timer) nil)))
       (error "Bogus timer event"))))
 
 ;; This function is incompatible with the one in levents.el.
@@ -500,11 +480,7 @@ The value is a list that the debugger can pass to `with-timeout-unsuspend'
 when it exits, to make these timers start counting again."
   (mapcar (lambda (timer)
             (cancel-timer timer)
-            (list timer
-                  (time-subtract
-                   ;; The time that this timer will go off.
-                   (list (aref timer 1) (aref timer 2) (aref timer 3))
-                   (current-time))))
+            (list timer (time-subtract (timer--time timer) (current-time))))
           with-timeout-timers))
 
 (defun with-timeout-unsuspend (timer-spec-list)
@@ -565,5 +541,5 @@ If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
 
 (provide 'timer)
 
-;;; arch-tag: b1a9237b-7787-4382-9e46-8f2c3b3273e0
+;; arch-tag: b1a9237b-7787-4382-9e46-8f2c3b3273e0
 ;;; timer.el ends here