(require 'tabify)
(eval-when-compile (require 'cl))
-(defvar zone-timer nil)
-
(defvar zone-idle 20
"*Seconds to idle before zoning out.")
(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")
(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"))
(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)))
(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)))
(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 ()
;;;; 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
(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 ()
(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))
;; 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))))
(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)))
(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))
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 ()
((= i nl))
(insert line)))))
;;
- (catch 'done ; ugh
+ (catch 'done; ugh
(while (not (input-pending-p))
(goto-char (point-min))
(sit-for 0)
(provide 'zone)
;;; zone.el ends here
-
projects / emacs.git / commitdiff