aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2010-07-06 21:16:27 -0700
committerGlenn Morris2010-07-06 21:16:27 -0700
commita2c270e752d0aa13f98c4d3338a7565bb61ceba4 (patch)
treeed1ed5b91516e942a2f1e6a5d2977d5257462124
parent48fb68553ba2d2bc657fee2b04b24acb77b6f028 (diff)
downloademacs-a2c270e752d0aa13f98c4d3338a7565bb61ceba4.tar.gz
emacs-a2c270e752d0aa13f98c4d3338a7565bb61ceba4.zip
Minor zone.el fixes for bug#6483.
Zone did not like the intangible newlines etc in the gomoku buffer. * lisp/play/zone.el (top-level): Do not require timer, tabify, or cl. (zone-shift-left): Ignore intangibility, and any errors from forward-char. (zone-shift-right): Remove no-op end-of-line. Ignore intangibility. (zone-pgm-putz-with-case): Use upcase-region rather than inserting, deleting, and copying text properties. (zone-line-specs, zone-pgm-stress): Check forward-line exit status. (zone-pgm-rotate): Handle odd buffers like that of gomoku, where getting to point-max is hard. (zone-fret, zone-fill-out-screen): Replace cl's do with dotimes. (zone-fill-out-screen): Ignore intangibility.
-rw-r--r--lisp/ChangeLog14
-rw-r--r--lisp/play/zone.el63
2 files changed, 42 insertions, 35 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b2332cdd349..2214a6ba761 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
12010-07-07 Glenn Morris <rgm@gnu.org>
2
3 * play/zone.el (top-level): Do not require timer, tabify, or cl.
4 (zone-shift-left): Ignore intangibility, and any errors from
5 forward-char.
6 (zone-shift-right): Remove no-op end-of-line. Ignore intangibility.
7 (zone-pgm-putz-with-case): Use upcase-region rather than inserting,
8 deleting, and copying text properties.
9 (zone-line-specs, zone-pgm-stress): Check forward-line exit status.
10 (zone-pgm-rotate): Handle odd buffers like that of gomoku, where getting
11 to point-max is hard.
12 (zone-fret, zone-fill-out-screen): Replace cl's do with dotimes.
13 (zone-fill-out-screen): Ignore intangibility.
14
12010-07-05 Chong Yidong <cyd@stupidchicken.com> 152010-07-05 Chong Yidong <cyd@stupidchicken.com>
2 16
3 * menu-bar.el (menu-bar-mode): 17 * menu-bar.el (menu-bar-mode):
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 367c301de44..568d4cf2a19 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,7 +1,7 @@
1;;; zone.el --- idle display hacks 1;;; zone.el --- idle display hacks
2 2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Author: Victor Zandy <zandy@cs.wisc.edu> 6;; Author: Victor Zandy <zandy@cs.wisc.edu>
7;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org> 7;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
@@ -40,10 +40,6 @@
40 40
41;;; Code: 41;;; Code:
42 42
43(require 'timer)
44(require 'tabify)
45(eval-when-compile (require 'cl))
46
47(defvar zone-timer nil 43(defvar zone-timer nil
48 "The timer we use to decide when to zone out, or nil if none.") 44 "The timer we use to decide when to zone out, or nil if none.")
49 45
@@ -210,19 +206,20 @@ If the element is a function or a list of a function and a number,
210 (insert s))) 206 (insert s)))
211 207
212(defun zone-shift-left () 208(defun zone-shift-left ()
213 (let (s) 209 (let ((inhibit-point-motion-hooks t)
210 s)
214 (while (not (eobp)) 211 (while (not (eobp))
215 (unless (eolp) 212 (unless (eolp)
216 (setq s (buffer-substring (point) (1+ (point)))) 213 (setq s (buffer-substring (point) (1+ (point))))
217 (delete-char 1) 214 (delete-char 1)
218 (end-of-line) 215 (end-of-line)
219 (insert s)) 216 (insert s))
220 (forward-char 1)))) 217 (ignore-errors (forward-char 1)))))
221 218
222(defun zone-shift-right () 219(defun zone-shift-right ()
223 (goto-char (point-max)) 220 (goto-char (point-max))
224 (end-of-line) 221 (let ((inhibit-point-motion-hooks t)
225 (let (s) 222 s)
226 (while (not (bobp)) 223 (while (not (bobp))
227 (unless (bolp) 224 (unless (bolp)
228 (setq s (buffer-substring (1- (point)) (point))) 225 (setq s (buffer-substring (1- (point)) (point)))
@@ -348,15 +345,8 @@ If the element is a function or a list of a function and a number,
348 (let ((np (+ 2 (random 5))) 345 (let ((np (+ 2 (random 5)))
349 (pm (point-max))) 346 (pm (point-max)))
350 (while (< np pm) 347 (while (< np pm)
351 (goto-char np) 348 (funcall (if (zerop (random 2)) 'upcase-region
352 (let ((prec (preceding-char)) 349 'downcase-region) (1- np) np)
353 (props (text-properties-at (1- (point)))))
354 (insert (if (zerop (random 2))
355 (upcase prec)
356 (downcase prec)))
357 (set-text-properties (1- (point)) (point) props))
358 (backward-char 2)
359 (delete-char 1)
360 (setq np (+ np (1+ (random 5)))))) 350 (setq np (+ np (1+ (random 5))))))
361 (goto-char (point-min)) 351 (goto-char (point-min))
362 (sit-for 0 2))) 352 (sit-for 0 2)))
@@ -365,13 +355,14 @@ If the element is a function or a list of a function and a number,
365;;;; rotating 355;;;; rotating
366 356
367(defun zone-line-specs () 357(defun zone-line-specs ()
368 (let (ret) 358 (let ((ok t)
359 ret)
369 (save-excursion 360 (save-excursion
370 (goto-char (window-start)) 361 (goto-char (window-start))
371 (while (< (point) (window-end)) 362 (while (and ok (< (point) (window-end)))
372 (when (looking-at "[\t ]*\\([^\n]+\\)") 363 (when (looking-at "[\t ]*\\([^\n]+\\)")
373 (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) 364 (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret)))
374 (forward-line 1))) 365 (setq ok (zerop (forward-line 1)))))
375 ret)) 366 ret))
376 367
377(defun zone-pgm-rotate (&optional random-style) 368(defun zone-pgm-rotate (&optional random-style)
@@ -404,6 +395,7 @@ If the element is a function or a list of a function and a number,
404 (setq cut 1 paste 2) 395 (setq cut 1 paste 2)
405 (setq cut 2 paste 1)) 396 (setq cut 2 paste 1))
406 (goto-char (aref ent cut)) 397 (goto-char (aref ent cut))
398 (setq aamt (min aamt (- (point-max) (point))))
407 (setq txt (buffer-substring (point) (+ (point) aamt))) 399 (setq txt (buffer-substring (point) (+ (point) aamt)))
408 (delete-char aamt) 400 (delete-char aamt)
409 (goto-char (aref ent paste)) 401 (goto-char (aref ent paste))
@@ -447,19 +439,19 @@ If the element is a function or a list of a function and a number,
447 (hmm (cond 439 (hmm (cond
448 ((string-match "[a-z]" c-string) (upcase c-string)) 440 ((string-match "[a-z]" c-string) (upcase c-string))
449 ((string-match "[A-Z]" c-string) (downcase c-string)) 441 ((string-match "[A-Z]" c-string) (downcase c-string))
450 (t (propertize " " 'display `(space :width ,cw-ceil)))))) 442 (t (propertize " " 'display `(space :width ,cw-ceil)))))
451 (do ((i 0 (1+ i)) 443 (wait 0.5))
452 (wait 0.5 (* wait 0.8))) 444 (dotimes (i 20)
453 ((= i 20))
454 (goto-char pos) 445 (goto-char pos)
455 (delete-char 1) 446 (delete-char 1)
456 (insert (if (= 0 (% i 2)) hmm c-string)) 447 (insert (if (= 0 (% i 2)) hmm c-string))
457 (zone-park/sit-for wbeg wait)) 448 (zone-park/sit-for wbeg (setq wait (* wait 0.8))))
458 (delete-char -1) (insert c-string))) 449 (delete-char -1) (insert c-string)))
459 450
460(defun zone-fill-out-screen (width height) 451(defun zone-fill-out-screen (width height)
461 (let ((start (window-start)) 452 (let ((start (window-start))
462 (line (make-string width 32))) 453 (line (make-string width 32))
454 (inhibit-point-motion-hooks t))
463 (goto-char start) 455 (goto-char start)
464 ;; fill out rectangular ws block 456 ;; fill out rectangular ws block
465 (while (progn (end-of-line) 457 (while (progn (end-of-line)
@@ -473,8 +465,7 @@ If the element is a function or a list of a function and a number,
473 (let ((nl (- height (count-lines (point-min) (point))))) 465 (let ((nl (- height (count-lines (point-min) (point)))))
474 (when (> nl 0) 466 (when (> nl 0)
475 (setq line (concat line "\n")) 467 (setq line (concat line "\n"))
476 (do ((i 0 (1+ i))) 468 (dotimes (i nl)
477 ((= i nl))
478 (insert line)))) 469 (insert line))))
479 (goto-char start) 470 (goto-char start)
480 (recenter 0) 471 (recenter 0)
@@ -587,11 +578,12 @@ If the element is a function or a list of a function and a number,
587 578
588(defun zone-pgm-stress () 579(defun zone-pgm-stress ()
589 (goto-char (point-min)) 580 (goto-char (point-min))
590 (let (lines) 581 (let ((ok t)
591 (while (< (point) (point-max)) 582 lines)
583 (while (and ok (< (point) (point-max)))
592 (let ((p (point))) 584 (let ((p (point)))
593 (forward-line 1) 585 (setq ok (zerop (forward-line 1))
594 (setq lines (cons (buffer-substring p (point)) lines)))) 586 lines (cons (buffer-substring p (point)) lines))))
595 (sit-for 5) 587 (sit-for 5)
596 (zone-hiding-modeline 588 (zone-hiding-modeline
597 (let ((msg "Zoning... (zone-pgm-stress)")) 589 (let ((msg "Zoning... (zone-pgm-stress)"))
@@ -671,7 +663,8 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
671 (setq c (point)) 663 (setq c (point))
672 (move-to-column 9) 664 (move-to-column 9)
673 (setq col (cons (buffer-substring (point) c) col)) 665 (setq col (cons (buffer-substring (point) c) col))
674 (end-of-line 0) 666; (let ((inhibit-point-motion-hooks t))
667 (end-of-line 0);)
675 (forward-char -10)) 668 (forward-char -10))
676 (let ((life-patterns (vector 669 (let ((life-patterns (vector
677 (if (and col (search-forward "@" max t)) 670 (if (and col (search-forward "@" max t))