(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)
|
;;;###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
|
;;;###autoload
|
||||||
(defmacro with-timeout (list &rest body)
|
(defmacro with-timeout (list &rest body)
|
||||||
"Run BODY, but if it doesn't finish in SECONDS seconds, give up.
|
"Run BODY, but if it doesn't finish in SECONDS seconds, give up.
|
||||||
|
@ -416,19 +419,46 @@ be detected.
|
||||||
(let ((seconds (car list))
|
(let ((seconds (car list))
|
||||||
(timeout-forms (cdr list)))
|
(timeout-forms (cdr list)))
|
||||||
`(let ((with-timeout-tag (cons nil nil))
|
`(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
|
(if (catch with-timeout-tag
|
||||||
(progn
|
(progn
|
||||||
(setq with-timeout-timer
|
(setq with-timeout-timer
|
||||||
(run-with-timer ,seconds nil
|
(run-with-timer ,seconds nil
|
||||||
'with-timeout-handler
|
'with-timeout-handler
|
||||||
with-timeout-tag))
|
with-timeout-tag))
|
||||||
|
(push with-timeout-timer with-timeout-timers)
|
||||||
(setq with-timeout-value (progn . ,body))
|
(setq with-timeout-value (progn . ,body))
|
||||||
nil))
|
nil))
|
||||||
(progn . ,timeout-forms)
|
(progn . ,timeout-forms)
|
||||||
(cancel-timer with-timeout-timer)
|
(cancel-timer with-timeout-timer)
|
||||||
with-timeout-value))))
|
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)
|
(defun y-or-n-p-with-timeout (prompt seconds default-value)
|
||||||
"Like (y-or-n-p PROMPT), with a timeout.
|
"Like (y-or-n-p PROMPT), with a timeout.
|
||||||
If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
|
If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue