Mercurial > emacs
comparison lisp/play/zone.el @ 58998:dd8c66d7733c
(zone): Fix omission bug: Use a self-disabling
one-shot thunk for uniform (error, quit, normal) recovery.
(zone-pgm-random-life): Fix bug:
Recognize empty initial field by lack of "@" chars.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Thu, 16 Dec 2004 17:08:34 +0000 |
parents | 64c212b55c0c |
children | ee201fcb86f7 |
comparison
equal
deleted
inserted
replaced
58997:f7098e12436d | 58998:dd8c66d7733c |
---|---|
150 (untabify (point-min) (point-max)) | 150 (untabify (point-min) (point-max)) |
151 (set-window-start (selected-window) (point-min)) | 151 (set-window-start (selected-window) (point-min)) |
152 (set-window-point (selected-window) wp) | 152 (set-window-point (selected-window) wp) |
153 (sit-for 0 500) | 153 (sit-for 0 500) |
154 (let ((pgm (elt zone-programs (random (length zone-programs)))) | 154 (let ((pgm (elt zone-programs (random (length zone-programs)))) |
155 (ct (and f (frame-parameter f 'cursor-type)))) | 155 (ct (and f (frame-parameter f 'cursor-type))) |
156 (when ct (modify-frame-parameters f '((cursor-type . (bar . 0))))) | 156 (restore (list '(kill-buffer outbuf)))) |
157 (when ct | |
158 (modify-frame-parameters f '((cursor-type . (bar . 0)))) | |
159 (setq restore (cons '(modify-frame-parameters | |
160 f (list (cons 'cursor-type ct))) | |
161 restore))) | |
162 ;; Make `restore' a self-disabling one-shot thunk. | |
163 (setq restore `(lambda () ,@restore (setq restore nil))) | |
157 (condition-case nil | 164 (condition-case nil |
158 (progn | 165 (progn |
159 (message "Zoning... (%s)" pgm) | 166 (message "Zoning... (%s)" pgm) |
160 (garbage-collect) | 167 (garbage-collect) |
161 ;; If some input is pending, zone says "sorry", which | 168 ;; If some input is pending, zone says "sorry", which |
165 (if (input-pending-p) | 172 (if (input-pending-p) |
166 (discard-input)) | 173 (discard-input)) |
167 (zone-call pgm) | 174 (zone-call pgm) |
168 (message "Zoning...sorry")) | 175 (message "Zoning...sorry")) |
169 (error | 176 (error |
177 (funcall restore) | |
170 (while (not (input-pending-p)) | 178 (while (not (input-pending-p)) |
171 (message (format "We were zoning when we wrote %s..." pgm)) | 179 (message (format "We were zoning when we wrote %s..." pgm)) |
172 (sit-for 3) | 180 (sit-for 3) |
173 (message "...here's hoping we didn't hose your buffer!") | 181 (message "...here's hoping we didn't hose your buffer!") |
174 (sit-for 3))) | 182 (sit-for 3))) |
175 (quit (ding) (message "Zoning...sorry"))) | 183 (quit |
176 (when ct (modify-frame-parameters f (list (cons 'cursor-type ct))))) | 184 (funcall restore) |
177 (kill-buffer outbuf))) | 185 (ding) |
186 (message "Zoning...sorry"))) | |
187 (when restore (funcall restore))))) | |
178 | 188 |
179 ;;;; Zone when idle, or not. | 189 ;;;; Zone when idle, or not. |
180 | 190 |
181 (defun zone-when-idle (secs) | 191 (defun zone-when-idle (secs) |
182 "Zone out when Emacs has been idle for SECS seconds." | 192 "Zone out when Emacs has been idle for SECS seconds." |
657 (move-to-column 9) | 667 (move-to-column 9) |
658 (setq col (cons (buffer-substring (point) c) col)) | 668 (setq col (cons (buffer-substring (point) c) col)) |
659 (end-of-line 0) | 669 (end-of-line 0) |
660 (forward-char -10)) | 670 (forward-char -10)) |
661 (let ((life-patterns (vector | 671 (let ((life-patterns (vector |
662 (if (and col (re-search-forward "[^ ]" max t)) | 672 (if (and col (search-forward "@" max t)) |
663 (cons (make-string (length (car col)) 32) col) | 673 (cons (make-string (length (car col)) 32) col) |
664 (list (mapconcat 'identity | 674 (list (mapconcat 'identity |
665 (make-list (/ (- rtc 11) 15) | 675 (make-list (/ (- rtc 11) 15) |
666 (make-string 5 ?@)) | 676 (make-string 5 ?@)) |
667 (make-string 10 32))))))) | 677 (make-string 10 32))))))) |