HCoop
/
bpt
/
emacs.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add 2012 to FSF copyright years for Emacs files
[bpt/emacs.git]
/
lisp
/
play
/
zone.el
diff --git
a/lisp/play/zone.el
b/lisp/play/zone.el
index
b8b4135
..
f1d42aa
100644
(file)
--- a/
lisp/play/zone.el
+++ b/
lisp/play/zone.el
@@
-1,7
+1,6
@@
;;; zone.el --- idle display hacks
;;; zone.el --- idle display hacks
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 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>
;; Author: Victor Zandy <zandy@cs.wisc.edu>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
@@
-10,10
+9,10
@@
;; This file is part of GNU Emacs.
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software
;
you can redistribute it and/or modify
+;; GNU Emacs is free software
:
you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation
; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation
, either version 3 of the License, or
+;;
(at your option)
any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@
-21,9
+20,7
@@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Commentary:
@@
-42,10
+39,6
@@
;;; Code:
;;; 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-timer nil
"The timer we use to decide when to zone out, or nil if none.")
@@
-212,19
+205,20
@@
If the element is a function or a list of a function and a number,
(insert s)))
(defun zone-shift-left ()
(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))
(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))
(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)))
(while (not (bobp))
(unless (bolp)
(setq s (buffer-substring (1- (point)) (point)))
@@
-350,15
+344,8
@@
If the element is a function or a list of a function and a number,
(let ((np (+ 2 (random 5)))
(pm (point-max)))
(while (< np pm)
(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)))
(setq np (+ np (1+ (random 5))))))
(goto-char (point-min))
(sit-for 0 2)))
@@
-367,13
+354,14
@@
If the element is a function or a list of a function and a number,
;;;; rotating
(defun zone-line-specs ()
;;;; rotating
(defun zone-line-specs ()
- (let (ret)
+ (let ((ok t)
+ ret)
(save-excursion
(goto-char (window-start))
(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)))
(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)
ret))
(defun zone-pgm-rotate (&optional random-style)
@@
-406,6
+394,7
@@
If the element is a function or a list of a function and a number,
(setq cut 1 paste 2)
(setq cut 2 paste 1))
(goto-char (aref ent cut))
(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))
(setq txt (buffer-substring (point) (+ (point) aamt)))
(delete-char aamt)
(goto-char (aref ent paste))
@@
-449,19
+438,19
@@
If the element is a function or a list of a function and a number,
(hmm (cond
((string-match "[a-z]" c-string) (upcase c-string))
((string-match "[A-Z]" c-string) (downcase c-string))
(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))
(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))
(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)
(goto-char start)
;; fill out rectangular ws block
(while (progn (end-of-line)
@@
-475,8
+464,7
@@
If the element is a function or a list of a function and a number,
(let ((nl (- height (count-lines (point-min) (point)))))
(when (> nl 0)
(setq line (concat line "\n"))
(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)
(insert line))))
(goto-char start)
(recenter 0)
@@
-489,8
+477,10
@@
If the element is a function or a list of a function and a number,
(wait 0.15)
newpos fall-p)
(while (when (save-excursion
(wait 0.15)
newpos fall-p)
(while (when (save-excursion
- (forward-line 1)
- (and (= col (current-column))
+ (and (zerop (forward-line 1))
+ (progn
+ (forward-char col)
+ (= col (current-column)))
(setq newpos (point))
(string= spaces (buffer-substring-no-properties
newpos (+ newpos cw-ceil)))
(setq newpos (point))
(string= spaces (buffer-substring-no-properties
newpos (+ newpos cw-ceil)))
@@
-589,11
+579,12
@@
If the element is a function or a list of a function and a number,
(defun zone-pgm-stress ()
(goto-char (point-min))
(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)))
(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
(let ((msg "Zoning... (zone-pgm-stress)"))
(sit-for 5)
(zone-hiding-modeline
(let ((msg "Zoning... (zone-pgm-stress)"))
@@
-635,6
+626,8
@@
If the element is a function or a list of a function and a number,
"*Seconds to wait between successive `life' generations.
If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
"*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)))
(defun zone-pgm-random-life ()
(require 'life)
(zone-fill-out-screen (1- (window-width)) (1- (window-height)))
@@
-673,7
+666,8
@@
If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(setq c (point))
(move-to-column 9)
(setq col (cons (buffer-substring (point) c) col))
(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))
(forward-char -10))
(let ((life-patterns (vector
(if (and col (search-forward "@" max t))
@@
-691,5
+685,4
@@
If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
;;;;;;;;;;;;;;;
(provide 'zone)
;;;;;;;;;;;;;;;
(provide 'zone)
-;; arch-tag: 7092503d-74a9-4325-a55c-a026ede58cea
;;; zone.el ends here
;;; zone.el ends here