(with-timeout-timers): New variable.
(with-timeout): Bind that variable to record timers. (with-timeout-suspend, with-timeout-unsuspend): New functions.
This commit is contained in:
parent
028d38a278
commit
89c020e85d
1 changed files with 31 additions and 1 deletions
|
@ -404,6 +404,9 @@ This function returns a timer object which you can use in `cancel-timer'."
|
|||
|
||||
;;;###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 @@ be detected.
|
|||
(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."
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue