From: Gerd Moellmann <gerd@gnu.org>
Date: Fri, 3 Aug 2001 12:28:18 +0000 (+0000)
Subject: (zone-pgm-stress): Use unwind-protect to make sure
X-Git-Tag: emacs-pretest-21.0.105~296
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b0fa1513a6ea9ecfa3e0f5510cfa3d5cba585b72;p=emacs.git

(zone-pgm-stress): Use unwind-protect to make sure
the mode-line face is restored.  Fix several bugs.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 239db44d00a..f19240b8840 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 2001-08-03  Gerd Moellmann  <gerd@gnu.org>
 
+	* play/zone.el (zone-pgm-stress): Use unwind-protect to make sure
+	the mode-line face is restored.  Fix several bugs.
+
 	* replace.el (perform-replace): Doc fix.
 
 2001-08-02  Francesco Potorti`  <pot@gnu.org>
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 90e9361c580..5bc87faef10 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,6 +1,6 @@
 ;;; zone.el --- idle display hacks
 
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
 
 ;; Author: Victor Zandy <zandy@cs.wisc.edu>
 ;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
@@ -526,35 +526,47 @@
 
 (defun zone-pgm-stress ()
   (goto-char (point-min))
-  (let (lines bg m-fg m-bg)
+  (let (lines bg mode-line-fg mode-line-bg mode-line-box)
     (while (< (point) (point-max))
       (let ((p (point)))
         (forward-line 1)
         (setq lines (cons (buffer-substring p (point)) lines))))
     (sit-for 5)
-    (when (display-color-p)
-      (setq bg (frame-parameter (selected-frame) 'background-color)
-            m-fg (face-foreground 'modeline)
-            m-bg (face-background 'modeline))
-      (set-face-foreground 'modeline bg)
-      (set-face-background 'modeline bg))
-    (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))
-    (when (display-color-p)
-      (set-face-foreground 'modeline m-fg)
-      (set-face-background 'modeline m-bg))))
+    (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)))))
 
 (provide 'zone)