From b0fa1513a6ea9ecfa3e0f5510cfa3d5cba585b72 Mon Sep 17 00:00:00 2001 From: Gerd Moellmann Date: Fri, 3 Aug 2001 12:28:18 +0000 Subject: [PATCH] (zone-pgm-stress): Use unwind-protect to make sure the mode-line face is restored. Fix several bugs. --- lisp/ChangeLog | 3 +++ lisp/play/zone.el | 62 ++++++++++++++++++++++++++++------------------- 2 files changed, 40 insertions(+), 25 deletions(-) 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 + * 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` 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 ;; Maintainer: Thien-Thi Nguyen @@ -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) -- 2.39.2