Mercurial > emacs
diff lisp/play/zone.el @ 32348:abc299ad3386
(zone-timer, zone-wc-tbl): Rework
these vars as symbol properties.
(zone, zone-when-idle, zone-leave-me-alone,
zone-pgm-whack-chars): Use new symbol properties.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Tue, 10 Oct 2000 01:57:04 +0000 |
parents | abcc7a8d4fe4 |
children | 67b464da13ec |
line wrap: on
line diff
--- a/lisp/play/zone.el Tue Oct 10 01:36:36 2000 +0000 +++ b/lisp/play/zone.el Tue Oct 10 01:57:04 2000 +0000 @@ -44,8 +44,6 @@ (require 'tabify) (eval-when-compile (require 'cl)) -(defvar zone-timer nil) - (defvar zone-idle 20 "*Seconds to idle before zoning out.") @@ -82,13 +80,14 @@ (defun zone () "Zone out, completely." (interactive) - (and (timerp zone-timer) (cancel-timer zone-timer)) - (setq zone-timer nil) + (let ((timer (get 'zone 'timer))) + (and (timerp timer) (cancel-timer timer))) + (put 'zone 'timer nil) (let ((f (selected-frame)) (outbuf (get-buffer-create "*zone*")) - (text (buffer-substring (window-start) (window-end))) - (wp (1+ (- (window-point (selected-window)) - (window-start))))) + (text (buffer-substring (window-start) (window-end))) + (wp (1+ (- (window-point (selected-window)) + (window-start))))) (put 'zone 'orig-buffer (current-buffer)) (set-buffer outbuf) (setq mode-name "Zone") @@ -104,47 +103,45 @@ (ct (and f (frame-parameter f 'cursor-type)))) (when ct (modify-frame-parameters f '((cursor-type . (bar . 0))))) (condition-case nil - (progn + (progn (message "Zoning... (%s)" pgm) - (garbage-collect) - ;; If some input is pending, zone says "sorry", which - ;; isn't nice; this might happen e.g. when they invoke the - ;; game by clicking the menu bar. So discard any pending - ;; input before zoning out. - (if (input-pending-p) - (discard-input)) - (funcall pgm) - (message "Zoning...sorry")) - (error - (while (not (input-pending-p)) - (message (format "We were zoning when we wrote %s..." pgm)) - (sit-for 3) - (message "...here's hoping we didn't hose your buffer!") - (sit-for 3))) - (quit (ding) (message "Zoning...sorry"))) + (garbage-collect) + ;; If some input is pending, zone says "sorry", which + ;; isn't nice; this might happen e.g. when they invoke the + ;; game by clicking the menu bar. So discard any pending + ;; input before zoning out. + (if (input-pending-p) + (discard-input)) + (funcall pgm) + (message "Zoning...sorry")) + (error + (while (not (input-pending-p)) + (message (format "We were zoning when we wrote %s..." pgm)) + (sit-for 3) + (message "...here's hoping we didn't hose your buffer!") + (sit-for 3))) + (quit (ding) (message "Zoning...sorry"))) (when ct (modify-frame-parameters f (list (cons 'cursor-type ct))))) (kill-buffer outbuf) (zone-when-idle zone-idle))) ;;;; Zone when idle, or not. -(defvar zone-timer nil - "Timer that zone sets to triggle idle zoning out. -If t, zone won't zone out.") - (defun zone-when-idle (secs) "Zone out when Emacs has been idle for SECS seconds." (interactive "nHow long before I start zoning (seconds): ") (or (<= secs 0) - (eq zone-timer t) - (timerp zone-timer) - (setq zone-timer (run-with-idle-timer secs t 'zone)))) + (let ((timer (get 'zone 'timer))) + (or (eq timer t) + (timerp timer))) + (put 'zone 'timer (run-with-idle-timer secs t 'zone)))) (defun zone-leave-me-alone () "Don't zone out when Emacs is idle." (interactive) - (and (timerp zone-timer) (cancel-timer zone-timer)) - (setq zone-timer t) + (let ((timer (get 'zone 'timer))) + (and (timerp timer) (cancel-timer timer))) + (put 'zone 'timer t) (message "I won't zone out any more")) @@ -152,10 +149,10 @@ (defun zone-shift-up () (let* ((b (point)) - (e (progn - (end-of-line) - (if (looking-at "\n") (1+ (point)) (point)))) - (s (buffer-substring b e))) + (e (progn + (end-of-line) + (if (looking-at "\n") (1+ (point)) (point)))) + (s (buffer-substring b e))) (delete-region b e) (goto-char (point-max)) (insert s))) @@ -165,10 +162,10 @@ (forward-line -1) (beginning-of-line) (let* ((b (point)) - (e (progn - (end-of-line) - (if (looking-at "\n") (1+ (point)) (point)))) - (s (buffer-substring b e))) + (e (progn + (end-of-line) + (if (looking-at "\n") (1+ (point)) (point)))) + (s (buffer-substring b e))) (delete-region b e) (goto-char (point-min)) (insert s))) @@ -176,20 +173,20 @@ (defun zone-shift-left () (while (not (eobp)) (or (eolp) - (let ((c (following-char))) - (delete-char 1) - (end-of-line) - (insert c))) +(let ((c (following-char))) + (delete-char 1) + (end-of-line) + (insert c))) (forward-line 1))) (defun zone-shift-right () (while (not (eobp)) (end-of-line) (or (bolp) - (let ((c (preceding-char))) - (delete-backward-char 1) - (beginning-of-line) - (insert c))) +(let ((c (preceding-char))) + (delete-backward-char 1) + (beginning-of-line) + (insert c))) (forward-line 1))) (defun zone-pgm-jitter () @@ -215,24 +212,23 @@ ;;;; zone-pgm-whack-chars -(defvar zone-wc-tbl - (let ((tbl (make-string 128 ?x)) - (i 0)) - (while (< i 128) - (aset tbl i i) - (setq i (1+ i))) - tbl)) - (defun zone-pgm-whack-chars () - (let ((tbl (copy-sequence zone-wc-tbl))) + (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) (while (not (input-pending-p)) (let ((i 48)) - (while (< i 122) - (aset tbl i (+ 48 (random (- 123 48)))) - (setq i (1+ i))) - (translate-region (point-min) (point-max) tbl) - (sit-for 0 2))))) +(while (< i 122) + (aset tbl i (+ 48 (random (- 123 48)))) + (setq i (1+ i))) +(translate-region (point-min) (point-max) tbl) +(sit-for 0 2))))) +(put 'zone-pgm-whack-chars 'wc-tbl + (let ((tbl (make-string 128 ?x)) + (i 0)) + (while (< i 128) + (aset tbl i i) + (setq i (1+ i))) + tbl)) ;;;; zone-pgm-dissolve @@ -241,17 +237,17 @@ (while working (setq working nil) (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "[^(){}\n\t ]") - (let ((n (random 5))) - (if (not (= n 0)) - (progn - (setq working t) - (forward-char 1)) - (delete-char 1) - (insert " "))) - (forward-char 1)))) +(goto-char (point-min)) +(while (not (eobp)) + (if (looking-at "[^(){}\n\t ]") + (let ((n (random 5))) +(if (not (= n 0)) + (progn + (setq working t) + (forward-char 1)) + (delete-char 1) + (insert " "))) + (forward-char 1)))) (sit-for 0 2)))) (defun zone-pgm-dissolve () @@ -265,14 +261,14 @@ (let ((i 0)) (while (< i 20) (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "[^*\n\t ]") - (let ((n (random 5))) - (if (not (= n 0)) - (forward-char 1)) - (insert " "))) - (forward-char 1))) +(goto-char (point-min)) +(while (not (eobp)) + (if (looking-at "[^*\n\t ]") + (let ((n (random 5))) +(if (not (= n 0)) + (forward-char 1)) + (insert " "))) + (forward-char 1))) (setq i (1+ i)) (sit-for 0 2))) (zone-pgm-jitter)) @@ -289,25 +285,25 @@ ;; less interesting effect than you might imagine. (defun zone-pgm-2nd-putz-with-case () (let ((tbl (make-string 128 ?x)) - (i 0)) +(i 0)) (while (< i 128) (aset tbl i i) (setq i (1+ i))) (while (not (input-pending-p)) (setq i ?a) (while (<= i ?z) - (aset tbl i - (if (zerop (random 5)) - (upcase i) - (downcase i))) - (setq i (+ i (1+ (random 5))))) +(aset tbl i + (if (zerop (random 5)) + (upcase i) +(downcase i))) +(setq i (+ i (1+ (random 5))))) (setq i ?A) (while (<= i ?z) - (aset tbl i - (if (zerop (random 5)) - (downcase i) - (upcase i))) - (setq i (+ i (1+ (random 5))))) +(aset tbl i + (if (zerop (random 5)) + (downcase i) +(upcase i))) +(setq i (+ i (1+ (random 5))))) (translate-region (point-min) (point-max) tbl) (sit-for 0 2)))) @@ -315,18 +311,18 @@ (goto-char (point-min)) (while (not (input-pending-p)) (let ((np (+ 2 (random 5))) - (pm (point-max))) + (pm (point-max))) (while (< np pm) - (goto-char np) +(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) - (setq np (+ np (1+ (random 5)))))) +(backward-char 2) +(delete-char 1) +(setq np (+ np (1+ (random 5)))))) (goto-char (point-min)) (sit-for 0 2))) @@ -338,14 +334,14 @@ (save-excursion (goto-char (window-start)) (while (< (point) (window-end)) - (when (looking-at "[\t ]*\\([^\n]+\\)") - (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) - (forward-line 1))) +(when (looking-at "[\t ]*\\([^\n]+\\)") + (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) +(forward-line 1))) ret)) (defun zone-pgm-rotate (&optional random-style) (let* ((specs (apply - 'vector + 'vector (let (res) (mapcar (lambda (ent) (let* ((beg (car ent)) @@ -362,22 +358,22 @@ res))))) (zone-line-specs)) res))) - (n (length specs)) - amt aamt cut paste txt i ent) + (n (length specs)) + amt aamt cut paste txt i ent) (while (not (input-pending-p)) (setq i 0) (while (< i n) - (setq ent (aref specs i)) - (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 txt (buffer-substring (point) (+ (point) aamt))) - (delete-char aamt) - (goto-char (aref ent paste)) - (insert txt) - (setq i (1+ i))) + (setq ent (aref specs i)) + (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 txt (buffer-substring (point) (+ (point) aamt))) + (delete-char aamt) + (goto-char (aref ent paste)) + (insert txt) + (setq i (1+ i))) (sit-for 0.04)))) (defun zone-pgm-rotate-LR-lockstep () @@ -459,7 +455,7 @@ ((= i nl)) (insert line))))) ;; - (catch 'done ; ugh + (catch 'done; ugh (while (not (input-pending-p)) (goto-char (point-min)) (sit-for 0) @@ -563,4 +559,3 @@ (provide 'zone) ;;; zone.el ends here -