From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Thu, 13 Oct 2011 05:18:12 +0000 (-0400)
Subject: * lisp/emacs-lisp/timer.el (with-timeout): Make sure we cancel the timer
X-Git-Tag: emacs-pretest-24.0.91~133
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=bad4122976909500e8989aad56e415afdacaa28d;p=emacs.git

* lisp/emacs-lisp/timer.el (with-timeout): Make sure we cancel the timer
even in case of error; add debug spec; simplify data flow.
(with-timeout-handler): Remove.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 62d7cc449ab..1ec96318116 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2011-10-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/timer.el (with-timeout): Make sure we cancel the timer
+	even in case of error; add debug spec; simplify data flow.
+	(with-timeout-handler): Remove.
+
 2011-10-12  Michael Albinus  <michael.albinus@gmx.de>
 
 	Fix Bug#6019, Bug#9315.
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 0e007ff7176..706c6fd0ba3 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -402,10 +402,6 @@ This function returns a timer object which you can use in `cancel-timer'."
     (timer-activate-when-idle timer t)
     timer))
 
-(defun with-timeout-handler (tag)
-  "This is the timer function used for the timer made by `with-timeout'."
-  (throw tag 'timeout))
-
 (defvar with-timeout-timers nil
   "List of all timers used by currently pending `with-timeout' calls.")
 
@@ -417,24 +413,27 @@ event (such as keyboard input, input from subprocesses, or a certain time);
 if the program loops without waiting in any way, the timeout will not
 be detected.
 \n(fn (SECONDS TIMEOUT-FORMS...) BODY)"
-  (declare (indent 1))
+  (declare (indent 1) (debug ((form body) body)))
   (let ((seconds (car list))
-	(timeout-forms (cdr list)))
-    `(let ((with-timeout-tag (cons nil nil))
-	   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))))
+	(timeout-forms (cdr list))
+        (timeout (make-symbol "timeout")))
+    `(let ((-with-timeout-value-
+            (catch ',timeout
+              (let* ((-with-timeout-timer-
+                      (run-with-timer ,seconds nil
+                                      (lambda () (throw ',timeout ',timeout))))
+                     (with-timeout-timers
+                         (cons -with-timeout-timer- with-timeout-timers)))
+                (unwind-protect
+                    ,@body
+                  (cancel-timer -with-timeout-timer-))))))
+       ;; It is tempting to avoid the `if' altogether and instead run
+       ;; timeout-forms in the timer, just before throwing `timeout'.
+       ;; But that would mean that timeout-forms are run in the deeper
+       ;; dynamic context of the timer, with inhibit-quit set etc...
+       (if (eq -with-timeout-value- ',timeout)
+           (progn ,@timeout-forms)
+         -with-timeout-value-))))
 
 (defun with-timeout-suspend ()
   "Stop the clock for `with-timeout'.  Used by debuggers.