Mercurial > emacs
comparison lisp/play/zone.el @ 91041:bdb3fe0ba9fa
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 866-879)
- Merge multi-tty branch
- Update from CVS
- Merge from emacs--rel--22
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-257
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Thu, 11 Oct 2007 16:22:07 +0000 |
| parents | b83d0dadb2a7 a4806daa82af |
| children | 4bc33ffdda1a |
comparison
equal
deleted
inserted
replaced
| 91040:14c4a6aac623 | 91041:bdb3fe0ba9fa |
|---|---|
| 84 (defmacro zone-orig (&rest body) | 84 (defmacro zone-orig (&rest body) |
| 85 `(with-current-buffer (get 'zone 'orig-buffer) | 85 `(with-current-buffer (get 'zone 'orig-buffer) |
| 86 ,@body)) | 86 ,@body)) |
| 87 | 87 |
| 88 (defmacro zone-hiding-modeline (&rest body) | 88 (defmacro zone-hiding-modeline (&rest body) |
| 89 `(let (bg mode-line-fg mode-line-bg mode-line-box) | 89 ;; This formerly worked by temporarily altering face `mode-line', |
| 90 (unwind-protect | 90 ;; which did not even work right, it seems. |
| 91 (progn | 91 `(let (mode-line-format) |
| 92 (when (and (= 0 (get 'zone 'modeline-hidden-level)) | 92 ,@body)) |
| 93 (display-color-p)) | |
| 94 (setq bg (face-background 'default) | |
| 95 mode-line-box (face-attribute 'mode-line :box) | |
| 96 mode-line-fg (face-attribute 'mode-line :foreground) | |
| 97 mode-line-bg (face-attribute 'mode-line :background)) | |
| 98 (set-face-attribute 'mode-line nil | |
| 99 :foreground bg | |
| 100 :background bg | |
| 101 :box nil)) | |
| 102 (put 'zone 'modeline-hidden-level | |
| 103 (1+ (get 'zone 'modeline-hidden-level))) | |
| 104 ,@body) | |
| 105 (put 'zone 'modeline-hidden-level | |
| 106 (1- (get 'zone 'modeline-hidden-level))) | |
| 107 (when (and (> 1 (get 'zone 'modeline-hidden-level)) | |
| 108 mode-line-fg) | |
| 109 (set-face-attribute 'mode-line nil | |
| 110 :foreground mode-line-fg | |
| 111 :background mode-line-bg | |
| 112 :box mode-line-box))))) | |
| 113 | 93 |
| 114 (defun zone-call (program &optional timeout) | 94 (defun zone-call (program &optional timeout) |
| 115 "Call PROGRAM in a zoned way. | 95 "Call PROGRAM in a zoned way. |
| 116 If PROGRAM is a function, call it, interrupting after the amount | 96 If PROGRAM is a function, call it, interrupting after the amount |
| 117 of time in seconds specified by optional arg TIMEOUT, or `zone-timeout' | 97 of time in seconds specified by optional arg TIMEOUT, or `zone-timeout' |
| 156 (set-window-start (selected-window) (point-min)) | 136 (set-window-start (selected-window) (point-min)) |
| 157 (set-window-point (selected-window) wp) | 137 (set-window-point (selected-window) wp) |
| 158 (sit-for 0 500) | 138 (sit-for 0 500) |
| 159 (let ((pgm (elt zone-programs (random (length zone-programs)))) | 139 (let ((pgm (elt zone-programs (random (length zone-programs)))) |
| 160 (ct (and f (frame-parameter f 'cursor-type))) | 140 (ct (and f (frame-parameter f 'cursor-type))) |
| 141 (show-trailing-whitespace nil) | |
| 161 (restore (list '(kill-buffer outbuf)))) | 142 (restore (list '(kill-buffer outbuf)))) |
| 162 (when ct | 143 (when ct |
| 163 (modify-frame-parameters f '((cursor-type . (bar . 0)))) | 144 (modify-frame-parameters f '((cursor-type . (bar . 0)))) |
| 164 (setq restore (cons '(modify-frame-parameters | 145 (setq restore (cons '(modify-frame-parameters |
| 165 f (list (cons 'cursor-type ct))) | 146 f (list (cons 'cursor-type ct))) |
| 397 | 378 |
| 398 (defun zone-pgm-rotate (&optional random-style) | 379 (defun zone-pgm-rotate (&optional random-style) |
| 399 (let* ((specs (apply | 380 (let* ((specs (apply |
| 400 'vector | 381 'vector |
| 401 (let (res) | 382 (let (res) |
| 402 (mapcar (lambda (ent) | 383 (mapc (lambda (ent) |
| 403 (let* ((beg (car ent)) | 384 (let* ((beg (car ent)) |
| 404 (end (cdr ent)) | 385 (end (cdr ent)) |
| 405 (amt (if random-style | 386 (amt (if random-style |
| 406 (funcall random-style) | 387 (funcall random-style) |
| 407 (- (random 7) 3)))) | 388 (- (random 7) 3)))) |
| 408 (when (< (- end (abs amt)) beg) | 389 (when (< (- end (abs amt)) beg) |
| 409 (setq amt (random (- end beg)))) | 390 (setq amt (random (- end beg)))) |
| 410 (unless (= 0 amt) | 391 (unless (= 0 amt) |
| 411 (setq res | 392 (setq res |
| 412 (cons | 393 (cons |
| 413 (vector amt beg (- end (abs amt))) | 394 (vector amt beg (- end (abs amt))) |
| 414 res))))) | 395 res))))) |
| 415 (zone-line-specs)) | 396 (zone-line-specs)) |
| 416 res))) | 397 res))) |
| 417 (n (length specs)) | 398 (n (length specs)) |
| 418 amt aamt cut paste txt i ent) | 399 amt aamt cut paste txt i ent) |
| 419 (while (not (input-pending-p)) | 400 (while (not (input-pending-p)) |
| 420 (setq i 0) | 401 (setq i 0) |
| 702 (make-string 5 ?@)) | 683 (make-string 5 ?@)) |
| 703 (make-string 10 32))))))) | 684 (make-string 10 32))))))) |
| 704 (life (or zone-pgm-random-life-wait (random 4))) | 685 (life (or zone-pgm-random-life-wait (random 4))) |
| 705 (kill-buffer nil)))) | 686 (kill-buffer nil)))) |
| 706 | 687 |
| 688 | |
| 707 (random t) | 689 (random t) |
| 708 | 690 |
| 709 ;;;;;;;;;;;;;;; | 691 ;;;;;;;;;;;;;;; |
| 710 (provide 'zone) | 692 (provide 'zone) |
| 711 | 693 |