* subr.el (sit-for): New function.

	* play/hanoi.el (hanoi-sit-for): Check sit-for return value.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8416aa837cc4ef33ff1554198f8a1e9f4e0b7884..ec13ee51487f76794e458824a7e9f698b58c27f9 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2006-07-10  Chong Yidong  <cyd@stupidchicken.com>
+
+       * subr.el (sit-for): New function.
+
+       * play/hanoi.el (hanoi-sit-for): Check sit-for return value.
+
 2006-07-10  Richard Stallman  <rms@gnu.org>
 
        * ldefs-boot.el (edebug): Update page.

diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index 296ca82b64a836e41b31f145d4aba01acf9c9e05..40a96f4e6c2c6d05a9d0b50e10797851edae27aa 100644 (file)
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -399,9 +399,8 @@ BITS must be of length nrings.  Start at START-TIME."
 ;; update display and pause, quitting with a pithy comment if the user
 ;; hits a key.
 (defun hanoi-sit-for (seconds)
-  (sit-for seconds)
-  (if (input-pending-p)
-      (signal 'quit '("I can tell you've had enough"))))
+  (unless (sit-for seconds)
+    (signal 'quit '("I can tell you've had enough"))))
 
 ;; move ring to a given buffer position and update ring's car.
 (defun hanoi-ring-to-pos (ring pos)

diff --git a/lisp/subr.el b/lisp/subr.el
index 9672a7afb76f4dfac06c3e9eab1fc749474a71dd..5c7e1c30cf4b02301cd9f79c667caad7bb045e09 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1699,6 +1699,45 @@ by doing (clear-string STRING)."
            (sit-for 1)
            t)))
     n))
+
+(defun sit-for (seconds &optional nodisp obsolete)
+  "Perform redisplay, then wait for SECONDS seconds or until input is available.
+SECONDS may be a floating-point value.
+\(On operating systems that do not support waiting for fractions of a
+second, floating-point values are rounded down to the nearest integer.)
+
+If optional arg NODISP is t, don't redisplay, just wait for input.
+Redisplay does not happen if input is available before it starts.
+However, as a special exception, redisplay will occur even when
+input is available if SECONDS is negative.
+
+Value is t if waited the full time with no input arriving, and nil otherwise.
+
+An obsolete but still supported form is
+\(sit-for SECONDS &optional MILLISECONDS NODISP)
+Where the optional arg MILLISECONDS specifies an additional wait period,
+in milliseconds; this was useful when Emacs was built without
+floating point support."
+  (when (or obsolete (numberp nodisp))
+    (setq seconds (+ seconds (* 1e-3 nodisp)))
+    (setq nodisp obsolete))
+  (unless nodisp
+    (let ((redisplay-dont-pause (or (< seconds 0) redisplay-dont-pause)))
+      (redisplay)))
+  (or (<= seconds 0)
+      (let ((timer (timer-create))
+           (echo-keystrokes 0))
+       (if (catch 'sit-for-timeout
+             (timer-set-time timer (timer-relative-time
+                                    (current-time) seconds))
+             (timer-set-function timer 'with-timeout-handler
+                                 '(sit-for-timeout))
+             (timer-activate timer)
+             (push (read-event) unread-command-events)
+             nil)
+           t
+         (cancel-timer timer)
+         nil))))
 \f
 ;;; Atomic change groups.