;;; zone.el --- idle display hacks
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Victor Zandy <zandy@cs.wisc.edu>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
;; Bored by the zone pyrotechnics? Write your own! Add it to
;; `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, Juri Linkov,
;; Luigi Panzeri, John Paul Wallington.
;;; Code:
-(require 'timer)
-(require 'tabify)
-(eval-when-compile (require 'cl))
-
(defvar zone-timer nil
"The timer we use to decide when to zone out, or nil if none.")
(defvar zone-timeout nil
- "*Seconds to timeout the zoning.
+ "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
`(with-current-buffer (get 'zone 'orig-buffer)
,@body))
-(defmacro zone-hiding-modeline (&rest body)
+(defmacro zone-hiding-mode-line (&rest body)
;; This formerly worked by temporarily altering face `mode-line',
;; which did not even work right, it seems.
`(let (mode-line-format)
(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)
(insert s)))
(defun zone-shift-left ()
- (let (s)
+ (let ((inhibit-point-motion-hooks t)
+ s)
(while (not (eobp))
(unless (eolp)
(setq s (buffer-substring (point) (1+ (point))))
(delete-char 1)
(end-of-line)
(insert s))
- (forward-char 1))))
+ (ignore-errors (forward-char 1)))))
(defun zone-shift-right ()
(goto-char (point-max))
- (end-of-line)
- (let (s)
+ (let ((inhibit-point-motion-hooks t)
+ s)
(while (not (bobp))
(unless (bolp)
(setq s (buffer-substring (1- (point)) (point)))
(let ((np (+ 2 (random 5)))
(pm (point-max)))
(while (< np pm)
- (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)
+ (funcall (if (zerop (random 2)) 'upcase-region
+ 'downcase-region) (1- np) np)
(setq np (+ np (1+ (random 5))))))
(goto-char (point-min))
(sit-for 0 2)))
;;;; rotating
(defun zone-line-specs ()
- (let (ret)
+ (let ((ok t)
+ ret)
(save-excursion
(goto-char (window-start))
- (while (< (point) (window-end))
+ (while (and ok (< (point) (window-end)))
(when (looking-at "[\t ]*\\([^\n]+\\)")
(setq ret (cons (cons (match-beginning 1) (match-end 1)) ret)))
- (forward-line 1)))
+ (setq ok (zerop (forward-line 1)))))
ret))
(defun zone-pgm-rotate (&optional random-style)
(setq cut 1 paste 2)
(setq cut 2 paste 1))
(goto-char (aref ent cut))
+ (setq aamt (min aamt (- (point-max) (point))))
(setq txt (buffer-substring (point) (+ (point) aamt)))
(delete-char aamt)
(goto-char (aref ent paste))
(hmm (cond
((string-match "[a-z]" c-string) (upcase c-string))
((string-match "[A-Z]" c-string) (downcase c-string))
- (t (propertize " " 'display `(space :width ,cw-ceil))))))
- (do ((i 0 (1+ i))
- (wait 0.5 (* wait 0.8)))
- ((= i 20))
+ (t (propertize " " 'display `(space :width ,cw-ceil)))))
+ (wait 0.5))
+ (dotimes (i 20)
(goto-char pos)
(delete-char 1)
(insert (if (= 0 (% i 2)) hmm c-string))
- (zone-park/sit-for wbeg wait))
+ (zone-park/sit-for wbeg (setq wait (* wait 0.8))))
(delete-char -1) (insert c-string)))
(defun zone-fill-out-screen (width height)
(let ((start (window-start))
- (line (make-string width 32)))
+ (line (make-string width 32))
+ (inhibit-point-motion-hooks t))
(goto-char start)
;; fill out rectangular ws block
(while (progn (end-of-line)
(let ((nl (- height (count-lines (point-min) (point)))))
(when (> nl 0)
(setq line (concat line "\n"))
- (do ((i 0 (1+ i)))
- ((= i nl))
+ (dotimes (i nl)
(insert line))))
(goto-char start)
(recenter 0)
(defun zone-pgm-stress ()
(goto-char (point-min))
- (let (lines)
- (while (< (point) (point-max))
+ (let ((ok t)
+ lines)
+ (while (and ok (< (point) (point-max)))
(let ((p (point)))
- (forward-line 1)
- (setq lines (cons (buffer-substring p (point)) lines))))
+ (setq ok (zerop (forward-line 1))
+ lines (cons (buffer-substring p (point)) lines))))
(sit-for 5)
- (zone-hiding-modeline
+ (zone-hiding-mode-line
(let ((msg "Zoning... (zone-pgm-stress)"))
(while (not (string= msg ""))
(message (setq msg (substring msg 1)))
(when (< 50 (random 100))
(goto-char (point-max))
(forward-line -1)
- (let ((kill-whole-line t))
- (kill-line))
+ (delete-region (point) (line-beginning-position 2))
(goto-char (point-min))
(insert (nth (random (length lines)) lines)))
(message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))
(defun zone-pgm-stress-destress ()
(zone-call 'zone-pgm-stress 25)
- (zone-hiding-modeline
+ (zone-hiding-mode-line
(sit-for 3)
(erase-buffer)
(sit-for 3)
;;;; the lyfe so short the craft so long to lerne --chaucer
(defvar zone-pgm-random-life-wait nil
- "*Seconds to wait between successive `life' generations.
+ "Seconds to wait between successive `life' generations.
If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
+(defvar life-patterns) ; from life.el
+
(defun zone-pgm-random-life ()
(require 'life)
(zone-fill-out-screen (1- (window-width)) (1- (window-height)))
(setq c (point))
(move-to-column 9)
(setq col (cons (buffer-substring (point) c) col))
- (end-of-line 0)
+; (let ((inhibit-point-motion-hooks t))
+ (end-of-line 0);)
(forward-char -10))
(let ((life-patterns (vector
(if (and col (search-forward "@" max t))
;;;;;;;;;;;;;;;
(provide 'zone)
-;; arch-tag: 7092503d-74a9-4325-a55c-a026ede58cea
;;; zone.el ends here
HCoop / bpt / emacs.git / blobdiff