(zone-timeout): New var.

(zone-hiding-modeline): New macro.
(zone-call): New func.

(zone): Init `modeline-hidden-level' symbol property.
Use `zone-call' instead of `funcall'.

(zone-pgm-whack-chars): Use `make-string' (bug introduced in 2001-10-26T20:11:25Z!monnier@iro.umontreal.ca).

(zone-pgm-stress): Use `zone-hiding-modeline'.

(zone-pgm-stress-destress): New zone program.

2 files changed, 217 insertions, 148 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 089536cca21..9114fb5555c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,12 +1,27 @@
+2002-01-10  Thien-Thi Nguyen  <ttn@giblet.glug.org>
+
+        * play/zone.el (zone-timeout): New var.
+        (zone-hiding-modeline): New macro.
+        (zone-call): New func.
+
+        (zone): Init `modeline-hidden-level' symbol property.
+        Use `zone-call' instead of `funcall'.
+
+        (zone-pgm-whack-chars): Use `make-string' (fix bug introduced in 2001-10-26T20:11:25Z!monnier@iro.umontreal.ca).
+
+        (zone-pgm-stress): Use `zone-hiding-modeline'.
+
+        (zone-pgm-stress-destress): New zone program.
+
 2002-01-10  Eli Zaretskii  <eliz@is.elta.co.il>
 
         * faces.el (minibuffer-prompt): Special face definition for MS-DOS.
 
 2002-01-09  Michael Kifer  <kifer@cs.stonybrook.edu>
-        
+
         * viper.el (viper-set-hooks): zap viper-unfriendly bindings in
         flyspell-mouse-map.
-        
+
 2002-01-08  Richard M. Stallman  <rms@gnu.org>
 
         * emacs-lisp/regexp-opt.el (regexp-opt): Bind max-specpdl-size.
@@ -42,9 +57,9 @@
         2000-08-30.
 
 2002-01-08  Michael Kifer  <kifer@cs.stonybrook.edu>
-        
+
         * ediff-hook.el: added an autoload cookie.
-        
+
 2002-01-08  Pavel Jan,Bm(Bk  <Pavel@Janik.cz>
 
         * net/eudcb-ph.el, net/ldap.el: New maintainer.  New e-mail
@@ -56,37 +71,37 @@
         (occur-mode-map): Bind `o' to that.
 
 2002-01-07  Michael Kifer  <kifer@cs.stonybrook.edu>
-        
+
         * viper-init.el (viper-cond-compile-for-xemacs-or-emacs):
         new macro that replaces viper-emacs-p and viper-xemacs-p in many
         cases. Used to reduce the number of warnings.
-        
+
         * viper-cmd.el: use viper-cond-compile-for-xemacs-or-emacs.
         (viper-standard-value): moved here from viper.el.
         (viper-set-unread-command-events): moved to viper-util.el
         (viper-check-minibuffer-overlay): make sure
         viper-minibuffer-overlay is moved to cover the entire input field.
-        
+
         * viper-util.el:  use viper-cond-compile-for-xemacs-or-emacs.
         (viper-read-key-sequence, viper-set-unread-command-events,
         viper-char-symbol-sequence-p, viper-char-array-p): moved here.
-        
+
         * viper-ex.el: use viper-cond-compile-for-xemacs-or-emacs.
-        
+
         * viper-keym.el: use viper-cond-compile-for-xemacs-or-emacs.
-        
+
         * viper-mous.el: use viper-cond-compile-for-xemacs-or-emacs.
-        
+
         * viper-macs.el (viper-char-array-p, viper-char-symbol-sequence-p,
         viper-event-vector-p): moved to viper-util.el
-        
+
         * viper.el (viper-standard-value): moved to viper-cmd.el.
         Use viper-cond-compile-for-xemacs-or-emacs.
 
         * ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs.
-        
+
         * ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs.
-        
+
         * ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new
         macro designed to be used in many places where ediff-emacs-p or
         ediff-xemacs-p was previously used. Reduces the number of
@@ -98,11 +113,11 @@
         ediff-whitespace-diff-region-p, ediff-get-region-contents):
         moved to ediff-util.el.
         (ediff-event-key): moved here.
-        
+
         * ediff-merge.el: got rid of unreferenced variables.
-        
+
         * ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs.
-        
+
         * ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs.
         (ediff-cleanup-mess): improved the way windows are set up after
         quitting ediff.
@@ -126,11 +141,11 @@
         (ediff-arrange-autosave-in-merge-jobs): check if the merge file
         is visited by another buffer and ask to save/delete that buffer.
         (ediff-verify-file-merge-buffer): new function to do the above.
-        
+
         * ediff-vers.el: load ediff-init.el at compile time.
-        
+
         * ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs.
-        
+
         * ediff.el (ediff-windows, ediff-regions-wordwise,
         ediff-regions-linewise): use indirect buffers to improve
         robustness and make it possible to compare regions of the same
@@ -140,7 +155,7 @@
         (ediff-files-internal): refuse to compare identical files.
         (ediff-regions-internal): get rid of the warning about comparing
         regions of the same buffer.
-        
+
         * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here.
         Plus the following fixes courtesy of Dave Love:
         Doc fixes.
@@ -150,7 +165,7 @@
         (ediff-copy-to-buffer): Use insert-buffer-substring rather than
         consing buffer contents.
         (ediff-goto-word): Move syntax table setting outside loop.
-        
+
 2002-01-07  Richard M. Stallman  <rms@gnu.org>
 
         * dired.el (dired-copy-filename-as-kill): Call kill-append
@@ -223,8 +238,8 @@
 
         * enriched.el (enriched-make-annotation): Doc fix.
 
-        * format.el (format-replace-strings, format-subtract-regions) 
-        (format-annotate-region, format-annotate-location) 
+        * format.el (format-replace-strings, format-subtract-regions)
+        (format-annotate-region, format-annotate-location)
         (format-annotate-atomic-property-change)
         (format-annotate-single-property-change): Doc fixes.
 
@@ -292,7 +307,7 @@
 2002-01-02  Chris Hanson  <cph@aarau.ai.mit.edu>
 
         * xscheme.el: Eleven years of updates on a private copy.
-                      
+
         Extensive changes to support multiple xscheme buffers:
         (run-scheme): Break up into new functions to facilitate starting
         processes in other buffers.
@@ -415,11 +430,11 @@
         * comint.el, cus-edit.el, diff-mode.el, enriched.el, font-lock.el:
         * generic-x.el, info.el, log-view.el, pcvs-info.el, speedbar.el:
         * wid-edit.el, woman.el, calendar/calendar.el, textmodes/flyspell.el:
-        * emulation/viper-init.el, eshell/em-ls.el, progmodes/antlr-mode.el: 
+        * emulation/viper-init.el, eshell/em-ls.el, progmodes/antlr-mode.el:
         * progmodes/cperl-mode.el, progmodes/idlwave.el:
         * progmodes/sh-script.el, progmodes/vhdl-mode.el:
         Adapt face definitions to use :weight and :slant.
-        
+
         * ps-print.el (ps-font-lock-face-attributes): Use :weight and :slant.
 
         * cus-edit.el (custom-face-edit-fix-value): Delete `assert' call.
@@ -454,7 +469,7 @@
 
         * replace.el (query-replace-read-args): Immediate error if read-only.
 
-        * textmodes/makeinfo.el (makeinfo-compilation-sentinel): 
+        * textmodes/makeinfo.el (makeinfo-compilation-sentinel):
         Display the output buffer in a more intelligent way.
 
 2001-12-30  Eli Zaretskii  <eliz@is.elta.co.il>
@@ -493,8 +508,8 @@
         * international/iso-transl.el (iso-transl-char-map) Eliminate the
         alias symbols--put the translated sequences here directly.
 
-        * progmodes/cc-mode.el (c-mode-abbrev-table) 
-        (c++-mode-abbrev-table, objc-mode-abbrev-table) 
+        * progmodes/cc-mode.el (c-mode-abbrev-table)
+        (c++-mode-abbrev-table, objc-mode-abbrev-table)
         (java-mode-abbrev-table, pike-mode-abbrev-table):
         Mark all the predefined abbrevs as "system" abbrevs.
 
@@ -616,29 +631,29 @@
         (occur-mode-map): Bind C-o to it.
 
 2001-12-24  Michael Kifer  <kifer@cs.sunysb.edu>
-        
+
         * viper-cmd.el (viper-change-state): Got rid of make-local-hook.
         (viper-special-read-and-insert-char): Make C-m work right in the r
         comand.
         (viper-buffer-search-enable): Fixed format string.
-        
+
         * viper-ex.el (ex-token-alist): Use ex-set-visited-file-name
         instead of viper-info-on-file.
         (ex-set-visited-file-name): New function.
-        
+
         * viper.el (viper-emacs-state-mode-list): Added mail-mode.
-        
+
         * ediff-mult.el (ediff-meta-mark-equal-files): Added optional
         action argument.
-        
+
         * ediff-init.el: Fixed some doc strings.
-        
+
         * ediff-util.el (ediff-after-quit-hook-internal): New variable.
         Got rid of make-local-hook.
-        
+
         * ediff-wind.el (ediff-setup-control-frame): Got rid of
         make-local-hook.
-        
+
 2001-12-23  Richard M. Stallman  <rms@gnu.org>
 
         * term/x-win.el (x-handle-geometry): Put height and width
@@ -681,7 +696,7 @@
 
         * time.el (display-time-load-average-threshold): New variable.
         (display-time-update): Use it.
-        
+
         These changes allow cycling through past 1, 5 and 15 minutes
         load-average displayed in the mode-line.
 
@@ -725,7 +740,7 @@
 
         * net/ange-ftp.el (ange-ftp-file-modtime): Use save-match-data.
 
-        * emacs-lisp/easy-mmode.el (define-minor-mode): 
+        * emacs-lisp/easy-mmode.el (define-minor-mode):
         Make no arg by default in an interactive call,
         so that repeating the command toggles again.
 
@@ -847,9 +862,9 @@
 
 2001-12-19  Richard M. Stallman  <rms@gnu.org>
 
-        * international/mule-cmds.el (describe-language-environment): 
+        * international/mule-cmds.el (describe-language-environment):
         Fix calls to help-xref-button.
-        
+
 2001-12-19  Miles Bader  <miles@gnu.org>
 
         * international/fontset.el: Require `ind-util' when compiling.
@@ -967,7 +982,7 @@
 
         * startup.el (command-line-1): Display startup screen
         even if there are command line args.
-        Add a note about how to go to editing your files. 
+        Add a note about how to go to editing your files.
         (fancy-splash-head): Add a note about how to go to your files.
         (fancy-splash-outer-buffer): New variable.
         (fancy-splash-screens): Bind variable fancy-splash-outer-buffer.
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 4ef3c2cb517..8c0a581c088 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -30,13 +30,13 @@
 ;; If it eventually irritates you, try M-x zone-leave-me-alone.
 
 ;; Bored by the zone pyrotechnics?  Write your own!  Add it to
-;; `zone-programs'.
+;; `zone-programs'.  See `zone-call' for higher-ordered zoning.
 
 ;; WARNING: Not appropriate for Emacs sessions over modems or
 ;; computers as slow as mine.
 
 ;; THANKS: Christopher Mayer, Scott Flinchbaugh, Rachel Kalmar,
-;; Max Froumentin.
+;;         Max Froumentin.
 
 ;;; Code:
 
@@ -47,6 +47,10 @@
 (defvar zone-idle 20
   "*Seconds to idle before zoning out.")
 
+(defvar zone-timeout nil
+  "*Seconds to timeout the zoning.
+If nil, don't interrupt for about 1^26 seconds.")
+
 ;; Vector of functions that zone out.  `zone' will execute one of
 ;; these functions, randomly chosen.  The chosen function is invoked
 ;; in the *zone* buffer, which contains the text of the selected
@@ -57,7 +61,7 @@
                        zone-pgm-jitter
                        zone-pgm-putz-with-case
                        zone-pgm-dissolve
-                       ;; zone-pgm-explode
+                       ;; zone-pgm-explode
                        zone-pgm-whack-chars
                        zone-pgm-rotate
                        zone-pgm-rotate-LR-lockstep
@@ -70,12 +74,60 @@
                        zone-pgm-martini-swan-dive
                        zone-pgm-paragraph-spaz
                        zone-pgm-stress
+                       zone-pgm-stress-destress
                        ])
 
 (defmacro zone-orig (&rest body)
   `(with-current-buffer (get 'zone 'orig-buffer)
      ,@body))
 
+(defmacro zone-hiding-modeline (&rest body)
+  `(let (bg mode-line-fg mode-line-bg mode-line-box)
+     (unwind-protect
+         (progn
+           (when (and (= 0 (get 'zone 'modeline-hidden-level))
+                      (display-color-p))
+             (setq bg (face-background 'default)
+                   mode-line-box (face-attribute 'mode-line :box)
+                   mode-line-fg (face-attribute 'mode-line :foreground)
+                   mode-line-bg (face-attribute 'mode-line :background))
+             (set-face-attribute 'mode-line nil
+                                 :foreground bg
+                                 :background bg
+                                 :box nil))
+           (put 'zone 'modeline-hidden-level
+                (1+ (get 'zone 'modeline-hidden-level)))
+           ,@body)
+       (put 'zone 'modeline-hidden-level
+            (1- (get 'zone 'modeline-hidden-level)))
+       (when (and (> 1 (get 'zone 'modeline-hidden-level))
+                  mode-line-fg)
+         (set-face-attribute 'mode-line nil
+                             :foreground mode-line-fg
+                             :background mode-line-bg
+                             :box mode-line-box)))))
+
+(defun zone-call (program &optional timeout)
+  "Call PROGRAM in a zoned way.
+If PROGRAM is a function, call it, interrupting after the amount
+ of time in seconds specified by optional arg TIMEOUT, or `zone-timeout'
+ if unspecified, q.v.
+PROGRAM can also be a list of elements, which are interpreted like so:
+If the element is a function or a list of a function and a number,
+ apply `zone-call' recursively."
+  (cond ((functionp program)
+         (with-timeout ((or timeout zone-timeout (ash 1 26)))
+           (funcall program)))
+        ((listp program)
+         (mapcar (lambda (elem)
+                   (cond ((functionp elem) (zone-call elem))
+                         ((and (listp elem)
+                               (functionp (car elem))
+                               (numberp (cadr elem)))
+                          (apply 'zone-call elem))
+                         (t (error "bad `zone-call' elem:" elem))))
+                 program))))
+
 ;;;###autoload
 (defun zone ()
   "Zone out, completely."
@@ -89,6 +141,7 @@
         (wp (1+ (- (window-point (selected-window))
                    (window-start)))))
     (put 'zone 'orig-buffer (current-buffer))
+    (put 'zone 'modeline-hidden-level 0)
     (set-buffer outbuf)
     (setq mode-name "Zone")
     (erase-buffer)
@@ -112,7 +165,7 @@
             ;; input before zoning out.
             (if (input-pending-p)
                 (discard-input))
-            (funcall pgm)
+            (zone-call pgm)
             (message "Zoning...sorry"))
         (error
          (while (not (input-pending-p))
@@ -149,10 +202,10 @@
 
 (defun zone-shift-up ()
   (let* ((b (point))
-         (e (progn
-              (end-of-line)
-              (if (looking-at "\n") (1+ (point)) (point))))
-         (s (buffer-substring b e)))
+         (e (progn
+              (end-of-line)
+              (if (looking-at "\n") (1+ (point)) (point))))
+         (s (buffer-substring b e)))
     (delete-region b e)
     (goto-char (point-max))
     (insert s)))
@@ -162,10 +215,10 @@
   (forward-line -1)
   (beginning-of-line)
   (let* ((b (point))
-         (e (progn
-              (end-of-line)
-              (if (looking-at "\n") (1+ (point)) (point))))
-         (s (buffer-substring b e)))
+         (e (progn
+              (end-of-line)
+              (if (looking-at "\n") (1+ (point)) (point))))
+         (s (buffer-substring b e)))
     (delete-region b e)
     (goto-char (point-min))
     (insert s)))
@@ -173,20 +226,20 @@
 (defun zone-shift-left ()
   (while (not (eobp))
     (or (eolp)
-        (let ((c (following-char)))
-          (delete-char 1)
-          (end-of-line)
-          (insert c)))
+        (let ((c (following-char)))
+          (delete-char 1)
+          (end-of-line)
+          (insert c)))
     (forward-line 1)))
 
 (defun zone-shift-right ()
   (while (not (eobp))
     (end-of-line)
     (or (bolp)
-        (let ((c (preceding-char)))
-          (delete-backward-char 1)
-          (beginning-of-line)
-          (insert c)))
+        (let ((c (preceding-char)))
+          (delete-backward-char 1)
+          (beginning-of-line)
+          (insert c)))
     (forward-line 1)))
 
 (defun zone-pgm-jitter ()
@@ -216,14 +269,14 @@
   (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
     (while (not (input-pending-p))
       (let ((i 48))
-        (while (< i 122)
-          (aset tbl i (+ 48 (random (- 123 48))))
-          (setq i (1+ i)))
-        (translate-region (point-min) (point-max) tbl)
-        (sit-for 0 2)))))
+        (while (< i 122)
+          (aset tbl i (+ 48 (random (- 123 48))))
+          (setq i (1+ i)))
+        (translate-region (point-min) (point-max) tbl)
+        (sit-for 0 2)))))
 
 (put 'zone-pgm-whack-chars 'wc-tbl
-     (let ((tbl (make-vector 128 ?x))
+     (let ((tbl (make-string 128 ?x))
            (i 0))
        (while (< i 128)
          (aset tbl i i)
@@ -237,17 +290,17 @@
     (while working
       (setq working nil)
       (save-excursion
-        (goto-char (point-min))
-        (while (not (eobp))
-          (if (looking-at "[^(){}\n\t ]")
-              (let ((n (random 5)))
-                (if (not (= n 0))
-                    (progn
-                      (setq working t)
-                      (forward-char 1))
-                  (delete-char 1)
-                  (insert " ")))
-            (forward-char 1))))
+        (goto-char (point-min))
+        (while (not (eobp))
+          (if (looking-at "[^(){}\n\t ]")
+              (let ((n (random 5)))
+                (if (not (= n 0))
+                    (progn
+                      (setq working t)
+                      (forward-char 1))
+                  (delete-char 1)
+                  (insert " ")))
+            (forward-char 1))))
       (sit-for 0 2))))
 
 (defun zone-pgm-dissolve ()
@@ -261,14 +314,14 @@
   (let ((i 0))
     (while (< i 20)
       (save-excursion
-        (goto-char (point-min))
-        (while (not (eobp))
-          (if (looking-at "[^*\n\t ]")
-              (let ((n (random 5)))
-                (if (not (= n 0))
-                    (forward-char 1))
-                (insert " ")))
-          (forward-char 1)))
+        (goto-char (point-min))
+        (while (not (eobp))
+          (if (looking-at "[^*\n\t ]")
+              (let ((n (random 5)))
+                (if (not (= n 0))
+                    (forward-char 1))
+                (insert " ")))
+          (forward-char 1)))
       (setq i (1+ i))
       (sit-for 0 2)))
   (zone-pgm-jitter))
@@ -285,25 +338,25 @@
 ;; less interesting effect than you might imagine.
 (defun zone-pgm-2nd-putz-with-case ()
   (let ((tbl (make-string 128 ?x))
-        (i 0))
+        (i 0))
     (while (< i 128)
       (aset tbl i i)
       (setq i (1+ i)))
     (while (not (input-pending-p))
       (setq i ?a)
       (while (<= i ?z)
-        (aset tbl i
-              (if (zerop (random 5))
-                  (upcase i)
-                (downcase i)))
-        (setq i (+ i (1+ (random 5)))))
+        (aset tbl i
+              (if (zerop (random 5))
+                  (upcase i)
+                (downcase i)))
+        (setq i (+ i (1+ (random 5)))))
       (setq i ?A)
       (while (<= i ?z)
-        (aset tbl i
-              (if (zerop (random 5))
-                  (downcase i)
-                (upcase i)))
-        (setq i (+ i (1+ (random 5)))))
+        (aset tbl i
+              (if (zerop (random 5))
+                  (downcase i)
+                (upcase i)))
+        (setq i (+ i (1+ (random 5)))))
       (translate-region (point-min) (point-max) tbl)
       (sit-for 0 2))))
 
@@ -311,18 +364,18 @@
   (goto-char (point-min))
   (while (not (input-pending-p))
     (let ((np (+ 2 (random 5)))
-          (pm (point-max)))
+          (pm (point-max)))
       (while (< np pm)
-        (goto-char np)
+        (goto-char np)
         (let ((prec (preceding-char))
               (props (text-properties-at (1- (point)))))
           (insert (if (zerop (random 2))
                       (upcase prec)
                     (downcase prec)))
           (set-text-properties (1- (point)) (point) props))
-        (backward-char 2)
-        (delete-char 1)
-        (setq np (+ np (1+ (random 5))))))
+        (backward-char 2)
+        (delete-char 1)
+        (setq np (+ np (1+ (random 5))))))
     (goto-char (point-min))
     (sit-for 0 2)))
 
@@ -334,9 +387,9 @@
     (save-excursion
       (goto-char (window-start))
       (while (< (point) (window-end))
-        (when (looking-at "[\t ]*\\([^\n]+\\)")
-          (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret)))
-        (forward-line 1)))
+        (when (looking-at "[\t ]*\\([^\n]+\\)")
+          (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret)))
+        (forward-line 1)))
     ret))
 
 (defun zone-pgm-rotate (&optional random-style)
@@ -413,7 +466,7 @@
 (defun zone-fall-through-ws (c col wend)
   (let ((fall-p nil)                    ; todo: move outward
         (wait 0.15)
-        (o (point))                  ; for terminals w/o cursor hiding
+        (o (point))                     ; for terminals w/o cursor hiding
         (p (point)))
     (while (progn
              (forward-line 1)
@@ -447,15 +500,14 @@
           (delete-char (- ww cc))))
       (unless (eobp)
         (forward-char 1)))
-    ;; what the hell is going on here?
+    ;; pad ws past bottom of screen
     (let ((nl (- wh (count-lines (point-min) (point)))))
       (when (> nl 0)
         (let ((line (concat (make-string (1- ww) ? ) "\n")))
           (do ((i 0 (1+ i)))
               ((= i nl))
             (insert line)))))
-    ;;
-    (catch 'done ;; ugh
+    (catch 'done
       (while (not (input-pending-p))
         (goto-char (point-min))
         (sit-for 0)
@@ -526,48 +578,50 @@
 
 (defun zone-pgm-stress ()
   (goto-char (point-min))
-  (let (lines bg mode-line-fg mode-line-bg mode-line-box)
+  (let (lines)
     (while (< (point) (point-max))
       (let ((p (point)))
         (forward-line 1)
         (setq lines (cons (buffer-substring p (point)) lines))))
     (sit-for 5)
-    (unwind-protect
-        (progn
-          (when (display-color-p)
-            (setq bg (face-background 'default)
-                  mode-line-box (face-attribute 'mode-line :box)
-                  mode-line-fg (face-attribute 'mode-line :foreground)
-                  mode-line-bg (face-attribute 'mode-line :background))
-            (set-face-attribute 'mode-line nil
-                                :foreground bg
-                                :background bg
-                                :box nil))
-
-          (let ((msg "Zoning... (zone-pgm-stress)"))
-            (while (not (string= msg ""))
-              (message (setq msg (substring msg 1)))
-              (sit-for 0.05)))
-
-          (while (not (input-pending-p))
-            (when (< 50 (random 100))
-              (goto-char (point-max))
-              (forward-line -1)
-              (unless (eobp)
-                (let ((kill-whole-line t))
-                  (kill-line)))
-              (goto-char (point-min))
-              (when lines
-                (insert (nth (random (1- (length lines))) lines))))
-            (message (concat (make-string (random (- (frame-width) 5)) ? )
-                             "grrr"))
-            (sit-for 0.1)))
-      (when mode-line-fg
-        (set-face-attribute 'mode-line nil
-                            :foreground mode-line-fg
-                            :background mode-line-bg
-                            :box mode-line-box)))))
-
+    (zone-hiding-modeline
+     (let ((msg "Zoning... (zone-pgm-stress)"))
+       (while (not (string= msg ""))
+         (message (setq msg (substring msg 1)))
+         (sit-for 0.05)))
+     (while (not (input-pending-p))
+       (when (< 50 (random 100))
+         (goto-char (point-max))
+         (forward-line -1)
+         (let ((kill-whole-line t))
+           (kill-line))
+         (goto-char (point-min))
+         (insert (nth (random (length lines)) lines)))
+       (message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))
+       (sit-for 0.1)))))
+
+
+;;;; zone-pgm-stress-destress
+
+(defun zone-pgm-stress-destress ()
+  (zone-call 'zone-pgm-stress 25)
+  (zone-hiding-modeline
+   (sit-for 3)
+   (erase-buffer)
+   (sit-for 3)
+   (insert-buffer "*Messages*")
+   (message "")
+   (goto-char (point-max))
+   (recenter -1)
+   (sit-for 3)
+   (delete-region (point-min) (window-start))
+   (message "hey why stress out anyway?")
+   (zone-call '((zone-pgm-rotate         30)
+                (zone-pgm-whack-chars    10)
+                zone-pgm-drip))))
+
+
+;;;;;;;;;;;;;;;
 (provide 'zone)
 
 ;;; zone.el ends here