[Emacs-diffs] /srv/bzr/emacs/trunk r100739: Minor zone.el fixes for bug#6483.

[Glenn Morris]

------------------------------------------------------------
revno: 100739
committer: Glenn Morris <address@hidden>
branch nick: trunk
timestamp: Tue 2010-07-06 21:16:27 -0700
message:
  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.
modified:
  lisp/ChangeLog
  lisp/play/zone.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-07-05 17:54:13 +0000
+++ b/lisp/ChangeLog    2010-07-07 04:16:27 +0000
@@ -1,3 +1,17 @@
+2010-07-07  Glenn Morris  <address@hidden>
+
+       * 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.
+
 2010-07-05  Chong Yidong  <address@hidden>
 
        * menu-bar.el (menu-bar-mode):

=== modified file 'lisp/play/zone.el'
--- a/lisp/play/zone.el 2010-01-13 08:35:10 +0000
+++ b/lisp/play/zone.el 2010-07-07 04:16:27 +0000
@@ -1,7 +1,7 @@
 ;;; 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, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;;   2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: Victor Zandy <address@hidden>
 ;; Maintainer: Thien-Thi Nguyen <address@hidden>
@@ -40,10 +40,6 @@
 
 ;;; 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.")
 
@@ -210,19 +206,20 @@
     (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)))
@@ -348,15 +345,8 @@
     (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)))
@@ -365,13 +355,14 @@
 ;;;; 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)
@@ -404,6 +395,7 @@
             (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))
@@ -447,19 +439,19 @@
          (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)
@@ -473,8 +465,7 @@
     (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)
@@ -587,11 +578,12 @@
 
 (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
      (let ((msg "Zoning... (zone-pgm-stress)"))
@@ -671,7 +663,8 @@
       (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))