;;; timer.el --- run a function with args at some time in future
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
;; This file is part of GNU Emacs.
(defsubst timer--check (timer)
(or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer))))
+(defun timer--time-setter (timer time)
+ (timer--check timer)
+ (setf (timer--high-seconds timer) (pop time))
+ (let ((low time) (usecs 0) (psecs 0))
+ (when (consp time)
+ (setq low (pop time))
+ (when time
+ (setq usecs (pop time))
+ (when time
+ (setq psecs (car time)))))
+ (setf (timer--low-seconds timer) low)
+ (setf (timer--usecs timer) usecs)
+ (setf (timer--psecs timer) psecs)
+ time))
+
;; Pseudo field `time'.
(defun timer--time (timer)
+ (declare (gv-setter timer--time-setter))
(list (timer--high-seconds timer)
(timer--low-seconds timer)
(timer--usecs timer)
(timer--psecs timer)))
-(gv-define-simple-setter timer--time
- (lambda (timer time)
- (timer--check timer)
- (setf (timer--high-seconds timer) (pop time))
- (let ((low time) (usecs 0) (psecs 0))
- (if (consp time)
- (progn
- (setq low (pop time))
- (if time
- (progn
- (setq usecs (pop time))
- (if time
- (setq psecs (car time)))))))
- (setf (timer--low-seconds timer) low)
- (setf (timer--usecs timer) usecs)
- (setf (timer--psecs timer) psecs))))
-
-
(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'.
"Advance TIME by SECS seconds and optionally USECS microseconds
and PSECS picoseconds. SECS may be either an integer or a
floating point number."
- (let ((delta (if (floatp secs)
- (seconds-to-time secs)
- (list (floor secs 65536) (mod secs 65536)))))
+ (let ((delta secs))
(if (or usecs psecs)
(setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0)))))
(time-add time delta)))
(cell
;; Delete from queue. Record the cons cell that was used.
(cancel-timer-internal timer)))
- ;; Re-schedule if requested.
- (if (timer--repeat-delay timer)
- (if (timer--idle-delay timer)
- (timer-activate-when-idle timer nil cell)
- (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))
- (timer--repeat-delay timer))))
- (if (> repeats timer-max-repeats)
- (timer-inc-time timer (* (timer--repeat-delay timer)
- repeats)))))
- ;; Place it back on the timer-list before running
- ;; timer--function, so it can cancel-timer itself.
- (timer-activate timer t cell)
- (setq retrigger t)))
- ;; Run handler.
- (condition-case-unless-debug err
- ;; Timer functions should not change the current buffer.
- ;; If they do, all kinds of nasty surprises can happen,
- ;; and it can be hellish to track down their source.
- (save-current-buffer
- (apply (timer--function timer) (timer--args timer)))
- (error (message "Error running timer%s: %S"
- (if (symbolp (timer--function timer))
- (format " `%s'" (timer--function timer)) "")
- err)))
- (when (and retrigger
- ;; If the timer's been canceled, don't "retrigger" it
- ;; since it might still be in the copy of timer-list kept
- ;; by keyboard.c:timer_check (bug#14156).
- (memq timer timer-list))
- (setf (timer--triggered timer) nil)))))
+ ;; If `cell' is nil, it means the timer was already canceled, so we
+ ;; shouldn't be running it at all. This can happen for example with the
+ ;; following scenario (bug#17392):
+ ;; - we run timers, starting with A (and remembering the rest as (B C)).
+ ;; - A runs and a does a sit-for.
+ ;; - during sit-for we run timer D which cancels timer B.
+ ;; - timer A finally finishes, so we move on to timers B and C.
+ (when cell
+ ;; Re-schedule if requested.
+ (if (timer--repeat-delay timer)
+ (if (timer--idle-delay timer)
+ (timer-activate-when-idle timer nil cell)
+ (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 nil)))
+ (let ((repeats (/ (timer-until timer nil)
+ (timer--repeat-delay timer))))
+ (if (> repeats timer-max-repeats)
+ (timer-inc-time timer (* (timer--repeat-delay timer)
+ repeats)))))
+ ;; Place it back on the timer-list before running
+ ;; timer--function, so it can cancel-timer itself.
+ (timer-activate timer t cell)
+ (setq retrigger t)))
+ ;; Run handler.
+ (condition-case-unless-debug err
+ ;; Timer functions should not change the current buffer.
+ ;; If they do, all kinds of nasty surprises can happen,
+ ;; and it can be hellish to track down their source.
+ (save-current-buffer
+ (apply (timer--function timer) (timer--args timer)))
+ (error (message "Error running timer%s: %S"
+ (if (symbolp (timer--function timer))
+ (format " `%s'" (timer--function timer)) "")
+ err)))
+ (when (and retrigger
+ ;; If the timer's been canceled, don't "retrigger" it
+ ;; since it might still be in the copy of timer-list kept
+ ;; by keyboard.c:timer_check (bug#14156).
+ (memq timer timer-list))
+ (setf (timer--triggered timer) nil))))))
;; This function is incompatible with the one in levents.el.
(defun timeout-event-p (event)
;; Handle numbers as relative times in seconds.
(if (numberp time)
- (setq time (timer-relative-time (current-time) time)))
+ (setq time (timer-relative-time nil time)))
;; Handle relative times like "2 hours 35 minutes"
(if (stringp time)
(let ((secs (timer-duration time)))
(if secs
- (setq time (timer-relative-time (current-time) secs)))))
+ (setq time (timer-relative-time nil secs)))))
;; Handle "11:23pm" and the like. Interpret it as meaning today
;; which admittedly is rather stupid if we have passed that time
when it exits, to make these timers start counting again."
(mapcar (lambda (timer)
(cancel-timer timer)
- (list timer (time-subtract (timer--time timer) (current-time))))
+ (list timer (time-subtract (timer--time timer) nil)))
with-timeout-timers))
(defun with-timeout-unsuspend (timer-spec-list)
(dolist (elt timer-spec-list)
(let ((timer (car elt))
(delay (cadr elt)))
- (timer-set-time timer (time-add (current-time) delay))
+ (timer-set-time timer (time-add nil delay))
(timer-activate timer))))
(defun y-or-n-p-with-timeout (prompt seconds default-value)