emacs: lisp/play/zone.el comparison

comparison lisp/play/zone.el @ 109157:76b683a5339b

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	1d1d5d9bd884
children	60516122d066

comparison

equal deleted inserted replaced

-:32bdba8ef7f4
+:76b683a5339b
 ;;; zone.el --- idle display hacks
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;;   2009, 2010  Free Software Foundation, Inc.
 ;; Author: Victor Zandy <zandy@cs.wisc.edu>
 ;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
 ;; Keywords: games
 ;; Created: June 6, 1998
 ;; 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
 (delete-region b e)
 (goto-char (point-min))
 (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 ((inhibit-point-motion-hooks t)
-(let (s)
+s)
 (while (not (bobp))
 (unless (bolp)
 (setq s (buffer-substring (1- (point)) (point)))
 (delete-char -1)
 (beginning-of-line)
 (goto-char (point-min))
 (while (not (input-pending-p))
 (let ((np (+ 2 (random 5)))
 (pm (point-max)))
 (while (< np pm)
-(goto-char np)
+(funcall (if (zerop (random 2)) 'upcase-region
-(let ((prec (preceding-char))
+'downcase-region) (1- np) np)
-(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)
 (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)
 (let* ((specs (apply
 'vector
 (setq amt (aref ent 0) aamt (abs amt))
 (if (> 0 amt)
 (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))
 (insert txt)
 (setq i (1+ i)))
 (c-string (zone-cpos pos))
 (cw-ceil (ceiling (char-width (aref c-string 0))))
 (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))))))
+(t (propertize " " 'display `(space :width ,cw-ceil)))))
-(do ((i 0 (1+ i))
+(wait 0.5))
-(wait 0.5 (* wait 0.8)))
+(dotimes (i 20)
-((= 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 ((cc (current-column)))
 		    (if (< cc width)
 			  (t (forward-char 1) t)))))
 ;; pad ws past bottom of screen
 (let ((nl (- height (count-lines (point-min) (point)))))
 (when (> nl 0)
 	(setq line (concat line "\n"))
-	(do ((i 0 (1+ i)))
+(dotimes (i nl)
-	    ((= i nl))
 	  (insert line))))
 (goto-char start)
 (recenter 0)
 (sit-for 0)))
 ;;;; stressing and destressing
 (defun zone-pgm-stress ()
 (goto-char (point-min))
-(let (lines)
+(let ((ok t)
-(while (< (point) (point-max))
+lines)
+(while (and ok (< (point) (point-max)))
 (let ((p (point)))
-(forward-line 1)
+(setq ok (zerop (forward-line 1))
-(setq lines (cons (buffer-substring p (point)) lines))))
+lines (cons (buffer-substring p (point)) lines))))
 (sit-for 5)
 (zone-hiding-modeline
 (let ((msg "Zoning... (zone-pgm-stress)"))
 (while (not (string= msg ""))
 (message (setq msg (substring msg 1)))
 (goto-char bot)
 (while (< top (point))
 (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))
 (cons (make-string (length (car col)) 32) col)
 (list (mapconcat 'identity

Mercurial > emacs

comparison lisp/play/zone.el @ 109157:76b683a5339b