Mercurial > emacs
comparison lisp/play/zone.el @ 65878:011947140bc7
(zone): Wrap body with save-window-excursion.
| author | Thien-Thi Nguyen <ttn@gnuvola.org> |
|---|---|
| date | Thu, 06 Oct 2005 18:23:23 +0000 |
| parents | 6d0d4d973f77 |
| children | 836785857446 aa89c814f853 |
comparison
equal
deleted
inserted
replaced
| 65877:05c82d2f864c | 65878:011947140bc7 |
|---|---|
| 133 | 133 |
| 134 ;;;###autoload | 134 ;;;###autoload |
| 135 (defun zone () | 135 (defun zone () |
| 136 "Zone out, completely." | 136 "Zone out, completely." |
| 137 (interactive) | 137 (interactive) |
| 138 (let ((f (selected-frame)) | 138 (save-window-excursion |
| 139 (outbuf (get-buffer-create "*zone*")) | 139 (let ((f (selected-frame)) |
| 140 (text (buffer-substring (window-start) (window-end))) | 140 (outbuf (get-buffer-create "*zone*")) |
| 141 (wp (1+ (- (window-point (selected-window)) | 141 (text (buffer-substring (window-start) (window-end))) |
| 142 (window-start))))) | 142 (wp (1+ (- (window-point (selected-window)) |
| 143 (put 'zone 'orig-buffer (current-buffer)) | 143 (window-start))))) |
| 144 (put 'zone 'modeline-hidden-level 0) | 144 (put 'zone 'orig-buffer (current-buffer)) |
| 145 (switch-to-buffer outbuf) | 145 (put 'zone 'modeline-hidden-level 0) |
| 146 (setq mode-name "Zone") | 146 (switch-to-buffer outbuf) |
| 147 (erase-buffer) | 147 (setq mode-name "Zone") |
| 148 (setq buffer-undo-list t | 148 (erase-buffer) |
| 149 truncate-lines t | 149 (setq buffer-undo-list t |
| 150 tab-width (zone-orig tab-width) | 150 truncate-lines t |
| 151 line-spacing (zone-orig line-spacing)) | 151 tab-width (zone-orig tab-width) |
| 152 (insert text) | 152 line-spacing (zone-orig line-spacing)) |
| 153 (untabify (point-min) (point-max)) | 153 (insert text) |
| 154 (set-window-start (selected-window) (point-min)) | 154 (untabify (point-min) (point-max)) |
| 155 (set-window-point (selected-window) wp) | 155 (set-window-start (selected-window) (point-min)) |
| 156 (sit-for 0 500) | 156 (set-window-point (selected-window) wp) |
| 157 (let ((pgm (elt zone-programs (random (length zone-programs)))) | 157 (sit-for 0 500) |
| 158 (ct (and f (frame-parameter f 'cursor-type))) | 158 (let ((pgm (elt zone-programs (random (length zone-programs)))) |
| 159 (restore (list '(kill-buffer outbuf)))) | 159 (ct (and f (frame-parameter f 'cursor-type))) |
| 160 (when ct | 160 (restore (list '(kill-buffer outbuf)))) |
| 161 (modify-frame-parameters f '((cursor-type . (bar . 0)))) | 161 (when ct |
| 162 (setq restore (cons '(modify-frame-parameters | 162 (modify-frame-parameters f '((cursor-type . (bar . 0)))) |
| 163 f (list (cons 'cursor-type ct))) | 163 (setq restore (cons '(modify-frame-parameters |
| 164 restore))) | 164 f (list (cons 'cursor-type ct))) |
| 165 ;; Make `restore' a self-disabling one-shot thunk. | 165 restore))) |
| 166 (setq restore `(lambda () ,@restore (setq restore nil))) | 166 ;; Make `restore' a self-disabling one-shot thunk. |
| 167 (condition-case nil | 167 (setq restore `(lambda () ,@restore (setq restore nil))) |
| 168 (progn | 168 (condition-case nil |
| 169 (message "Zoning... (%s)" pgm) | 169 (progn |
| 170 (garbage-collect) | 170 (message "Zoning... (%s)" pgm) |
| 171 ;; If some input is pending, zone says "sorry", which | 171 (garbage-collect) |
| 172 ;; isn't nice; this might happen e.g. when they invoke the | 172 ;; If some input is pending, zone says "sorry", which |
| 173 ;; game by clicking the menu bar. So discard any pending | 173 ;; isn't nice; this might happen e.g. when they invoke the |
| 174 ;; input before zoning out. | 174 ;; game by clicking the menu bar. So discard any pending |
| 175 (if (input-pending-p) | 175 ;; input before zoning out. |
| 176 (discard-input)) | 176 (if (input-pending-p) |
| 177 (zone-call pgm) | 177 (discard-input)) |
| 178 (message "Zoning...sorry")) | 178 (zone-call pgm) |
| 179 (error | 179 (message "Zoning...sorry")) |
| 180 (funcall restore) | 180 (error |
| 181 (while (not (input-pending-p)) | 181 (funcall restore) |
| 182 (message "We were zoning when we wrote %s..." pgm) | 182 (while (not (input-pending-p)) |
| 183 (sit-for 3) | 183 (message "We were zoning when we wrote %s..." pgm) |
| 184 (message "...here's hoping we didn't hose your buffer!") | 184 (sit-for 3) |
| 185 (sit-for 3))) | 185 (message "...here's hoping we didn't hose your buffer!") |
| 186 (quit | 186 (sit-for 3))) |
| 187 (funcall restore) | 187 (quit |
| 188 (ding) | 188 (funcall restore) |
| 189 (message "Zoning...sorry"))) | 189 (ding) |
| 190 (when restore (funcall restore))))) | 190 (message "Zoning...sorry"))) |
| 191 (when restore (funcall restore)))))) | |
| 191 | 192 |
| 192 ;;;; Zone when idle, or not. | 193 ;;;; Zone when idle, or not. |
| 193 | 194 |
| 194 (defun zone-when-idle (secs) | 195 (defun zone-when-idle (secs) |
| 195 "Zone out when Emacs has been idle for SECS seconds." | 196 "Zone out when Emacs has been idle for SECS seconds." |