| 1 | ;;; timer.el --- run a function with args at some time in future |
| 2 | |
| 3 | ;; Copyright (C) 1996, 2002, 2003, 2004, 2005, |
| 4 | ;; 2006 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Maintainer: FSF |
| 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 2, or (at your option) |
| 13 | ;; 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; see the file COPYING. If not, write to the |
| 22 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 23 | ;; Boston, MA 02110-1301, USA. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;; This package gives you the capability to run Emacs Lisp commands at |
| 28 | ;; specified times in the future, either as one-shots or periodically. |
| 29 | |
| 30 | ;;; Code: |
| 31 | |
| 32 | ;; Layout of a timer vector: |
| 33 | ;; [triggered-p high-seconds low-seconds usecs repeat-delay |
| 34 | ;; function args idle-delay] |
| 35 | |
| 36 | (defun timer-create () |
| 37 | "Create a timer object." |
| 38 | (let ((timer (make-vector 8 nil))) |
| 39 | (aset timer 0 t) |
| 40 | timer)) |
| 41 | |
| 42 | (defun timerp (object) |
| 43 | "Return t if OBJECT is a timer." |
| 44 | (and (vectorp object) (= (length object) 8))) |
| 45 | |
| 46 | (defun timer-set-time (timer time &optional delta) |
| 47 | "Set the trigger time of TIMER to TIME. |
| 48 | TIME must be in the internal format returned by, e.g., `current-time'. |
| 49 | If optional third argument DELTA is a positive number, make the timer |
| 50 | fire repeatedly that many seconds apart." |
| 51 | (or (timerp timer) |
| 52 | (error "Invalid timer")) |
| 53 | (aset timer 1 (car time)) |
| 54 | (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time))) |
| 55 | (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time))) |
| 56 | (nth 2 time)) |
| 57 | 0)) |
| 58 | (aset timer 4 (and (numberp delta) (> delta 0) delta)) |
| 59 | timer) |
| 60 | |
| 61 | (defun timer-set-idle-time (timer secs &optional repeat) |
| 62 | "Set the trigger idle time of TIMER to SECS. |
| 63 | If optional third argument REPEAT is non-nil, make the timer |
| 64 | fire each time Emacs is idle for that many seconds." |
| 65 | (or (timerp timer) |
| 66 | (error "Invalid timer")) |
| 67 | (aset timer 1 0) |
| 68 | (aset timer 2 0) |
| 69 | (aset timer 3 0) |
| 70 | (timer-inc-time timer secs) |
| 71 | (aset timer 4 repeat) |
| 72 | timer) |
| 73 | |
| 74 | (defun timer-next-integral-multiple-of-time (time secs) |
| 75 | "Yield the next value after TIME that is an integral multiple of SECS. |
| 76 | More precisely, the next value, after TIME, that is an integral multiple |
| 77 | of SECS seconds since the epoch. SECS may be a fraction." |
| 78 | (let ((time-base (ash 1 16))) |
| 79 | (if (fboundp 'atan) |
| 80 | ;; Use floating point, taking care to not lose precision. |
| 81 | (let* ((float-time-base (float time-base)) |
| 82 | (million 1000000.0) |
| 83 | (time-usec (+ (* million |
| 84 | (+ (* float-time-base (nth 0 time)) |
| 85 | (nth 1 time))) |
| 86 | (nth 2 time))) |
| 87 | (secs-usec (* million secs)) |
| 88 | (mod-usec (mod time-usec secs-usec)) |
| 89 | (next-usec (+ (- time-usec mod-usec) secs-usec)) |
| 90 | (time-base-million (* float-time-base million))) |
| 91 | (list (floor next-usec time-base-million) |
| 92 | (floor (mod next-usec time-base-million) million) |
| 93 | (floor (mod next-usec million)))) |
| 94 | ;; Floating point is not supported. |
| 95 | ;; Use integer arithmetic, avoiding overflow if possible. |
| 96 | (let* ((mod-sec (mod (+ (* (mod time-base secs) |
| 97 | (mod (nth 0 time) secs)) |
| 98 | (nth 1 time)) |
| 99 | secs)) |
| 100 | (next-1-sec (+ (- (nth 1 time) mod-sec) secs))) |
| 101 | (list (+ (nth 0 time) (floor next-1-sec time-base)) |
| 102 | (mod next-1-sec time-base) |
| 103 | 0))))) |
| 104 | |
| 105 | (defun timer-relative-time (time secs &optional usecs) |
| 106 | "Advance TIME by SECS seconds and optionally USECS microseconds. |
| 107 | SECS may be a fraction." |
| 108 | (let ((high (car time)) |
| 109 | (low (if (consp (cdr time)) (nth 1 time) (cdr time))) |
| 110 | (micro (if (numberp (car-safe (cdr-safe (cdr time)))) |
| 111 | (nth 2 time) |
| 112 | 0))) |
| 113 | ;; Add |
| 114 | (if usecs (setq micro (+ micro usecs))) |
| 115 | (if (floatp secs) |
| 116 | (setq micro (+ micro (floor (* 1000000 (- secs (floor secs))))))) |
| 117 | (setq low (+ low (floor secs))) |
| 118 | |
| 119 | ;; Normalize |
| 120 | ;; `/' rounds towards zero while `mod' returns a positive number, |
| 121 | ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))). |
| 122 | (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0))) |
| 123 | (setq micro (mod micro 1000000)) |
| 124 | (setq high (+ high (/ low 65536) (if (< low 0) -1 0))) |
| 125 | (setq low (logand low 65535)) |
| 126 | |
| 127 | (list high low (and (/= micro 0) micro)))) |
| 128 | |
| 129 | (defun timer-inc-time (timer secs &optional usecs) |
| 130 | "Increment the time set in TIMER by SECS seconds and USECS microseconds. |
| 131 | SECS may be a fraction. If USECS is omitted, that means it is zero." |
| 132 | (let ((time (timer-relative-time |
| 133 | (list (aref timer 1) (aref timer 2) (aref timer 3)) |
| 134 | secs |
| 135 | usecs))) |
| 136 | (aset timer 1 (nth 0 time)) |
| 137 | (aset timer 2 (nth 1 time)) |
| 138 | (aset timer 3 (or (nth 2 time) 0)))) |
| 139 | |
| 140 | (defun timer-set-time-with-usecs (timer time usecs &optional delta) |
| 141 | "Set the trigger time of TIMER to TIME plus USECS. |
| 142 | TIME must be in the internal format returned by, e.g., `current-time'. |
| 143 | The microsecond count from TIME is ignored, and USECS is used instead. |
| 144 | If optional fourth argument DELTA is a positive number, make the timer |
| 145 | fire repeatedly that many seconds apart." |
| 146 | (or (timerp timer) |
| 147 | (error "Invalid timer")) |
| 148 | (aset timer 1 (nth 0 time)) |
| 149 | (aset timer 2 (nth 1 time)) |
| 150 | (aset timer 3 usecs) |
| 151 | (aset timer 4 (and (numberp delta) (> delta 0) delta)) |
| 152 | timer) |
| 153 | (make-obsolete 'timer-set-time-with-usecs |
| 154 | "use `timer-set-time' and `timer-inc-time' instead." |
| 155 | "22.1") |
| 156 | |
| 157 | (defun timer-set-function (timer function &optional args) |
| 158 | "Make TIMER call FUNCTION with optional ARGS when triggering." |
| 159 | (or (timerp timer) |
| 160 | (error "Invalid timer")) |
| 161 | (aset timer 5 function) |
| 162 | (aset timer 6 args) |
| 163 | timer) |
| 164 | \f |
| 165 | (defun timer-activate (timer &optional triggered-p reuse-cell) |
| 166 | "Put TIMER on the list of active timers. |
| 167 | |
| 168 | REUSE-CELL, if non-nil, is a cons cell to reuse instead |
| 169 | of allocating a new one." |
| 170 | (if (and (timerp timer) |
| 171 | (integerp (aref timer 1)) |
| 172 | (integerp (aref timer 2)) |
| 173 | (integerp (aref timer 3)) |
| 174 | (aref timer 5)) |
| 175 | (let ((timers timer-list) |
| 176 | last) |
| 177 | ;; Skip all timers to trigger before the new one. |
| 178 | (while (and timers |
| 179 | (or (> (aref timer 1) (aref (car timers) 1)) |
| 180 | (and (= (aref timer 1) (aref (car timers) 1)) |
| 181 | (> (aref timer 2) (aref (car timers) 2))) |
| 182 | (and (= (aref timer 1) (aref (car timers) 1)) |
| 183 | (= (aref timer 2) (aref (car timers) 2)) |
| 184 | (> (aref timer 3) (aref (car timers) 3))))) |
| 185 | (setq last timers |
| 186 | timers (cdr timers))) |
| 187 | (if reuse-cell |
| 188 | (progn |
| 189 | (setcar reuse-cell timer) |
| 190 | (setcdr reuse-cell timers)) |
| 191 | (setq reuse-cell (cons timer timers))) |
| 192 | ;; Insert new timer after last which possibly means in front of queue. |
| 193 | (if last |
| 194 | (setcdr last reuse-cell) |
| 195 | (setq timer-list reuse-cell)) |
| 196 | (aset timer 0 triggered-p) |
| 197 | (aset timer 7 nil) |
| 198 | nil) |
| 199 | (error "Invalid or uninitialized timer"))) |
| 200 | |
| 201 | (defun timer-activate-when-idle (timer &optional dont-wait reuse-cell) |
| 202 | "Arrange to activate TIMER whenever Emacs is next idle. |
| 203 | If optional argument DONT-WAIT is non-nil, then enable the |
| 204 | timer to activate immediately, or at the right time, if Emacs |
| 205 | is already idle. |
| 206 | |
| 207 | REUSE-CELL, if non-nil, is a cons cell to reuse instead |
| 208 | of allocating a new one." |
| 209 | (if (and (timerp timer) |
| 210 | (integerp (aref timer 1)) |
| 211 | (integerp (aref timer 2)) |
| 212 | (integerp (aref timer 3)) |
| 213 | (aref timer 5)) |
| 214 | (let ((timers timer-idle-list) |
| 215 | last) |
| 216 | ;; Skip all timers to trigger before the new one. |
| 217 | (while (and timers |
| 218 | (or (> (aref timer 1) (aref (car timers) 1)) |
| 219 | (and (= (aref timer 1) (aref (car timers) 1)) |
| 220 | (> (aref timer 2) (aref (car timers) 2))) |
| 221 | (and (= (aref timer 1) (aref (car timers) 1)) |
| 222 | (= (aref timer 2) (aref (car timers) 2)) |
| 223 | (> (aref timer 3) (aref (car timers) 3))))) |
| 224 | (setq last timers |
| 225 | timers (cdr timers))) |
| 226 | (if reuse-cell |
| 227 | (progn |
| 228 | (setcar reuse-cell timer) |
| 229 | (setcdr reuse-cell timers)) |
| 230 | (setq reuse-cell (cons timer timers))) |
| 231 | ;; Insert new timer after last which possibly means in front of queue. |
| 232 | (if last |
| 233 | (setcdr last reuse-cell) |
| 234 | (setq timer-idle-list reuse-cell)) |
| 235 | (aset timer 0 (not dont-wait)) |
| 236 | (aset timer 7 t) |
| 237 | nil) |
| 238 | (error "Invalid or uninitialized timer"))) |
| 239 | |
| 240 | ;;;###autoload |
| 241 | (defalias 'disable-timeout 'cancel-timer) |
| 242 | ;;;###autoload |
| 243 | (defun cancel-timer (timer) |
| 244 | "Remove TIMER from the list of active timers." |
| 245 | (or (timerp timer) |
| 246 | (error "Invalid timer")) |
| 247 | (setq timer-list (delq timer timer-list)) |
| 248 | (setq timer-idle-list (delq timer timer-idle-list)) |
| 249 | nil) |
| 250 | |
| 251 | ;; Remove TIMER from the list of active timers or idle timers. |
| 252 | ;; Only to be used in this file. It returns the cons cell |
| 253 | ;; that was removed from the list. |
| 254 | (defun cancel-timer-internal (timer) |
| 255 | (let ((cell1 (memq timer timer-list)) |
| 256 | (cell2 (memq timer timer-idle-list))) |
| 257 | (if cell1 |
| 258 | (setq timer-list (delq timer timer-list))) |
| 259 | (if cell2 |
| 260 | (setq timer-idle-list (delq timer timer-idle-list))) |
| 261 | (or cell1 cell2))) |
| 262 | |
| 263 | ;;;###autoload |
| 264 | (defun cancel-function-timers (function) |
| 265 | "Cancel all timers scheduled by `run-at-time' which would run FUNCTION." |
| 266 | (interactive "aCancel timers of function: ") |
| 267 | (let ((tail timer-list)) |
| 268 | (while tail |
| 269 | (if (eq (aref (car tail) 5) function) |
| 270 | (setq timer-list (delq (car tail) timer-list))) |
| 271 | (setq tail (cdr tail)))) |
| 272 | (let ((tail timer-idle-list)) |
| 273 | (while tail |
| 274 | (if (eq (aref (car tail) 5) function) |
| 275 | (setq timer-idle-list (delq (car tail) timer-idle-list))) |
| 276 | (setq tail (cdr tail))))) |
| 277 | \f |
| 278 | ;; Record the last few events, for debugging. |
| 279 | (defvar timer-event-last-2 nil) |
| 280 | (defvar timer-event-last-1 nil) |
| 281 | (defvar timer-event-last nil) |
| 282 | |
| 283 | (defvar timer-max-repeats 10 |
| 284 | "*Maximum number of times to repeat a timer, if real time jumps.") |
| 285 | |
| 286 | (defun timer-until (timer time) |
| 287 | "Calculate number of seconds from when TIMER will run, until TIME. |
| 288 | TIMER is a timer, and stands for the time when its next repeat is scheduled. |
| 289 | TIME is a time-list." |
| 290 | (let ((high (- (car time) (aref timer 1))) |
| 291 | (low (- (nth 1 time) (aref timer 2)))) |
| 292 | (+ low (* high 65536)))) |
| 293 | |
| 294 | (defun timer-event-handler (timer) |
| 295 | "Call the handler for the timer TIMER. |
| 296 | This function is called, by name, directly by the C code." |
| 297 | (setq timer-event-last-2 timer-event-last-1) |
| 298 | (setq timer-event-last-1 timer-event-last) |
| 299 | (setq timer-event-last timer) |
| 300 | (let ((inhibit-quit t)) |
| 301 | (if (timerp timer) |
| 302 | (let (retrigger cell) |
| 303 | ;; Delete from queue. Record the cons cell that was used. |
| 304 | (setq cell (cancel-timer-internal timer)) |
| 305 | ;; Re-schedule if requested. |
| 306 | (if (aref timer 4) |
| 307 | (if (aref timer 7) |
| 308 | (timer-activate-when-idle timer nil cell) |
| 309 | (timer-inc-time timer (aref timer 4) 0) |
| 310 | ;; If real time has jumped forward, |
| 311 | ;; perhaps because Emacs was suspended for a long time, |
| 312 | ;; limit how many times things get repeated. |
| 313 | (if (and (numberp timer-max-repeats) |
| 314 | (< 0 (timer-until timer (current-time)))) |
| 315 | (let ((repeats (/ (timer-until timer (current-time)) |
| 316 | (aref timer 4)))) |
| 317 | (if (> repeats timer-max-repeats) |
| 318 | (timer-inc-time timer (* (aref timer 4) repeats))))) |
| 319 | (timer-activate timer t cell) |
| 320 | (setq retrigger t))) |
| 321 | ;; Run handler. |
| 322 | ;; We do this after rescheduling so that the handler function |
| 323 | ;; can cancel its own timer successfully with cancel-timer. |
| 324 | (condition-case nil |
| 325 | (apply (aref timer 5) (aref timer 6)) |
| 326 | (error nil)) |
| 327 | (if retrigger |
| 328 | (aset timer 0 nil))) |
| 329 | (error "Bogus timer event")))) |
| 330 | |
| 331 | ;; This function is incompatible with the one in levents.el. |
| 332 | (defun timeout-event-p (event) |
| 333 | "Non-nil if EVENT is a timeout event." |
| 334 | (and (listp event) (eq (car event) 'timer-event))) |
| 335 | \f |
| 336 | ;;;###autoload |
| 337 | (defun run-at-time (time repeat function &rest args) |
| 338 | "Perform an action at time TIME. |
| 339 | Repeat the action every REPEAT seconds, if REPEAT is non-nil. |
| 340 | TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds |
| 341 | from now, a value from `current-time', or t (with non-nil REPEAT) |
| 342 | meaning the next integral multiple of REPEAT. |
| 343 | REPEAT may be an integer or floating point number. |
| 344 | The action is to call FUNCTION with arguments ARGS. |
| 345 | |
| 346 | This function returns a timer object which you can use in `cancel-timer'." |
| 347 | (interactive "sRun at time: \nNRepeat interval: \naFunction: ") |
| 348 | |
| 349 | (or (null repeat) |
| 350 | (and (numberp repeat) (< 0 repeat)) |
| 351 | (error "Invalid repetition interval")) |
| 352 | |
| 353 | ;; Special case: nil means "now" and is useful when repeating. |
| 354 | (if (null time) |
| 355 | (setq time (current-time))) |
| 356 | |
| 357 | ;; Special case: t means the next integral multiple of REPEAT. |
| 358 | (if (and (eq time t) repeat) |
| 359 | (setq time (timer-next-integral-multiple-of-time (current-time) repeat))) |
| 360 | |
| 361 | ;; Handle numbers as relative times in seconds. |
| 362 | (if (numberp time) |
| 363 | (setq time (timer-relative-time (current-time) time))) |
| 364 | |
| 365 | ;; Handle relative times like "2 hours and 35 minutes" |
| 366 | (if (stringp time) |
| 367 | (let ((secs (timer-duration time))) |
| 368 | (if secs |
| 369 | (setq time (timer-relative-time (current-time) secs))))) |
| 370 | |
| 371 | ;; Handle "11:23pm" and the like. Interpret it as meaning today |
| 372 | ;; which admittedly is rather stupid if we have passed that time |
| 373 | ;; already. (Though only Emacs hackers hack Emacs at that time.) |
| 374 | (if (stringp time) |
| 375 | (progn |
| 376 | (require 'diary-lib) |
| 377 | (let ((hhmm (diary-entry-time time)) |
| 378 | (now (decode-time))) |
| 379 | (if (>= hhmm 0) |
| 380 | (setq time |
| 381 | (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now) |
| 382 | (nth 4 now) (nth 5 now) (nth 8 now))))))) |
| 383 | |
| 384 | (or (consp time) |
| 385 | (error "Invalid time format")) |
| 386 | |
| 387 | (let ((timer (timer-create))) |
| 388 | (timer-set-time timer time repeat) |
| 389 | (timer-set-function timer function args) |
| 390 | (timer-activate timer) |
| 391 | timer)) |
| 392 | |
| 393 | ;;;###autoload |
| 394 | (defun run-with-timer (secs repeat function &rest args) |
| 395 | "Perform an action after a delay of SECS seconds. |
| 396 | Repeat the action every REPEAT seconds, if REPEAT is non-nil. |
| 397 | SECS and REPEAT may be integers or floating point numbers. |
| 398 | The action is to call FUNCTION with arguments ARGS. |
| 399 | |
| 400 | This function returns a timer object which you can use in `cancel-timer'." |
| 401 | (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ") |
| 402 | (apply 'run-at-time secs repeat function args)) |
| 403 | |
| 404 | ;;;###autoload |
| 405 | (defun add-timeout (secs function object &optional repeat) |
| 406 | "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT. |
| 407 | If REPEAT is non-nil, repeat the timer every REPEAT seconds. |
| 408 | This function is for compatibility; see also `run-with-timer'." |
| 409 | (run-with-timer secs repeat function object)) |
| 410 | |
| 411 | ;;;###autoload |
| 412 | (defun run-with-idle-timer (secs repeat function &rest args) |
| 413 | "Perform an action the next time Emacs is idle for SECS seconds. |
| 414 | The action is to call FUNCTION with arguments ARGS. |
| 415 | SECS may be an integer or a floating point number. |
| 416 | |
| 417 | If REPEAT is non-nil, do the action each time Emacs has been idle for |
| 418 | exactly SECS seconds (that is, only once for each time Emacs becomes idle). |
| 419 | |
| 420 | This function returns a timer object which you can use in `cancel-timer'." |
| 421 | (interactive |
| 422 | (list (read-from-minibuffer "Run after idle (seconds): " nil nil t) |
| 423 | (y-or-n-p "Repeat each time Emacs is idle? ") |
| 424 | (intern (completing-read "Function: " obarray 'fboundp t)))) |
| 425 | (let ((timer (timer-create))) |
| 426 | (timer-set-function timer function args) |
| 427 | (timer-set-idle-time timer secs repeat) |
| 428 | (timer-activate-when-idle timer) |
| 429 | timer)) |
| 430 | \f |
| 431 | (defun with-timeout-handler (tag) |
| 432 | (throw tag 'timeout)) |
| 433 | |
| 434 | ;;;###autoload (put 'with-timeout 'lisp-indent-function 1) |
| 435 | |
| 436 | (defvar with-timeout-timers nil |
| 437 | "List of all timers used by currently pending `with-timeout' calls.") |
| 438 | |
| 439 | ;;;###autoload |
| 440 | (defmacro with-timeout (list &rest body) |
| 441 | "Run BODY, but if it doesn't finish in SECONDS seconds, give up. |
| 442 | If we give up, we run the TIMEOUT-FORMS and return the value of the last one. |
| 443 | The timeout is checked whenever Emacs waits for some kind of external |
| 444 | event (such as keyboard input, input from subprocesses, or a certain time); |
| 445 | if the program loops without waiting in any way, the timeout will not |
| 446 | be detected. |
| 447 | \n(fn (SECONDS TIMEOUT-FORMS...) BODY)" |
| 448 | (let ((seconds (car list)) |
| 449 | (timeout-forms (cdr list))) |
| 450 | `(let ((with-timeout-tag (cons nil nil)) |
| 451 | with-timeout-value with-timeout-timer |
| 452 | (with-timeout-timers with-timeout-timers)) |
| 453 | (if (catch with-timeout-tag |
| 454 | (progn |
| 455 | (setq with-timeout-timer |
| 456 | (run-with-timer ,seconds nil |
| 457 | 'with-timeout-handler |
| 458 | with-timeout-tag)) |
| 459 | (push with-timeout-timer with-timeout-timers) |
| 460 | (setq with-timeout-value (progn . ,body)) |
| 461 | nil)) |
| 462 | (progn . ,timeout-forms) |
| 463 | (cancel-timer with-timeout-timer) |
| 464 | with-timeout-value)))) |
| 465 | |
| 466 | (defun with-timeout-suspend () |
| 467 | "Stop the clock for `with-timeout'. Used by debuggers. |
| 468 | The idea is that the time you spend in the debugger should not |
| 469 | count against these timeouts. |
| 470 | |
| 471 | The value is a list that the debugger can pass to `with-timeout-unsuspend' |
| 472 | when it exits, to make these timers start counting again." |
| 473 | (mapcar (lambda (timer) |
| 474 | (cancel-timer timer) |
| 475 | (list timer |
| 476 | (time-subtract |
| 477 | ;; The time that this timer will go off. |
| 478 | (list (aref timer 1) (aref timer 2) (aref timer 3)) |
| 479 | (current-time)))) |
| 480 | with-timeout-timers)) |
| 481 | |
| 482 | (defun with-timeout-unsuspend (timer-spec-list) |
| 483 | "Restart the clock for `with-timeout'. |
| 484 | The argument should be a value previously returned by `with-timeout-suspend'." |
| 485 | (dolist (elt timer-spec-list) |
| 486 | (let ((timer (car elt)) |
| 487 | (delay (cadr elt))) |
| 488 | (timer-set-time timer (time-add (current-time) delay)) |
| 489 | (timer-activate timer)))) |
| 490 | |
| 491 | (defun y-or-n-p-with-timeout (prompt seconds default-value) |
| 492 | "Like (y-or-n-p PROMPT), with a timeout. |
| 493 | If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." |
| 494 | (with-timeout (seconds default-value) |
| 495 | (y-or-n-p prompt))) |
| 496 | \f |
| 497 | (defvar timer-duration-words |
| 498 | (list (cons "microsec" 0.000001) |
| 499 | (cons "microsecond" 0.000001) |
| 500 | (cons "millisec" 0.001) |
| 501 | (cons "millisecond" 0.001) |
| 502 | (cons "sec" 1) |
| 503 | (cons "second" 1) |
| 504 | (cons "min" 60) |
| 505 | (cons "minute" 60) |
| 506 | (cons "hour" (* 60 60)) |
| 507 | (cons "day" (* 24 60 60)) |
| 508 | (cons "week" (* 7 24 60 60)) |
| 509 | (cons "fortnight" (* 14 24 60 60)) |
| 510 | (cons "month" (* 30 24 60 60)) ; Approximation |
| 511 | (cons "year" (* 365.25 24 60 60)) ; Approximation |
| 512 | ) |
| 513 | "Alist mapping temporal words to durations in seconds") |
| 514 | |
| 515 | (defun timer-duration (string) |
| 516 | "Return number of seconds specified by STRING, or nil if parsing fails." |
| 517 | (let ((secs 0) |
| 518 | (start 0) |
| 519 | (case-fold-search t)) |
| 520 | (while (string-match |
| 521 | "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*" |
| 522 | string start) |
| 523 | (let ((count (if (match-beginning 1) |
| 524 | (string-to-number (match-string 1 string)) |
| 525 | 1)) |
| 526 | (itemsize (cdr (assoc (match-string 2 string) |
| 527 | timer-duration-words)))) |
| 528 | (if itemsize |
| 529 | (setq start (match-end 0) |
| 530 | secs (+ secs (* count itemsize))) |
| 531 | (setq secs nil |
| 532 | start (length string))))) |
| 533 | (if (= start (length string)) |
| 534 | secs |
| 535 | (if (string-match "\\`[0-9.]+\\'" string) |
| 536 | (string-to-number string))))) |
| 537 | \f |
| 538 | (provide 'timer) |
| 539 | |
| 540 | ;;; arch-tag: b1a9237b-7787-4382-9e46-8f2c3b3273e0 |
| 541 | ;;; timer.el ends here |