Make run-at-time try harder to run at integral multiples

* lisp/emacs-lisp/timer.el (timer): Add new slot integral-multiple.
(timerp): Adjust.
(timer-event-handler): Recompute the delay if requested
(bug#39099).
(run-at-time): Mark the timer as recomputable if given a t
parameter.

* src/keyboard.c (decode_timer): Adjust.
This commit is contained in:
Lars Ingebrigtsen 2021-08-31 03:04:22 +02:00
parent d2ad64b7a5
commit 50765f3f51
3 changed files with 64 additions and 40 deletions

View file

@ -29,6 +29,8 @@
(eval-when-compile (require 'cl-lib))
;; If you change this structure, you also have to change `timerp'
;; (below) and decode_timer in keyboard.c.
(cl-defstruct (timer
(:constructor nil)
(:copier nil)
@ -46,11 +48,16 @@
repeat-delay
function args ;What to do when triggered.
idle-delay ;If non-nil, this is an idle-timer.
psecs)
psecs
;; A timer may be created with `t' as the TIME, which means that we
;; want to run at specific integral multiples of `repeat-delay'. We
;; then have to recompute this (because the machine may have gone to
;; sleep, etc).
integral-multiple)
(defun timerp (object)
"Return t if OBJECT is a timer."
(and (vectorp object) (= (length object) 9)))
(and (vectorp object) (= (length object) 10)))
(defsubst timer--check (timer)
(or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer))))
@ -284,6 +291,13 @@ This function is called, by name, directly by the C code."
(if (> repeats timer-max-repeats)
(timer-inc-time timer (* (timer--repeat-delay timer)
repeats)))))
;; If we want integral multiples, we have to recompute
;; the repetition.
(when (and (timer--integral-multiple timer)
(not (timer--idle-delay timer)))
(setf (timer--time timer)
(timer-next-integral-multiple-of-time
(current-time) (timer--repeat-delay timer))))
;; Place it back on the timer-list before running
;; timer--function, so it can cancel-timer itself.
(timer-activate timer t cell)
@ -340,45 +354,44 @@ This function returns a timer object which you can use in
`cancel-timer'."
(interactive "sRun at time: \nNRepeat interval: \naFunction: ")
(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 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 nil secs)))))
;; Handle "11:23pm" and the like. Interpret it as meaning today
;; which admittedly is rather stupid if we have passed that time
;; already. (Though only Emacs hackers hack Emacs at that time.)
(if (stringp time)
(progn
(require 'diary-lib)
(let ((hhmm (diary-entry-time time))
(now (decode-time)))
(if (>= hhmm 0)
(setq time
(encode-time 0 (% hhmm 100) (/ hhmm 100)
(decoded-time-day now)
(decoded-time-month now)
(decoded-time-year now)
(decoded-time-zone now)))))))
(when (and repeat
(numberp repeat)
(< repeat 0))
(error "Invalid repetition interval"))
(let ((timer (timer-create)))
;; Special case: nil means "now" and is useful when repeating.
(unless time
(setq time (current-time)))
;; Special case: t means the next integral multiple of REPEAT.
(when (and (eq time t) repeat)
(setq time (timer-next-integral-multiple-of-time (current-time) repeat))
(setf (timer--integral-multiple timer) t))
;; Handle numbers as relative times in seconds.
(when (numberp time)
(setq time (timer-relative-time nil time)))
;; Handle relative times like "2 hours 35 minutes".
(when (stringp time)
(when-let ((secs (timer-duration time)))
(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
;; already. (Though only Emacs hackers hack Emacs at that time.)
(when (stringp time)
(require 'diary-lib)
(let ((hhmm (diary-entry-time time))
(now (decode-time)))
(when (>= hhmm 0)
(setq time (encode-time 0 (% hhmm 100) (/ hhmm 100)
(decoded-time-day now)
(decoded-time-month now)
(decoded-time-year now)
(decoded-time-zone now))))))
(timer-set-time timer time repeat)
(timer-set-function timer function args)
(timer-activate timer)