Mercurial > emacs

changeset 109157:76b683a5339b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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.
author Glenn Morris <rgm@gnu.org>
date Tue, 06 Jul 2010 21:16:27 -0700
parents 32bdba8ef7f4
children 6175ebc3b6ce
files lisp/ChangeLog lisp/play/zone.el
diffstat 2 files changed, 42 insertions(+), 35 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Jul 06 20:09:30 2010 -0700
+++ b/lisp/ChangeLog	Tue Jul 06 21:16:27 2010 -0700
@@ -1,3 +1,17 @@
+2010-07-07  Glenn Morris  <rgm@gnu.org>
+
+	* 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  <cyd@stupidchicken.com>
 
 	* menu-bar.el (menu-bar-mode):
--- a/lisp/play/zone.el	Tue Jul 06 20:09:30 2010 -0700
+++ b/lisp/play/zone.el	Tue Jul 06 21:16:27 2010 -0700
@@ -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 <zandy@cs.wisc.edu>
 ;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
@@ -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))