30 |
;; If it eventually irritates you, try M-x zone-leave-me-alone. |
;; If it eventually irritates you, try M-x zone-leave-me-alone. |
31 |
|
|
32 |
;; Bored by the zone pyrotechnics? Write your own! Add it to |
;; Bored by the zone pyrotechnics? Write your own! Add it to |
33 |
;; `zone-programs'. |
;; `zone-programs'. See `zone-call' for higher-ordered zoning. |
34 |
|
|
35 |
;; WARNING: Not appropriate for Emacs sessions over modems or |
;; WARNING: Not appropriate for Emacs sessions over modems or |
36 |
;; computers as slow as mine. |
;; computers as slow as mine. |
37 |
|
|
38 |
;; THANKS: Christopher Mayer, Scott Flinchbaugh, Rachel Kalmar, |
;; THANKS: Christopher Mayer, Scott Flinchbaugh, Rachel Kalmar, |
39 |
;; Max Froumentin. |
;; Max Froumentin. |
40 |
|
|
41 |
;;; Code: |
;;; Code: |
42 |
|
|
47 |
(defvar zone-idle 20 |
(defvar zone-idle 20 |
48 |
"*Seconds to idle before zoning out.") |
"*Seconds to idle before zoning out.") |
49 |
|
|
50 |
|
(defvar zone-timeout nil |
51 |
|
"*Seconds to timeout the zoning. |
52 |
|
If nil, don't interrupt for about 1^26 seconds.") |
53 |
|
|
54 |
;; Vector of functions that zone out. `zone' will execute one of |
;; Vector of functions that zone out. `zone' will execute one of |
55 |
;; these functions, randomly chosen. The chosen function is invoked |
;; these functions, randomly chosen. The chosen function is invoked |
56 |
;; in the *zone* buffer, which contains the text of the selected |
;; in the *zone* buffer, which contains the text of the selected |
61 |
zone-pgm-jitter |
zone-pgm-jitter |
62 |
zone-pgm-putz-with-case |
zone-pgm-putz-with-case |
63 |
zone-pgm-dissolve |
zone-pgm-dissolve |
64 |
;; zone-pgm-explode |
;; zone-pgm-explode |
65 |
zone-pgm-whack-chars |
zone-pgm-whack-chars |
66 |
zone-pgm-rotate |
zone-pgm-rotate |
67 |
zone-pgm-rotate-LR-lockstep |
zone-pgm-rotate-LR-lockstep |
74 |
zone-pgm-martini-swan-dive |
zone-pgm-martini-swan-dive |
75 |
zone-pgm-paragraph-spaz |
zone-pgm-paragraph-spaz |
76 |
zone-pgm-stress |
zone-pgm-stress |
77 |
|
zone-pgm-stress-destress |
78 |
]) |
]) |
79 |
|
|
80 |
(defmacro zone-orig (&rest body) |
(defmacro zone-orig (&rest body) |
81 |
`(with-current-buffer (get 'zone 'orig-buffer) |
`(with-current-buffer (get 'zone 'orig-buffer) |
82 |
,@body)) |
,@body)) |
83 |
|
|
84 |
|
(defmacro zone-hiding-modeline (&rest body) |
85 |
|
`(let (bg mode-line-fg mode-line-bg mode-line-box) |
86 |
|
(unwind-protect |
87 |
|
(progn |
88 |
|
(when (and (= 0 (get 'zone 'modeline-hidden-level)) |
89 |
|
(display-color-p)) |
90 |
|
(setq bg (face-background 'default) |
91 |
|
mode-line-box (face-attribute 'mode-line :box) |
92 |
|
mode-line-fg (face-attribute 'mode-line :foreground) |
93 |
|
mode-line-bg (face-attribute 'mode-line :background)) |
94 |
|
(set-face-attribute 'mode-line nil |
95 |
|
:foreground bg |
96 |
|
:background bg |
97 |
|
:box nil)) |
98 |
|
(put 'zone 'modeline-hidden-level |
99 |
|
(1+ (get 'zone 'modeline-hidden-level))) |
100 |
|
,@body) |
101 |
|
(put 'zone 'modeline-hidden-level |
102 |
|
(1- (get 'zone 'modeline-hidden-level))) |
103 |
|
(when (and (> 1 (get 'zone 'modeline-hidden-level)) |
104 |
|
mode-line-fg) |
105 |
|
(set-face-attribute 'mode-line nil |
106 |
|
:foreground mode-line-fg |
107 |
|
:background mode-line-bg |
108 |
|
:box mode-line-box))))) |
109 |
|
|
110 |
|
(defun zone-call (program &optional timeout) |
111 |
|
"Call PROGRAM in a zoned way. |
112 |
|
If PROGRAM is a function, call it, interrupting after the amount |
113 |
|
of time in seconds specified by optional arg TIMEOUT, or `zone-timeout' |
114 |
|
if unspecified, q.v. |
115 |
|
PROGRAM can also be a list of elements, which are interpreted like so: |
116 |
|
If the element is a function or a list of a function and a number, |
117 |
|
apply `zone-call' recursively." |
118 |
|
(cond ((functionp program) |
119 |
|
(with-timeout ((or timeout zone-timeout (ash 1 26))) |
120 |
|
(funcall program))) |
121 |
|
((listp program) |
122 |
|
(mapcar (lambda (elem) |
123 |
|
(cond ((functionp elem) (zone-call elem)) |
124 |
|
((and (listp elem) |
125 |
|
(functionp (car elem)) |
126 |
|
(numberp (cadr elem))) |
127 |
|
(apply 'zone-call elem)) |
128 |
|
(t (error "bad `zone-call' elem:" elem)))) |
129 |
|
program)))) |
130 |
|
|
131 |
;;;###autoload |
;;;###autoload |
132 |
(defun zone () |
(defun zone () |
133 |
"Zone out, completely." |
"Zone out, completely." |
141 |
(wp (1+ (- (window-point (selected-window)) |
(wp (1+ (- (window-point (selected-window)) |
142 |
(window-start))))) |
(window-start))))) |
143 |
(put 'zone 'orig-buffer (current-buffer)) |
(put 'zone 'orig-buffer (current-buffer)) |
144 |
|
(put 'zone 'modeline-hidden-level 0) |
145 |
(set-buffer outbuf) |
(set-buffer outbuf) |
146 |
(setq mode-name "Zone") |
(setq mode-name "Zone") |
147 |
(erase-buffer) |
(erase-buffer) |
165 |
;; input before zoning out. |
;; input before zoning out. |
166 |
(if (input-pending-p) |
(if (input-pending-p) |
167 |
(discard-input)) |
(discard-input)) |
168 |
(funcall pgm) |
(zone-call pgm) |
169 |
(message "Zoning...sorry")) |
(message "Zoning...sorry")) |
170 |
(error |
(error |
171 |
(while (not (input-pending-p)) |
(while (not (input-pending-p)) |
202 |
|
|
203 |
(defun zone-shift-up () |
(defun zone-shift-up () |
204 |
(let* ((b (point)) |
(let* ((b (point)) |
205 |
(e (progn |
(e (progn |
206 |
(end-of-line) |
(end-of-line) |
207 |
(if (looking-at "\n") (1+ (point)) (point)))) |
(if (looking-at "\n") (1+ (point)) (point)))) |
208 |
(s (buffer-substring b e))) |
(s (buffer-substring b e))) |
209 |
(delete-region b e) |
(delete-region b e) |
210 |
(goto-char (point-max)) |
(goto-char (point-max)) |
211 |
(insert s))) |
(insert s))) |
215 |
(forward-line -1) |
(forward-line -1) |
216 |
(beginning-of-line) |
(beginning-of-line) |
217 |
(let* ((b (point)) |
(let* ((b (point)) |
218 |
(e (progn |
(e (progn |
219 |
(end-of-line) |
(end-of-line) |
220 |
(if (looking-at "\n") (1+ (point)) (point)))) |
(if (looking-at "\n") (1+ (point)) (point)))) |
221 |
(s (buffer-substring b e))) |
(s (buffer-substring b e))) |
222 |
(delete-region b e) |
(delete-region b e) |
223 |
(goto-char (point-min)) |
(goto-char (point-min)) |
224 |
(insert s))) |
(insert s))) |
226 |
(defun zone-shift-left () |
(defun zone-shift-left () |
227 |
(while (not (eobp)) |
(while (not (eobp)) |
228 |
(or (eolp) |
(or (eolp) |
229 |
(let ((c (following-char))) |
(let ((c (following-char))) |
230 |
(delete-char 1) |
(delete-char 1) |
231 |
(end-of-line) |
(end-of-line) |
232 |
(insert c))) |
(insert c))) |
233 |
(forward-line 1))) |
(forward-line 1))) |
234 |
|
|
235 |
(defun zone-shift-right () |
(defun zone-shift-right () |
236 |
(while (not (eobp)) |
(while (not (eobp)) |
237 |
(end-of-line) |
(end-of-line) |
238 |
(or (bolp) |
(or (bolp) |
239 |
(let ((c (preceding-char))) |
(let ((c (preceding-char))) |
240 |
(delete-backward-char 1) |
(delete-backward-char 1) |
241 |
(beginning-of-line) |
(beginning-of-line) |
242 |
(insert c))) |
(insert c))) |
243 |
(forward-line 1))) |
(forward-line 1))) |
244 |
|
|
245 |
(defun zone-pgm-jitter () |
(defun zone-pgm-jitter () |
269 |
(let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) |
(let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) |
270 |
(while (not (input-pending-p)) |
(while (not (input-pending-p)) |
271 |
(let ((i 48)) |
(let ((i 48)) |
272 |
(while (< i 122) |
(while (< i 122) |
273 |
(aset tbl i (+ 48 (random (- 123 48)))) |
(aset tbl i (+ 48 (random (- 123 48)))) |
274 |
(setq i (1+ i))) |
(setq i (1+ i))) |
275 |
(translate-region (point-min) (point-max) tbl) |
(translate-region (point-min) (point-max) tbl) |
276 |
(sit-for 0 2))))) |
(sit-for 0 2))))) |
277 |
|
|
278 |
(put 'zone-pgm-whack-chars 'wc-tbl |
(put 'zone-pgm-whack-chars 'wc-tbl |
279 |
(let ((tbl (make-vector 128 ?x)) |
(let ((tbl (make-string 128 ?x)) |
280 |
(i 0)) |
(i 0)) |
281 |
(while (< i 128) |
(while (< i 128) |
282 |
(aset tbl i i) |
(aset tbl i i) |
290 |
(while working |
(while working |
291 |
(setq working nil) |
(setq working nil) |
292 |
(save-excursion |
(save-excursion |
293 |
(goto-char (point-min)) |
(goto-char (point-min)) |
294 |
(while (not (eobp)) |
(while (not (eobp)) |
295 |
(if (looking-at "[^(){}\n\t ]") |
(if (looking-at "[^(){}\n\t ]") |
296 |
(let ((n (random 5))) |
(let ((n (random 5))) |
297 |
(if (not (= n 0)) |
(if (not (= n 0)) |
298 |
(progn |
(progn |
299 |
(setq working t) |
(setq working t) |
300 |
(forward-char 1)) |
(forward-char 1)) |
301 |
(delete-char 1) |
(delete-char 1) |
302 |
(insert " "))) |
(insert " "))) |
303 |
(forward-char 1)))) |
(forward-char 1)))) |
304 |
(sit-for 0 2)))) |
(sit-for 0 2)))) |
305 |
|
|
306 |
(defun zone-pgm-dissolve () |
(defun zone-pgm-dissolve () |
314 |
(let ((i 0)) |
(let ((i 0)) |
315 |
(while (< i 20) |
(while (< i 20) |
316 |
(save-excursion |
(save-excursion |
317 |
(goto-char (point-min)) |
(goto-char (point-min)) |
318 |
(while (not (eobp)) |
(while (not (eobp)) |
319 |
(if (looking-at "[^*\n\t ]") |
(if (looking-at "[^*\n\t ]") |
320 |
(let ((n (random 5))) |
(let ((n (random 5))) |
321 |
(if (not (= n 0)) |
(if (not (= n 0)) |
322 |
(forward-char 1)) |
(forward-char 1)) |
323 |
(insert " "))) |
(insert " "))) |
324 |
(forward-char 1))) |
(forward-char 1))) |
325 |
(setq i (1+ i)) |
(setq i (1+ i)) |
326 |
(sit-for 0 2))) |
(sit-for 0 2))) |
327 |
(zone-pgm-jitter)) |
(zone-pgm-jitter)) |
338 |
;; less interesting effect than you might imagine. |
;; less interesting effect than you might imagine. |
339 |
(defun zone-pgm-2nd-putz-with-case () |
(defun zone-pgm-2nd-putz-with-case () |
340 |
(let ((tbl (make-string 128 ?x)) |
(let ((tbl (make-string 128 ?x)) |
341 |
(i 0)) |
(i 0)) |
342 |
(while (< i 128) |
(while (< i 128) |
343 |
(aset tbl i i) |
(aset tbl i i) |
344 |
(setq i (1+ i))) |
(setq i (1+ i))) |
345 |
(while (not (input-pending-p)) |
(while (not (input-pending-p)) |
346 |
(setq i ?a) |
(setq i ?a) |
347 |
(while (<= i ?z) |
(while (<= i ?z) |
348 |
(aset tbl i |
(aset tbl i |
349 |
(if (zerop (random 5)) |
(if (zerop (random 5)) |
350 |
(upcase i) |
(upcase i) |
351 |
(downcase i))) |
(downcase i))) |
352 |
(setq i (+ i (1+ (random 5))))) |
(setq i (+ i (1+ (random 5))))) |
353 |
(setq i ?A) |
(setq i ?A) |
354 |
(while (<= i ?z) |
(while (<= i ?z) |
355 |
(aset tbl i |
(aset tbl i |
356 |
(if (zerop (random 5)) |
(if (zerop (random 5)) |
357 |
(downcase i) |
(downcase i) |
358 |
(upcase i))) |
(upcase i))) |
359 |
(setq i (+ i (1+ (random 5))))) |
(setq i (+ i (1+ (random 5))))) |
360 |
(translate-region (point-min) (point-max) tbl) |
(translate-region (point-min) (point-max) tbl) |
361 |
(sit-for 0 2)))) |
(sit-for 0 2)))) |
362 |
|
|
364 |
(goto-char (point-min)) |
(goto-char (point-min)) |
365 |
(while (not (input-pending-p)) |
(while (not (input-pending-p)) |
366 |
(let ((np (+ 2 (random 5))) |
(let ((np (+ 2 (random 5))) |
367 |
(pm (point-max))) |
(pm (point-max))) |
368 |
(while (< np pm) |
(while (< np pm) |
369 |
(goto-char np) |
(goto-char np) |
370 |
(let ((prec (preceding-char)) |
(let ((prec (preceding-char)) |
371 |
(props (text-properties-at (1- (point))))) |
(props (text-properties-at (1- (point))))) |
372 |
(insert (if (zerop (random 2)) |
(insert (if (zerop (random 2)) |
373 |
(upcase prec) |
(upcase prec) |
374 |
(downcase prec))) |
(downcase prec))) |
375 |
(set-text-properties (1- (point)) (point) props)) |
(set-text-properties (1- (point)) (point) props)) |
376 |
(backward-char 2) |
(backward-char 2) |
377 |
(delete-char 1) |
(delete-char 1) |
378 |
(setq np (+ np (1+ (random 5)))))) |
(setq np (+ np (1+ (random 5)))))) |
379 |
(goto-char (point-min)) |
(goto-char (point-min)) |
380 |
(sit-for 0 2))) |
(sit-for 0 2))) |
381 |
|
|
387 |
(save-excursion |
(save-excursion |
388 |
(goto-char (window-start)) |
(goto-char (window-start)) |
389 |
(while (< (point) (window-end)) |
(while (< (point) (window-end)) |
390 |
(when (looking-at "[\t ]*\\([^\n]+\\)") |
(when (looking-at "[\t ]*\\([^\n]+\\)") |
391 |
(setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) |
(setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) |
392 |
(forward-line 1))) |
(forward-line 1))) |
393 |
ret)) |
ret)) |
394 |
|
|
395 |
(defun zone-pgm-rotate (&optional random-style) |
(defun zone-pgm-rotate (&optional random-style) |
466 |
(defun zone-fall-through-ws (c col wend) |
(defun zone-fall-through-ws (c col wend) |
467 |
(let ((fall-p nil) ; todo: move outward |
(let ((fall-p nil) ; todo: move outward |
468 |
(wait 0.15) |
(wait 0.15) |
469 |
(o (point)) ; for terminals w/o cursor hiding |
(o (point)) ; for terminals w/o cursor hiding |
470 |
(p (point))) |
(p (point))) |
471 |
(while (progn |
(while (progn |
472 |
(forward-line 1) |
(forward-line 1) |
500 |
(delete-char (- ww cc)))) |
(delete-char (- ww cc)))) |
501 |
(unless (eobp) |
(unless (eobp) |
502 |
(forward-char 1))) |
(forward-char 1))) |
503 |
;; what the hell is going on here? |
;; pad ws past bottom of screen |
504 |
(let ((nl (- wh (count-lines (point-min) (point))))) |
(let ((nl (- wh (count-lines (point-min) (point))))) |
505 |
(when (> nl 0) |
(when (> nl 0) |
506 |
(let ((line (concat (make-string (1- ww) ? ) "\n"))) |
(let ((line (concat (make-string (1- ww) ? ) "\n"))) |
507 |
(do ((i 0 (1+ i))) |
(do ((i 0 (1+ i))) |
508 |
((= i nl)) |
((= i nl)) |
509 |
(insert line))))) |
(insert line))))) |
510 |
;; |
(catch 'done |
|
(catch 'done ;; ugh |
|
511 |
(while (not (input-pending-p)) |
(while (not (input-pending-p)) |
512 |
(goto-char (point-min)) |
(goto-char (point-min)) |
513 |
(sit-for 0) |
(sit-for 0) |
578 |
|
|
579 |
(defun zone-pgm-stress () |
(defun zone-pgm-stress () |
580 |
(goto-char (point-min)) |
(goto-char (point-min)) |
581 |
(let (lines bg mode-line-fg mode-line-bg mode-line-box) |
(let (lines) |
582 |
(while (< (point) (point-max)) |
(while (< (point) (point-max)) |
583 |
(let ((p (point))) |
(let ((p (point))) |
584 |
(forward-line 1) |
(forward-line 1) |
585 |
(setq lines (cons (buffer-substring p (point)) lines)))) |
(setq lines (cons (buffer-substring p (point)) lines)))) |
586 |
(sit-for 5) |
(sit-for 5) |
587 |
(unwind-protect |
(zone-hiding-modeline |
588 |
(progn |
(let ((msg "Zoning... (zone-pgm-stress)")) |
589 |
(when (display-color-p) |
(while (not (string= msg "")) |
590 |
(setq bg (face-background 'default) |
(message (setq msg (substring msg 1))) |
591 |
mode-line-box (face-attribute 'mode-line :box) |
(sit-for 0.05))) |
592 |
mode-line-fg (face-attribute 'mode-line :foreground) |
(while (not (input-pending-p)) |
593 |
mode-line-bg (face-attribute 'mode-line :background)) |
(when (< 50 (random 100)) |
594 |
(set-face-attribute 'mode-line nil |
(goto-char (point-max)) |
595 |
:foreground bg |
(forward-line -1) |
596 |
:background bg |
(let ((kill-whole-line t)) |
597 |
:box nil)) |
(kill-line)) |
598 |
|
(goto-char (point-min)) |
599 |
(let ((msg "Zoning... (zone-pgm-stress)")) |
(insert (nth (random (length lines)) lines))) |
600 |
(while (not (string= msg "")) |
(message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr")) |
601 |
(message (setq msg (substring msg 1))) |
(sit-for 0.1))))) |
602 |
(sit-for 0.05))) |
|
603 |
|
|
604 |
(while (not (input-pending-p)) |
;;;; zone-pgm-stress-destress |
605 |
(when (< 50 (random 100)) |
|
606 |
(goto-char (point-max)) |
(defun zone-pgm-stress-destress () |
607 |
(forward-line -1) |
(zone-call 'zone-pgm-stress 25) |
608 |
(unless (eobp) |
(zone-hiding-modeline |
609 |
(let ((kill-whole-line t)) |
(sit-for 3) |
610 |
(kill-line))) |
(erase-buffer) |
611 |
(goto-char (point-min)) |
(sit-for 3) |
612 |
(when lines |
(insert-buffer "*Messages*") |
613 |
(insert (nth (random (1- (length lines))) lines)))) |
(message "") |
614 |
(message (concat (make-string (random (- (frame-width) 5)) ? ) |
(goto-char (point-max)) |
615 |
"grrr")) |
(recenter -1) |
616 |
(sit-for 0.1))) |
(sit-for 3) |
617 |
(when mode-line-fg |
(delete-region (point-min) (window-start)) |
618 |
(set-face-attribute 'mode-line nil |
(message "hey why stress out anyway?") |
619 |
:foreground mode-line-fg |
(zone-call '((zone-pgm-rotate 30) |
620 |
:background mode-line-bg |
(zone-pgm-whack-chars 10) |
621 |
:box mode-line-box))))) |
zone-pgm-drip)))) |
622 |
|
|
623 |
|
|
624 |
|
;;;;;;;;;;;;;;; |
625 |
(provide 'zone) |
(provide 'zone) |
626 |
|
|
627 |
;;; zone.el ends here |
;;; zone.el ends here |