Merge from emacs--rel--22

[bpt/emacs.git] / lisp / play / zone.el

diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index a075729..256a316 100644 (file)
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,6 +1,7 @@
 ;;; zone.el --- idle display hacks
 
-;; Copyright (C) 2000, 2001, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Victor Zandy <zandy@cs.wisc.edu>
 ;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
@@ -134,59 +135,60 @@ If the element is a function or a list of a function and a number,
 (defun zone ()
   "Zone out, completely."
   (interactive)
-  (let ((f (selected-frame))
-        (outbuf (get-buffer-create "*zone*"))
-        (text (buffer-substring (window-start) (window-end)))
-        (wp (1+ (- (window-point (selected-window))
-                   (window-start)))))
-    (put 'zone 'orig-buffer (current-buffer))
-    (put 'zone 'modeline-hidden-level 0)
-    (switch-to-buffer outbuf)
-    (setq mode-name "Zone")
-    (erase-buffer)
-    (setq buffer-undo-list t
-          truncate-lines t
-          tab-width (zone-orig tab-width)
-          line-spacing (zone-orig line-spacing))
-    (insert text)
-    (untabify (point-min) (point-max))
-    (set-window-start (selected-window) (point-min))
-    (set-window-point (selected-window) wp)
-    (sit-for 0 500)
-    (let ((pgm (elt zone-programs (random (length zone-programs))))
-          (ct (and f (frame-parameter f 'cursor-type)))
-          (restore (list '(kill-buffer outbuf))))
-      (when ct
-        (modify-frame-parameters f '((cursor-type . (bar . 0))))
-        (setq restore (cons '(modify-frame-parameters
-                              f (list (cons 'cursor-type ct)))
-                            restore)))
-      ;; Make `restore' a self-disabling one-shot thunk.
-      (setq restore `(lambda () ,@restore (setq restore nil)))
-      (condition-case nil
-          (progn
-            (message "Zoning... (%s)" pgm)
-            (garbage-collect)
-            ;; If some input is pending, zone says "sorry", which
-            ;; isn't nice; this might happen e.g. when they invoke the
-            ;; game by clicking the menu bar.  So discard any pending
-            ;; input before zoning out.
-            (if (input-pending-p)
-                (discard-input))
-            (zone-call pgm)
-            (message "Zoning...sorry"))
-        (error
-         (funcall restore)
-         (while (not (input-pending-p))
-           (message (format "We were zoning when we wrote %s..." pgm))
-           (sit-for 3)
-           (message "...here's hoping we didn't hose your buffer!")
-           (sit-for 3)))
-        (quit
-         (funcall restore)
-         (ding)
-         (message "Zoning...sorry")))
-      (when restore (funcall restore)))))
+  (save-window-excursion
+    (let ((f (selected-frame))
+          (outbuf (get-buffer-create "*zone*"))
+          (text (buffer-substring (window-start) (window-end)))
+          (wp (1+ (- (window-point (selected-window))
+                     (window-start)))))
+      (put 'zone 'orig-buffer (current-buffer))
+      (put 'zone 'modeline-hidden-level 0)
+      (switch-to-buffer outbuf)
+      (setq mode-name "Zone")
+      (erase-buffer)
+      (setq buffer-undo-list t
+            truncate-lines t
+            tab-width (zone-orig tab-width)
+            line-spacing (zone-orig line-spacing))
+      (insert text)
+      (untabify (point-min) (point-max))
+      (set-window-start (selected-window) (point-min))
+      (set-window-point (selected-window) wp)
+      (sit-for 0 500)
+      (let ((pgm (elt zone-programs (random (length zone-programs))))
+            (ct (and f (frame-parameter f 'cursor-type)))
+            (restore (list '(kill-buffer outbuf))))
+        (when ct
+          (modify-frame-parameters f '((cursor-type . (bar . 0))))
+          (setq restore (cons '(modify-frame-parameters
+                                f (list (cons 'cursor-type ct)))
+                              restore)))
+        ;; Make `restore' a self-disabling one-shot thunk.
+        (setq restore `(lambda () ,@restore (setq restore nil)))
+        (condition-case nil
+            (progn
+              (message "Zoning... (%s)" pgm)
+              (garbage-collect)
+              ;; If some input is pending, zone says "sorry", which
+              ;; isn't nice; this might happen e.g. when they invoke the
+              ;; game by clicking the menu bar.  So discard any pending
+              ;; input before zoning out.
+              (if (input-pending-p)
+                  (discard-input))
+              (zone-call pgm)
+              (message "Zoning...sorry"))
+          (error
+           (funcall restore)
+           (while (not (input-pending-p))
+             (message "We were zoning when we wrote %s..." pgm)
+             (sit-for 3)
+             (message "...here's hoping we didn't hose your buffer!")
+             (sit-for 3)))
+          (quit
+           (funcall restore)
+           (ding)
+           (message "Zoning...sorry")))
+        (when restore (funcall restore))))))
 
 ;;;; Zone when idle, or not.
 
@@ -622,7 +624,7 @@ If the element is a function or a list of a function and a number,
    (sit-for 3)
    (erase-buffer)
    (sit-for 3)
-   (insert-buffer "*Messages*")
+   (insert-buffer-substring "*Messages*")
    (message "")
    (goto-char (point-max))
    (recenter -1)
@@ -690,6 +692,7 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
       (life (or zone-pgm-random-life-wait (random 4)))
       (kill-buffer nil))))
 
+(random t)
 
 ;;;;;;;;;;;;;;;
 (provide 'zone)