# HG changeset patch # User Richard M. Stallman # Date 1121015905 0 # Node ID 5177474d1ca79416ee6fae03a35a233fd4b41c94 # Parent c08c2bf5cec81c618d090d4837352747a4458746 (with-timeout-timers): New variable. (with-timeout): Bind that variable to record timers. (with-timeout-suspend, with-timeout-unsuspend): New functions. diff -r c08c2bf5cec8 -r 5177474d1ca7 lisp/emacs-lisp/timer.el --- a/lisp/emacs-lisp/timer.el Sun Jul 10 17:07:19 2005 +0000 +++ b/lisp/emacs-lisp/timer.el Sun Jul 10 17:18:25 2005 +0000 @@ -404,6 +404,9 @@ ;;;###autoload (put 'with-timeout 'lisp-indent-function 1) +(defvar with-timeout-timers nil + "List of all timers used by currently pending `with-timeout' calls.") + ;;;###autoload (defmacro with-timeout (list &rest body) "Run BODY, but if it doesn't finish in SECONDS seconds, give up. @@ -416,19 +419,46 @@ (let ((seconds (car list)) (timeout-forms (cdr list))) `(let ((with-timeout-tag (cons nil nil)) - with-timeout-value with-timeout-timer) + with-timeout-value with-timeout-timer + (with-timeout-timers with-timeout-timers)) (if (catch with-timeout-tag (progn (setq with-timeout-timer (run-with-timer ,seconds nil 'with-timeout-handler with-timeout-tag)) + (push with-timeout-timer with-timeout-timers) (setq with-timeout-value (progn . ,body)) nil)) (progn . ,timeout-forms) (cancel-timer with-timeout-timer) with-timeout-value)))) +(defun with-timeout-suspend () + "Stop the clock for `with-timeout'. Used by debuggers. +The idea is that the time you spend in the debugger should not +count against these timeouts. + +The value is a list that the debugger can pass to `with-timeout-unsuspend' +when it exits, to make these timers start counting again." + (mapcar (lambda (timer) + (cancel-timer timer) + (list timer + (time-subtract + ;; The time that this timer will go off. + (list (aref timer 1) (aref timer 2) (aref timer 3)) + (current-time)))) + with-timeout-timers)) + +(defun with-timeout-unsuspend (timer-spec-list) + "Restart the clock for `with-timeout'. +The argument should be a value previously returned by `with-timeout-suspend'." + (dolist (elt timer-spec-list) + (let ((timer (car elt)) + (delay (cadr elt))) + (timer-set-time timer (time-add (current-time) delay)) + (timer-activate timer)))) + (defun y-or-n-p-with-timeout (prompt seconds default-value) "Like (y-or-n-p PROMPT), with a timeout. If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."