| 1 | ;;; timer.el --- run a function with args at some time in future |
| 2 | |
| 3 | ;; Copyright (C) 1996, 2001-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Maintainer: emacs-devel@gnu.org |
| 6 | ;; Package: emacs |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation, either version 3 of the License, or |
| 13 | ;; (at your option) any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 22 | |
| 23 | ;;; Commentary: |
| 24 | |
| 25 | ;; This package gives you the capability to run Emacs Lisp commands at |
| 26 | ;; specified times in the future, either as one-shots or periodically. |
| 27 | |
| 28 | ;;; Code: |
| 29 | |
| 30 | (eval-when-compile (require 'cl-lib)) |
| 31 | |
| 32 | (cl-defstruct (timer |
| 33 | (:constructor nil) |
| 34 | (:copier nil) |
| 35 | (:constructor timer-create ()) |
| 36 | (:type vector) |
| 37 | (:conc-name timer--)) |
| 38 | ;; nil if the timer is active (waiting to be triggered), |
| 39 | ;; non-nil if it is inactive ("already triggered", in theory). |
| 40 | (triggered t) |
| 41 | ;; Time of next trigger: for normal timers, absolute time, for idle timers, |
| 42 | ;; time relative to idle-start. |
| 43 | high-seconds low-seconds usecs |
| 44 | ;; For normal timers, time between repetitions, or nil. For idle timers, |
| 45 | ;; non-nil iff repeated. |
| 46 | repeat-delay |
| 47 | function args ;What to do when triggered. |
| 48 | idle-delay ;If non-nil, this is an idle-timer. |
| 49 | psecs) |
| 50 | |
| 51 | (defun timerp (object) |
| 52 | "Return t if OBJECT is a timer." |
| 53 | (and (vectorp object) (= (length object) 9))) |
| 54 | |
| 55 | (defsubst timer--check (timer) |
| 56 | (or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer)))) |
| 57 | |
| 58 | (defun timer--time-setter (timer time) |
| 59 | (timer--check timer) |
| 60 | (setf (timer--high-seconds timer) (pop time)) |
| 61 | (let ((low time) (usecs 0) (psecs 0)) |
| 62 | (when (consp time) |
| 63 | (setq low (pop time)) |
| 64 | (when time |
| 65 | (setq usecs (pop time)) |
| 66 | (when time |
| 67 | (setq psecs (car time))))) |
| 68 | (setf (timer--low-seconds timer) low) |
| 69 | (setf (timer--usecs timer) usecs) |
| 70 | (setf (timer--psecs timer) psecs) |
| 71 | time)) |
| 72 | |
| 73 | ;; Pseudo field `time'. |
| 74 | (defun timer--time (timer) |
| 75 | (declare (gv-setter timer--time-setter)) |
| 76 | (list (timer--high-seconds timer) |
| 77 | (timer--low-seconds timer) |
| 78 | (timer--usecs timer) |
| 79 | (timer--psecs timer))) |
| 80 | |
| 81 | (defun timer-set-time (timer time &optional delta) |
| 82 | "Set the trigger time of TIMER to TIME. |
| 83 | TIME must be in the internal format returned by, e.g., `current-time'. |
| 84 | If optional third argument DELTA is a positive number, make the timer |
| 85 | fire repeatedly that many seconds apart." |
| 86 | (setf (timer--time timer) time) |
| 87 | (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) |
| 88 | timer) |
| 89 | |
| 90 | (defun timer-set-idle-time (timer secs &optional repeat) |
| 91 | ;; FIXME: Merge with timer-set-time. |
| 92 | "Set the trigger idle time of TIMER to SECS. |
| 93 | SECS may be an integer, floating point number, or the internal |
| 94 | time format returned by, e.g., `current-idle-time'. |
| 95 | If optional third argument REPEAT is non-nil, make the timer |
| 96 | fire each time Emacs is idle for that many seconds." |
| 97 | (setf (timer--time timer) (if (consp secs) secs (seconds-to-time secs))) |
| 98 | (setf (timer--repeat-delay timer) repeat) |
| 99 | timer) |
| 100 | |
| 101 | (defun timer-next-integral-multiple-of-time (time secs) |
| 102 | "Yield the next value after TIME that is an integral multiple of SECS. |
| 103 | More precisely, the next value, after TIME, that is an integral multiple |
| 104 | of SECS seconds since the epoch. SECS may be a fraction." |
| 105 | (let* ((trillion 1e12) |
| 106 | (time-sec (+ (nth 1 time) |
| 107 | (* 65536.0 (nth 0 time)))) |
| 108 | (delta-sec (mod (- time-sec) secs)) |
| 109 | (next-sec (+ time-sec (ffloor delta-sec))) |
| 110 | (next-sec-psec (ffloor (* trillion (mod delta-sec 1)))) |
| 111 | (sub-time-psec (+ (or (nth 3 time) 0) |
| 112 | (* 1e6 (nth 2 time)))) |
| 113 | (psec-diff (- sub-time-psec next-sec-psec))) |
| 114 | (if (and (<= next-sec time-sec) (< 0 psec-diff)) |
| 115 | (setq next-sec-psec (+ sub-time-psec |
| 116 | (mod (- psec-diff) (* trillion secs))))) |
| 117 | (setq next-sec (+ next-sec (floor next-sec-psec trillion))) |
| 118 | (setq next-sec-psec (mod next-sec-psec trillion)) |
| 119 | (list (floor next-sec 65536) |
| 120 | (floor (mod next-sec 65536)) |
| 121 | (floor next-sec-psec 1000000) |
| 122 | (floor (mod next-sec-psec 1000000))))) |
| 123 | |
| 124 | (defun timer-relative-time (time secs &optional usecs psecs) |
| 125 | "Advance TIME by SECS seconds and optionally USECS microseconds |
| 126 | and PSECS picoseconds. SECS may be either an integer or a |
| 127 | floating point number." |
| 128 | (let ((delta (if (floatp secs) |
| 129 | (seconds-to-time secs) |
| 130 | (list (floor secs 65536) (mod secs 65536))))) |
| 131 | (if (or usecs psecs) |
| 132 | (setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0))))) |
| 133 | (time-add time delta))) |
| 134 | |
| 135 | (defun timer--time-less-p (t1 t2) |
| 136 | "Say whether time value T1 is less than time value T2." |
| 137 | (time-less-p (timer--time t1) (timer--time t2))) |
| 138 | |
| 139 | (defun timer-inc-time (timer secs &optional usecs psecs) |
| 140 | "Increment the time set in TIMER by SECS seconds, USECS microseconds, |
| 141 | and PSECS picoseconds. SECS may be a fraction. If USECS or PSECS are |
| 142 | omitted, they are treated as zero." |
| 143 | (setf (timer--time timer) |
| 144 | (timer-relative-time (timer--time timer) secs usecs psecs))) |
| 145 | |
| 146 | (defun timer-set-time-with-usecs (timer time usecs &optional delta) |
| 147 | "Set the trigger time of TIMER to TIME plus USECS. |
| 148 | TIME must be in the internal format returned by, e.g., `current-time'. |
| 149 | The microsecond count from TIME is ignored, and USECS is used instead. |
| 150 | If optional fourth argument DELTA is a positive number, make the timer |
| 151 | fire repeatedly that many seconds apart." |
| 152 | (declare (obsolete "use `timer-set-time' and `timer-inc-time' instead." |
| 153 | "22.1")) |
| 154 | (setf (timer--time timer) time) |
| 155 | (setf (timer--usecs timer) usecs) |
| 156 | (setf (timer--psecs timer) 0) |
| 157 | (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) |
| 158 | timer) |
| 159 | |
| 160 | (defun timer-set-function (timer function &optional args) |
| 161 | "Make TIMER call FUNCTION with optional ARGS when triggering." |
| 162 | (timer--check timer) |
| 163 | (setf (timer--function timer) function) |
| 164 | (setf (timer--args timer) args) |
| 165 | timer) |
| 166 | \f |
| 167 | (defun timer--activate (timer &optional triggered-p reuse-cell idle) |
| 168 | (if (and (timerp timer) |
| 169 | (integerp (timer--high-seconds timer)) |
| 170 | (integerp (timer--low-seconds timer)) |
| 171 | (integerp (timer--usecs timer)) |
| 172 | (integerp (timer--psecs timer)) |
| 173 | (timer--function timer)) |
| 174 | (let ((timers (if idle timer-idle-list timer-list)) |
| 175 | last) |
| 176 | ;; Skip all timers to trigger before the new one. |
| 177 | (while (and timers (timer--time-less-p (car timers) timer)) |
| 178 | (setq last timers |
| 179 | timers (cdr timers))) |
| 180 | (if reuse-cell |
| 181 | (progn |
| 182 | (setcar reuse-cell timer) |
| 183 | (setcdr reuse-cell timers)) |
| 184 | (setq reuse-cell (cons timer timers))) |
| 185 | ;; Insert new timer after last which possibly means in front of queue. |
| 186 | (setf (cond (last (cdr last)) |
| 187 | (idle timer-idle-list) |
| 188 | (t timer-list)) |
| 189 | reuse-cell) |
| 190 | (setf (timer--triggered timer) triggered-p) |
| 191 | (setf (timer--idle-delay timer) idle) |
| 192 | nil) |
| 193 | (error "Invalid or uninitialized timer"))) |
| 194 | |
| 195 | (defun timer-activate (timer &optional triggered-p reuse-cell) |
| 196 | "Insert TIMER into `timer-list'. |
| 197 | If TRIGGERED-P is t, make TIMER inactive (put it on the list, but |
| 198 | mark it as already triggered). To remove it, use `cancel-timer'. |
| 199 | |
| 200 | REUSE-CELL, if non-nil, is a cons cell to reuse when inserting |
| 201 | TIMER into `timer-list' (usually a cell removed from that list by |
| 202 | `cancel-timer-internal'; using this reduces consing for repeat |
| 203 | timers). If nil, allocate a new cell." |
| 204 | (timer--activate timer triggered-p reuse-cell nil)) |
| 205 | |
| 206 | (defun timer-activate-when-idle (timer &optional dont-wait reuse-cell) |
| 207 | "Insert TIMER into `timer-idle-list'. |
| 208 | This arranges to activate TIMER whenever Emacs is next idle. |
| 209 | If optional argument DONT-WAIT is non-nil, set TIMER to activate |
| 210 | immediately \(see below\), or at the right time, if Emacs is |
| 211 | already idle. |
| 212 | |
| 213 | REUSE-CELL, if non-nil, is a cons cell to reuse when inserting |
| 214 | TIMER into `timer-idle-list' (usually a cell removed from that |
| 215 | list by `cancel-timer-internal'; using this reduces consing for |
| 216 | repeat timers). If nil, allocate a new cell. |
| 217 | |
| 218 | Using non-nil DONT-WAIT is not recommended when activating an |
| 219 | idle timer from an idle timer handler, if the timer being |
| 220 | activated has an idleness time that is smaller or equal to |
| 221 | the time of the current timer. That's because the activated |
| 222 | timer will fire right away." |
| 223 | (timer--activate timer (not dont-wait) reuse-cell 'idle)) |
| 224 | |
| 225 | (defalias 'disable-timeout 'cancel-timer) |
| 226 | |
| 227 | (defun cancel-timer (timer) |
| 228 | "Remove TIMER from the list of active timers." |
| 229 | (timer--check timer) |
| 230 | (setq timer-list (delq timer timer-list)) |
| 231 | (setq timer-idle-list (delq timer timer-idle-list)) |
| 232 | nil) |
| 233 | |
| 234 | (defun cancel-timer-internal (timer) |
| 235 | "Remove TIMER from the list of active timers or idle timers. |
| 236 | Only to be used in this file. It returns the cons cell |
| 237 | that was removed from the timer list." |
| 238 | (let ((cell1 (memq timer timer-list)) |
| 239 | (cell2 (memq timer timer-idle-list))) |
| 240 | (if cell1 |
| 241 | (setq timer-list (delq timer timer-list))) |
| 242 | (if cell2 |
| 243 | (setq timer-idle-list (delq timer timer-idle-list))) |
| 244 | (or cell1 cell2))) |
| 245 | |
| 246 | (defun cancel-function-timers (function) |
| 247 | "Cancel all timers which would run FUNCTION. |
| 248 | This affects ordinary timers such as are scheduled by `run-at-time', |
| 249 | and idle timers such as are scheduled by `run-with-idle-timer'." |
| 250 | (interactive "aCancel timers of function: ") |
| 251 | (dolist (timer timer-list) |
| 252 | (if (eq (timer--function timer) function) |
| 253 | (setq timer-list (delq timer timer-list)))) |
| 254 | (dolist (timer timer-idle-list) |
| 255 | (if (eq (timer--function timer) function) |
| 256 | (setq timer-idle-list (delq timer timer-idle-list))))) |
| 257 | \f |
| 258 | ;; Record the last few events, for debugging. |
| 259 | (defvar timer-event-last nil |
| 260 | "Last timer that was run.") |
| 261 | (defvar timer-event-last-1 nil |
| 262 | "Next-to-last timer that was run.") |
| 263 | (defvar timer-event-last-2 nil |
| 264 | "Third-to-last timer that was run.") |
| 265 | |
| 266 | (defcustom timer-max-repeats 10 |
| 267 | "Maximum number of times to repeat a timer, if many repeats are delayed. |
| 268 | Timer invocations can be delayed because Emacs is suspended or busy, |
| 269 | or because the system's time changes. If such an occurrence makes it |
| 270 | appear that many invocations are overdue, this variable controls |
| 271 | how many will really happen." |
| 272 | :type 'integer |
| 273 | :group 'internal) |
| 274 | |
| 275 | (defun timer-until (timer time) |
| 276 | "Calculate number of seconds from when TIMER will run, until TIME. |
| 277 | TIMER is a timer, and stands for the time when its next repeat is scheduled. |
| 278 | TIME is a time-list." |
| 279 | (- (float-time time) (float-time (timer--time timer)))) |
| 280 | |
| 281 | (defun timer-event-handler (timer) |
| 282 | "Call the handler for the timer TIMER. |
| 283 | This function is called, by name, directly by the C code." |
| 284 | (setq timer-event-last-2 timer-event-last-1) |
| 285 | (setq timer-event-last-1 timer-event-last) |
| 286 | (setq timer-event-last timer) |
| 287 | (let ((inhibit-quit t)) |
| 288 | (timer--check timer) |
| 289 | (let ((retrigger nil) |
| 290 | (cell |
| 291 | ;; Delete from queue. Record the cons cell that was used. |
| 292 | (cancel-timer-internal timer))) |
| 293 | ;; Re-schedule if requested. |
| 294 | (if (timer--repeat-delay timer) |
| 295 | (if (timer--idle-delay timer) |
| 296 | (timer-activate-when-idle timer nil cell) |
| 297 | (timer-inc-time timer (timer--repeat-delay timer) 0) |
| 298 | ;; If real time has jumped forward, |
| 299 | ;; perhaps because Emacs was suspended for a long time, |
| 300 | ;; limit how many times things get repeated. |
| 301 | (if (and (numberp timer-max-repeats) |
| 302 | (< 0 (timer-until timer (current-time)))) |
| 303 | (let ((repeats (/ (timer-until timer (current-time)) |
| 304 | (timer--repeat-delay timer)))) |
| 305 | (if (> repeats timer-max-repeats) |
| 306 | (timer-inc-time timer (* (timer--repeat-delay timer) |
| 307 | repeats))))) |
| 308 | ;; Place it back on the timer-list before running |
| 309 | ;; timer--function, so it can cancel-timer itself. |
| 310 | (timer-activate timer t cell) |
| 311 | (setq retrigger t))) |
| 312 | ;; Run handler. |
| 313 | (condition-case-unless-debug err |
| 314 | ;; Timer functions should not change the current buffer. |
| 315 | ;; If they do, all kinds of nasty surprises can happen, |
| 316 | ;; and it can be hellish to track down their source. |
| 317 | (save-current-buffer |
| 318 | (apply (timer--function timer) (timer--args timer))) |
| 319 | (error (message "Error running timer%s: %S" |
| 320 | (if (symbolp (timer--function timer)) |
| 321 | (format " `%s'" (timer--function timer)) "") |
| 322 | err))) |
| 323 | (when (and retrigger |
| 324 | ;; If the timer's been canceled, don't "retrigger" it |
| 325 | ;; since it might still be in the copy of timer-list kept |
| 326 | ;; by keyboard.c:timer_check (bug#14156). |
| 327 | (memq timer timer-list)) |
| 328 | (setf (timer--triggered timer) nil))))) |
| 329 | |
| 330 | ;; This function is incompatible with the one in levents.el. |
| 331 | (defun timeout-event-p (event) |
| 332 | "Non-nil if EVENT is a timeout event." |
| 333 | (and (listp event) (eq (car event) 'timer-event))) |
| 334 | \f |
| 335 | |
| 336 | (declare-function diary-entry-time "diary-lib" (s)) |
| 337 | |
| 338 | (defun run-at-time (time repeat function &rest args) |
| 339 | "Perform an action at time TIME. |
| 340 | Repeat the action every REPEAT seconds, if REPEAT is non-nil. |
| 341 | TIME should be one of: a string giving an absolute time like |
| 342 | \"11:23pm\" (the acceptable formats are those recognized by |
| 343 | `diary-entry-time'; note that such times are interpreted as times |
| 344 | today, even if in the past); a string giving a relative time like |
| 345 | \"2 hours 35 minutes\" (the acceptable formats are those |
| 346 | recognized by `timer-duration'); nil meaning now; a number of |
| 347 | seconds from now; a value from `encode-time'; or t (with non-nil |
| 348 | REPEAT) meaning the next integral multiple of REPEAT. REPEAT may |
| 349 | be an integer or floating point number. The action is to call |
| 350 | FUNCTION with arguments ARGS. |
| 351 | |
| 352 | This function returns a timer object which you can use in `cancel-timer'." |
| 353 | (interactive "sRun at time: \nNRepeat interval: \naFunction: ") |
| 354 | |
| 355 | (or (null repeat) |
| 356 | (and (numberp repeat) (< 0 repeat)) |
| 357 | (error "Invalid repetition interval")) |
| 358 | |
| 359 | ;; Special case: nil means "now" and is useful when repeating. |
| 360 | (if (null time) |
| 361 | (setq time (current-time))) |
| 362 | |
| 363 | ;; Special case: t means the next integral multiple of REPEAT. |
| 364 | (if (and (eq time t) repeat) |
| 365 | (setq time (timer-next-integral-multiple-of-time (current-time) repeat))) |
| 366 | |
| 367 | ;; Handle numbers as relative times in seconds. |
| 368 | (if (numberp time) |
| 369 | (setq time (timer-relative-time (current-time) time))) |
| 370 | |
| 371 | ;; Handle relative times like "2 hours 35 minutes" |
| 372 | (if (stringp time) |
| 373 | (let ((secs (timer-duration time))) |
| 374 | (if secs |
| 375 | (setq time (timer-relative-time (current-time) secs))))) |
| 376 | |
| 377 | ;; Handle "11:23pm" and the like. Interpret it as meaning today |
| 378 | ;; which admittedly is rather stupid if we have passed that time |
| 379 | ;; already. (Though only Emacs hackers hack Emacs at that time.) |
| 380 | (if (stringp time) |
| 381 | (progn |
| 382 | (require 'diary-lib) |
| 383 | (let ((hhmm (diary-entry-time time)) |
| 384 | (now (decode-time))) |
| 385 | (if (>= hhmm 0) |
| 386 | (setq time |
| 387 | (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now) |
| 388 | (nth 4 now) (nth 5 now) (nth 8 now))))))) |
| 389 | |
| 390 | (or (consp time) |
| 391 | (error "Invalid time format")) |
| 392 | |
| 393 | (let ((timer (timer-create))) |
| 394 | (timer-set-time timer time repeat) |
| 395 | (timer-set-function timer function args) |
| 396 | (timer-activate timer) |
| 397 | timer)) |
| 398 | |
| 399 | (defun run-with-timer (secs repeat function &rest args) |
| 400 | "Perform an action after a delay of SECS seconds. |
| 401 | Repeat the action every REPEAT seconds, if REPEAT is non-nil. |
| 402 | SECS and REPEAT may be integers or floating point numbers. |
| 403 | The action is to call FUNCTION with arguments ARGS. |
| 404 | |
| 405 | This function returns a timer object which you can use in `cancel-timer'." |
| 406 | (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ") |
| 407 | (apply 'run-at-time secs repeat function args)) |
| 408 | |
| 409 | (defun add-timeout (secs function object &optional repeat) |
| 410 | "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT. |
| 411 | If REPEAT is non-nil, repeat the timer every REPEAT seconds. |
| 412 | This function is for compatibility; see also `run-with-timer'." |
| 413 | (run-with-timer secs repeat function object)) |
| 414 | |
| 415 | (defun run-with-idle-timer (secs repeat function &rest args) |
| 416 | "Perform an action the next time Emacs is idle for SECS seconds. |
| 417 | The action is to call FUNCTION with arguments ARGS. |
| 418 | SECS may be an integer, a floating point number, or the internal |
| 419 | time format returned by, e.g., `current-idle-time'. |
| 420 | If Emacs is currently idle, and has been idle for N seconds (N < SECS), |
| 421 | then it will call FUNCTION in SECS - N seconds from now. Using |
| 422 | SECS <= N is not recommended if this function is invoked from an idle |
| 423 | timer, because FUNCTION will then be called immediately. |
| 424 | |
| 425 | If REPEAT is non-nil, do the action each time Emacs has been idle for |
| 426 | exactly SECS seconds (that is, only once for each time Emacs becomes idle). |
| 427 | |
| 428 | This function returns a timer object which you can use in `cancel-timer'." |
| 429 | (interactive |
| 430 | (list (read-from-minibuffer "Run after idle (seconds): " nil nil t) |
| 431 | (y-or-n-p "Repeat each time Emacs is idle? ") |
| 432 | (intern (completing-read "Function: " obarray 'fboundp t)))) |
| 433 | (let ((timer (timer-create))) |
| 434 | (timer-set-function timer function args) |
| 435 | (timer-set-idle-time timer secs repeat) |
| 436 | (timer-activate-when-idle timer t) |
| 437 | timer)) |
| 438 | \f |
| 439 | (defvar with-timeout-timers nil |
| 440 | "List of all timers used by currently pending `with-timeout' calls.") |
| 441 | |
| 442 | (defmacro with-timeout (list &rest body) |
| 443 | "Run BODY, but if it doesn't finish in SECONDS seconds, give up. |
| 444 | If we give up, we run the TIMEOUT-FORMS and return the value of the last one. |
| 445 | The timeout is checked whenever Emacs waits for some kind of external |
| 446 | event (such as keyboard input, input from subprocesses, or a certain time); |
| 447 | if the program loops without waiting in any way, the timeout will not |
| 448 | be detected. |
| 449 | \n(fn (SECONDS TIMEOUT-FORMS...) BODY)" |
| 450 | (declare (indent 1) (debug ((form body) body))) |
| 451 | (let ((seconds (car list)) |
| 452 | (timeout-forms (cdr list)) |
| 453 | (timeout (make-symbol "timeout"))) |
| 454 | `(let ((-with-timeout-value- |
| 455 | (catch ',timeout |
| 456 | (let* ((-with-timeout-timer- |
| 457 | (run-with-timer ,seconds nil |
| 458 | (lambda () (throw ',timeout ',timeout)))) |
| 459 | (with-timeout-timers |
| 460 | (cons -with-timeout-timer- with-timeout-timers))) |
| 461 | (unwind-protect |
| 462 | (progn ,@body) |
| 463 | (cancel-timer -with-timeout-timer-)))))) |
| 464 | ;; It is tempting to avoid the `if' altogether and instead run |
| 465 | ;; timeout-forms in the timer, just before throwing `timeout'. |
| 466 | ;; But that would mean that timeout-forms are run in the deeper |
| 467 | ;; dynamic context of the timer, with inhibit-quit set etc... |
| 468 | (if (eq -with-timeout-value- ',timeout) |
| 469 | (progn ,@timeout-forms) |
| 470 | -with-timeout-value-)))) |
| 471 | |
| 472 | (defun with-timeout-suspend () |
| 473 | "Stop the clock for `with-timeout'. Used by debuggers. |
| 474 | The idea is that the time you spend in the debugger should not |
| 475 | count against these timeouts. |
| 476 | |
| 477 | The value is a list that the debugger can pass to `with-timeout-unsuspend' |
| 478 | when it exits, to make these timers start counting again." |
| 479 | (mapcar (lambda (timer) |
| 480 | (cancel-timer timer) |
| 481 | (list timer (time-subtract (timer--time timer) (current-time)))) |
| 482 | with-timeout-timers)) |
| 483 | |
| 484 | (defun with-timeout-unsuspend (timer-spec-list) |
| 485 | "Restart the clock for `with-timeout'. |
| 486 | The argument should be a value previously returned by `with-timeout-suspend'." |
| 487 | (dolist (elt timer-spec-list) |
| 488 | (let ((timer (car elt)) |
| 489 | (delay (cadr elt))) |
| 490 | (timer-set-time timer (time-add (current-time) delay)) |
| 491 | (timer-activate timer)))) |
| 492 | |
| 493 | (defun y-or-n-p-with-timeout (prompt seconds default-value) |
| 494 | "Like (y-or-n-p PROMPT), with a timeout. |
| 495 | If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." |
| 496 | (with-timeout (seconds default-value) |
| 497 | (y-or-n-p prompt))) |
| 498 | \f |
| 499 | (defconst timer-duration-words |
| 500 | (list (cons "microsec" 0.000001) |
| 501 | (cons "microsecond" 0.000001) |
| 502 | (cons "millisec" 0.001) |
| 503 | (cons "millisecond" 0.001) |
| 504 | (cons "sec" 1) |
| 505 | (cons "second" 1) |
| 506 | (cons "min" 60) |
| 507 | (cons "minute" 60) |
| 508 | (cons "hour" (* 60 60)) |
| 509 | (cons "day" (* 24 60 60)) |
| 510 | (cons "week" (* 7 24 60 60)) |
| 511 | (cons "fortnight" (* 14 24 60 60)) |
| 512 | (cons "month" (* 30 24 60 60)) ; Approximation |
| 513 | (cons "year" (* 365.25 24 60 60)) ; Approximation |
| 514 | ) |
| 515 | "Alist mapping temporal words to durations in seconds.") |
| 516 | |
| 517 | (defun timer-duration (string) |
| 518 | "Return number of seconds specified by STRING, or nil if parsing fails." |
| 519 | (let ((secs 0) |
| 520 | (start 0) |
| 521 | (case-fold-search t)) |
| 522 | (while (string-match |
| 523 | "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*" |
| 524 | string start) |
| 525 | (let ((count (if (match-beginning 1) |
| 526 | (string-to-number (match-string 1 string)) |
| 527 | 1)) |
| 528 | (itemsize (cdr (assoc (match-string 2 string) |
| 529 | timer-duration-words)))) |
| 530 | (if itemsize |
| 531 | (setq start (match-end 0) |
| 532 | secs (+ secs (* count itemsize))) |
| 533 | (setq secs nil |
| 534 | start (length string))))) |
| 535 | (if (= start (length string)) |
| 536 | secs |
| 537 | (if (string-match-p "\\`[0-9.]+\\'" string) |
| 538 | (string-to-number string))))) |
| 539 | |
| 540 | (defun internal-timer-start-idle () |
| 541 | "Mark all idle-time timers as once again candidates for running." |
| 542 | (dolist (timer timer-idle-list) |
| 543 | (if (timerp timer) ;; FIXME: Why test? |
| 544 | (setf (timer--triggered timer) nil)))) |
| 545 | \f |
| 546 | (provide 'timer) |
| 547 | |
| 548 | ;;; timer.el ends here |