;;; 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.
;;; Code:
-;; Layout of a timer vector:
-;; [triggered-p high-seconds low-seconds usecs repeat-delay
-;; function args idle-delay psecs]
-;; triggered-p is nil if the timer is active (waiting to be triggered),
-;; t if it is inactive ("already triggered", in theory)
-
(eval-when-compile (require 'cl-lib))
(cl-defstruct (timer
- (:constructor nil)
- (:copier nil)
- (:constructor timer-create ())
- (:type vector)
- (:conc-name timer--))
+ (:constructor nil)
+ (:copier nil)
+ (:constructor timer-create ())
+ (:type vector)
+ (:conc-name timer--))
+ ;; nil if the timer is active (waiting to be triggered),
+ ;; non-nil if it is inactive ("already triggered", in theory).
(triggered t)
- high-seconds low-seconds usecs repeat-delay function args idle-delay psecs)
+ ;; Time of next trigger: for normal timers, absolute time, for idle timers,
+ ;; time relative to idle-start.
+ high-seconds low-seconds usecs
+ ;; For normal timers, time between repetitions, or nil. For idle timers,
+ ;; non-nil iff repeated.
+ repeat-delay
+ function args ;What to do when triggered.
+ idle-delay ;If non-nil, this is an idle-timer.
+ psecs)
(defun timerp (object)
"Return t if OBJECT is a timer."
(and (vectorp object) (= (length object) 9)))
+(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)
- (or (timerp timer) (error "Invalid 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'.
timer)
(defun timer-set-idle-time (timer secs &optional repeat)
+ ;; FIXME: Merge with timer-set-time.
"Set the trigger idle time of TIMER to SECS.
SECS may be an integer, floating point number, or the internal
time format 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."
- (if (consp secs)
- (setf (timer--time timer) secs)
- (setf (timer--time timer) '(0 0 0))
- (timer-inc-time timer secs))
+ (setf (timer--time timer) (if (consp secs) secs (seconds-to-time secs)))
(setf (timer--repeat-delay timer) repeat)
timer)
(floor (mod next-sec-psec 1000000)))))
(defun timer-relative-time (time secs &optional usecs psecs)
- "Advance TIME by SECS seconds and optionally USECS nanoseconds
+ "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)))
(time-less-p (timer--time t1) (timer--time t2)))
(defun timer-inc-time (timer secs &optional usecs psecs)
- "Increment the time set in TIMER by SECS seconds, USECS nanoseconds,
+ "Increment the time set in TIMER by SECS seconds, USECS microseconds,
and PSECS picoseconds. SECS may be a fraction. If USECS or PSECS are
omitted, they are treated as zero."
(setf (timer--time timer)
(defun timer-set-function (timer function &optional args)
"Make TIMER call FUNCTION with optional ARGS when triggering."
- (or (timerp timer)
- (error "Invalid timer"))
+ (timer--check timer)
(setf (timer--function timer) function)
(setf (timer--args timer) args)
timer)
(setcdr reuse-cell timers))
(setq reuse-cell (cons timer timers)))
;; Insert new timer after last which possibly means in front of queue.
- (cond (last (setcdr last reuse-cell))
- (idle (setq timer-idle-list reuse-cell))
- (t (setq timer-list reuse-cell)))
+ (setf (cond (last (cdr last))
+ (idle timer-idle-list)
+ (t timer-list))
+ reuse-cell)
(setf (timer--triggered timer) triggered-p)
(setf (timer--idle-delay timer) idle)
nil)
(defun cancel-timer (timer)
"Remove TIMER from the list of active timers."
- (or (timerp timer)
- (error "Invalid timer"))
+ (timer--check timer)
(setq timer-list (delq timer timer-list))
(setq timer-idle-list (delq timer timer-idle-list))
nil)
(setq timer-event-last-1 timer-event-last)
(setq timer-event-last timer)
(let ((inhibit-quit t))
- (if (timerp timer)
- (let (retrigger cell)
- ;; Delete from queue. Record the cons cell that was used.
- (setq cell (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)))))
- (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-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 in timer: %S" err)))
- (if retrigger
- (setf (timer--triggered timer) nil)))
- (error "Bogus timer event"))))
+ (timer--check timer)
+ (let ((retrigger nil)
+ (cell
+ ;; Delete from queue. Record the cons cell that was used.
+ (cancel-timer-internal timer)))
+ ;; 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)
secs
(if (string-match-p "\\`[0-9.]+\\'" string)
(string-to-number string)))))
+
+(defun internal-timer-start-idle ()
+ "Mark all idle-time timers as once again candidates for running."
+ (dolist (timer timer-idle-list)
+ (if (timerp timer) ;; FIXME: Why test?
+ (setf (timer--triggered timer) nil))))
\f
(provide 'timer)