From e0f0f3efb4fdedbb040968eba953d433816585bc Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 3 Apr 2008 03:43:18 +0000 Subject: [PATCH] (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. --- lisp/ChangeLog | 17 +++- lisp/emacs-lisp/timer.el | 212 +++++++++++++++++++++-------------------------- 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 + + * 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 - * 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 -- 2.11.4.GIT