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

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

3 files changed, 47 insertions, 3 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8416aa837cc..ec13ee51487 100644
--- 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 296ca82b64a..40a96f4e6c2 100644
--- 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 9672a7afb76..5c7e1c30cf4 100644
--- 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))))
 
 ;;; Atomic change groups.