;;; Code:
;; Layout of a timer vector:
-;; [triggered-p high-seconds low-seconds usecs delta-secs function args]
+;; [triggered-p high-seconds low-seconds usecs repeat-delay
+;; function args idle-delay]
(defun timer-create ()
"Create a timer object."
- (let ((timer (make-vector 7 nil)))
+ (let ((timer (make-vector 8 nil)))
(aset timer 0 t)
timer))
(defun timerp (object)
"Return t if OBJECT is a timer."
- (and (vectorp object) (= (length object) 7)))
+ (and (vectorp object) (= (length object) 8)))
(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 non-zero integer make the timer
-fire repeatedly that meny seconds apart."
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a non-zero integer, 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 (if (consp (cdr time)) (nth 2 time) 0))
+ (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))
timer)
+(defun timer-set-idle-time (timer secs &optional repeat)
+ "Set the trigger idle time of TIMER to SECS.
+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"))
+ (aset timer 1 0)
+ (aset timer 2 0)
+ (aset timer 3 0)
+ (timer-inc-time timer secs)
+ (aset timer 4 repeat)
+ timer)
+
+(defun timer-next-integral-multiple-of-time (time secs)
+ "Yield the next value after TIME that is an integral multiple of SECS.
+More precisely, the next value, after TIME, that is an integral multiple
+of SECS seconds since the epoch. SECS may be a fraction."
+ (let ((time-base (ash 1 16)))
+ (if (fboundp 'atan)
+ ;; Use floating point, taking care to not lose precision.
+ (let* ((float-time-base (float time-base))
+ (million 1000000.0)
+ (time-usec (+ (* million
+ (+ (* float-time-base (nth 0 time))
+ (nth 1 time)))
+ (nth 2 time)))
+ (secs-usec (* million secs))
+ (mod-usec (mod time-usec secs-usec))
+ (next-usec (+ (- time-usec mod-usec) secs-usec))
+ (time-base-million (* float-time-base million)))
+ (list (floor next-usec time-base-million)
+ (floor (mod next-usec time-base-million) million)
+ (floor (mod next-usec million))))
+ ;; Floating point is not supported.
+ ;; Use integer arithmetic, avoiding overflow if possible.
+ (let* ((mod-sec (mod (+ (* (mod time-base secs)
+ (mod (nth 0 time) secs))
+ (nth 1 time))
+ secs))
+ (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
+ (list (+ (nth 0 time) (floor next-1-sec time-base))
+ (mod next-1-sec time-base)
+ 0)))))
+
(defun timer-relative-time (time secs &optional usecs)
"Advance TIME by SECS seconds and optionally USECS microseconds.
SECS may be a fraction."
(defun timer-set-time-with-usecs (timer time usecs &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 non-zero integer make the timer
-fire repeatedly that menu seconds apart."
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a non-zero integer, make the timer
+fire repeatedly that many seconds apart."
(or (timerp timer)
(error "Invalid timer"))
(aset timer 1 (car time))
(setcdr last (cons timer timers))
(setq timer-list (cons timer timers)))
(aset timer 0 nil)
+ (aset timer 7 nil)
nil)
(error "Invalid or uninitialized timer")))
+(defun timer-activate-when-idle (timer &optional dont-wait)
+ "Arrange to activate TIMER whenever Emacs is next idle.
+If optional argument DONT-WAIT is non-nil, then enable the
+timer to activate immediately, or at the right time, if Emacs
+is already idle."
+ (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)))
+ ;; Insert new timer after last which possibly means in front of queue.
+ (if last
+ (setcdr last (cons timer timers))
+ (setq timer-idle-list (cons timer timers)))
+ (aset timer 0 (not dont-wait))
+ (aset timer 7 t)
+ nil)
+ (error "Invalid or uninitialized timer")))
+
+;;;###autoload
(defalias 'disable-timeout 'cancel-timer)
+;;;###autoload
(defun cancel-timer (timer)
"Remove TIMER from the list of active timers."
(or (timerp timer)
(error "Invalid timer"))
(setq timer-list (delq timer timer-list))
+ (setq timer-idle-list (delq timer timer-idle-list))
nil)
+;;;###autoload
(defun cancel-function-timers (function)
"Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
(interactive "aCancel timers of function: ")
(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)))))
\f
-;; Set up the common handler for all timer events. Since the event has
-;; the timer as parameter we can still distinguish. Note that using
-;; special-event-map ensures that event timer events that arrive in the
-;; middle of a key sequence being entered are still handled correctly.
-(define-key special-event-map [timer-event] 'timer-event-handler)
-(defun timer-event-handler (event)
- "Call the handler for the timer in the event EVENT."
- (interactive "e")
- (let ((timer (car-safe (cdr-safe event))))
+;; Record the last few events, for debugging.
+(defvar timer-event-last-2 nil)
+(defvar timer-event-last-1 nil)
+(defvar timer-event-last nil)
+
+(defvar timer-max-repeats 10
+ "*Maximum number of times to repeat a timer, if real time jumps.")
+
+(defun timer-until (timer time)
+ "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))))
+ (+ low (* high 65536))))
+
+(defun timer-event-handler (timer)
+ "Call the handler for the timer TIMER.
+This function is called, by name, directly by the C code."
+ (setq timer-event-last-2 timer-event-last-1)
+ (setq timer-event-last-1 timer-event-last)
+ (setq timer-event-last timer)
+ (let ((inhibit-quit t))
(if (timerp timer)
(progn
;; Delete from queue.
(cancel-timer timer)
- ;; Run handler
- (apply (aref timer 5) (aref timer 6))
;; Re-schedule if requested.
(if (aref timer 4)
- (progn
+ (if (aref timer 7)
+ (timer-activate-when-idle timer)
(timer-inc-time timer (aref timer 4) 0)
- (timer-activate timer))))
+ ;; 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))))
+ (if (> repeats timer-max-repeats)
+ (timer-inc-time timer (* (aref timer 4) repeats)))))
+ (timer-activate timer)))
+ ;; 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))
+ (error nil)))
(error "Bogus timer event"))))
+
+;; This function is incompatible with the one in levents.el.
+(defun timeout-event-p (event)
+ "Non-nil if EVENT is a timeout event."
+ (and (listp event) (eq (car event) 'timer-event)))
\f
;;;###autoload
(defun run-at-time (time repeat function &rest args)
- "Run a function at a time, and optionally on a regular interval.
-Arguments are TIME, REPEAT, FUNCTION &rest ARGS.
-TIME is a string like \"11:23pm\" or a value from `encode-time'.
-REPEAT, an integer number of seconds, is the interval on which to repeat
-the call to the function. If REPEAT is nil or 0, call it just once.
+ "Perform an action at time TIME.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
+from now, a value from `current-time', or t (with non-nil REPEAT)
+meaning the next integral multiple of REPEAT.
+REPEAT may be an integer or floating point number.
+The action is to call FUNCTION with arguments ARGS.
This function returns a timer object which you can use in `cancel-timer'."
(interactive "sRun at time: \nNRepeat interval: \naFunction: ")
- ;; Special case: nil means "now" and is useful when repeting.
+ (or (null repeat)
+ (and (numberp repeat) (< 0 repeat))
+ (error "Invalid repetition interval"))
+
+ ;; Special case: nil means "now" and is useful when repeating.
(if (null time)
(setq time (current-time)))
+ ;; Special case: t means the next integral multiple of REPEAT.
+ (if (and (eq time t) repeat)
+ (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
+
;; Handle numbers as relative times in seconds.
(if (numberp time)
(setq time (timer-relative-time (current-time) time)))
;; Handle "11:23pm" and the like. Interpret it as meaning today
;; which admittedly is rather stupid if we have passed that time
- ;; already.
+ ;; already. (Though only Emacs hackers hack Emacs at that time.)
(if (stringp time)
(progn
(require 'diary-lib)
(or (consp time)
(error "Invalid time format"))
- (or (null repeat)
- (natnump repeat)
- (error "Invalid repetition interval"))
-
(let ((timer (timer-create)))
(timer-set-time timer time repeat)
(timer-set-function timer function args)
This function returns a timer object which you can use in `cancel-timer'."
(interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
+ (apply 'run-at-time secs repeat function args))
- (or (null repeat)
- (and (numberp repeat) (>= repeat 0))
- (error "Invalid repetition interval"))
-
- (let ((timer (timer-create)))
- (timer-set-time timer (current-time) repeat)
- (timer-inc-time timer secs)
- (timer-set-function timer function args)
- (timer-activate timer)
- timer))
-\f
;;;###autoload
(defun add-timeout (secs function object &optional repeat)
"Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
This function is for compatibility; see also `run-with-timer'."
(run-with-timer secs repeat function object))
-(defun timeout-event-p (event)
- "Non-nil if EVENT is a timeout event."
- (and (listp event)
- (eq (car event) 'timer-event)))
+;;;###autoload
+(defun run-with-idle-timer (secs repeat function &rest args)
+ "Perform an action the next time Emacs is idle for SECS seconds.
+The action is to call FUNCTION with arguments ARGS.
+SECS may be an integer or a floating point number.
+
+If REPEAT is non-nil, do the action each time Emacs has been idle for
+exactly SECS seconds (that is, only once for each time Emacs becomes idle).
+This function returns a timer object which you can use in `cancel-timer'."
+ (interactive
+ (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
+ (y-or-n-p "Repeat each time Emacs is idle? ")
+ (intern (completing-read "Function: " obarray 'fboundp t))))
+ (let ((timer (timer-create)))
+ (timer-set-function timer function args)
+ (timer-set-idle-time timer secs repeat)
+ (timer-activate-when-idle timer)
+ timer))
+\f
(defun with-timeout-handler (tag)
(throw tag 'timeout))
(defmacro with-timeout (list &rest body)
"Run BODY, but if it doesn't finish in SECONDS seconds, give up.
If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
-The call looks like
- (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
+The call should look like:
+ (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
The timeout is checked whenever Emacs waits for some kind of external
event \(such as keyboard input, input from subprocesses, or a certain time);
if the program loops without waiting in any way, the timeout will not
secs (+ secs (* count itemsize)))
(setq secs nil
start (length string)))))
- secs))
+ (if (= start (length string))
+ secs
+ (if (string-match "\\`[0-9.]+\\'" string)
+ (string-to-number string)))))
\f
(provide 'timer)
HCoop / bpt / emacs.git / blobdiff