changeset 71763:bedc73f663be

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

--- a/lisp/ChangeLog	Mon Jul 10 18:51:42 2006 +0000
+++ b/lisp/ChangeLog	Mon Jul 10 18:52:13 2006 +0000
@@ -1,3 +1,9 @@
[phone]  Chong Yidong  <[e-mail]>
+
+	* subr.el (sit-for): New function.
+
+	* play/hanoi.el (hanoi-sit-for): Check sit-for return value.
+
 2006-07-10  Richard Stallman  <[e-mail]>
 
 	* ldefs-boot.el (edebug): Update page.

--- a/lisp/play/hanoi.el	Mon Jul 10 18:51:42 2006 +0000
+++ b/lisp/play/hanoi.el	Mon Jul 10 18:52:13 2006 +0000
@@ -399,9 +399,8 @@
 ;; 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)

--- a/lisp/subr.el	Mon Jul 10 18:51:42 2006 +0000
+++ b/lisp/subr.el	Mon Jul 10 18:52:13 2006 +0000
@@ -1699,6 +1699,45 @@
 	    (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.