135 |
(defun zone () |
(defun zone () |
136 |
"Zone out, completely." |
"Zone out, completely." |
137 |
(interactive) |
(interactive) |
138 |
(let ((f (selected-frame)) |
(save-window-excursion |
139 |
(outbuf (get-buffer-create "*zone*")) |
(let ((f (selected-frame)) |
140 |
(text (buffer-substring (window-start) (window-end))) |
(outbuf (get-buffer-create "*zone*")) |
141 |
(wp (1+ (- (window-point (selected-window)) |
(text (buffer-substring (window-start) (window-end))) |
142 |
(window-start))))) |
(wp (1+ (- (window-point (selected-window)) |
143 |
(put 'zone 'orig-buffer (current-buffer)) |
(window-start))))) |
144 |
(put 'zone 'modeline-hidden-level 0) |
(put 'zone 'orig-buffer (current-buffer)) |
145 |
(switch-to-buffer outbuf) |
(put 'zone 'modeline-hidden-level 0) |
146 |
(setq mode-name "Zone") |
(switch-to-buffer outbuf) |
147 |
(erase-buffer) |
(setq mode-name "Zone") |
148 |
(setq buffer-undo-list t |
(erase-buffer) |
149 |
truncate-lines t |
(setq buffer-undo-list t |
150 |
tab-width (zone-orig tab-width) |
truncate-lines t |
151 |
line-spacing (zone-orig line-spacing)) |
tab-width (zone-orig tab-width) |
152 |
(insert text) |
line-spacing (zone-orig line-spacing)) |
153 |
(untabify (point-min) (point-max)) |
(insert text) |
154 |
(set-window-start (selected-window) (point-min)) |
(untabify (point-min) (point-max)) |
155 |
(set-window-point (selected-window) wp) |
(set-window-start (selected-window) (point-min)) |
156 |
(sit-for 0 500) |
(set-window-point (selected-window) wp) |
157 |
(let ((pgm (elt zone-programs (random (length zone-programs)))) |
(sit-for 0 500) |
158 |
(ct (and f (frame-parameter f 'cursor-type))) |
(let ((pgm (elt zone-programs (random (length zone-programs)))) |
159 |
(restore (list '(kill-buffer outbuf)))) |
(ct (and f (frame-parameter f 'cursor-type))) |
160 |
(when ct |
(restore (list '(kill-buffer outbuf)))) |
161 |
(modify-frame-parameters f '((cursor-type . (bar . 0)))) |
(when ct |
162 |
(setq restore (cons '(modify-frame-parameters |
(modify-frame-parameters f '((cursor-type . (bar . 0)))) |
163 |
f (list (cons 'cursor-type ct))) |
(setq restore (cons '(modify-frame-parameters |
164 |
restore))) |
f (list (cons 'cursor-type ct))) |
165 |
;; Make `restore' a self-disabling one-shot thunk. |
restore))) |
166 |
(setq restore `(lambda () ,@restore (setq restore nil))) |
;; Make `restore' a self-disabling one-shot thunk. |
167 |
(condition-case nil |
(setq restore `(lambda () ,@restore (setq restore nil))) |
168 |
(progn |
(condition-case nil |
169 |
(message "Zoning... (%s)" pgm) |
(progn |
170 |
(garbage-collect) |
(message "Zoning... (%s)" pgm) |
171 |
;; If some input is pending, zone says "sorry", which |
(garbage-collect) |
172 |
;; isn't nice; this might happen e.g. when they invoke the |
;; If some input is pending, zone says "sorry", which |
173 |
;; game by clicking the menu bar. So discard any pending |
;; isn't nice; this might happen e.g. when they invoke the |
174 |
;; input before zoning out. |
;; game by clicking the menu bar. So discard any pending |
175 |
(if (input-pending-p) |
;; input before zoning out. |
176 |
(discard-input)) |
(if (input-pending-p) |
177 |
(zone-call pgm) |
(discard-input)) |
178 |
(message "Zoning...sorry")) |
(zone-call pgm) |
179 |
(error |
(message "Zoning...sorry")) |
180 |
(funcall restore) |
(error |
181 |
(while (not (input-pending-p)) |
(funcall restore) |
182 |
(message "We were zoning when we wrote %s..." pgm) |
(while (not (input-pending-p)) |
183 |
(sit-for 3) |
(message "We were zoning when we wrote %s..." pgm) |
184 |
(message "...here's hoping we didn't hose your buffer!") |
(sit-for 3) |
185 |
(sit-for 3))) |
(message "...here's hoping we didn't hose your buffer!") |
186 |
(quit |
(sit-for 3))) |
187 |
(funcall restore) |
(quit |
188 |
(ding) |
(funcall restore) |
189 |
(message "Zoning...sorry"))) |
(ding) |
190 |
(when restore (funcall restore))))) |
(message "Zoning...sorry"))) |
191 |
|
(when restore (funcall restore)))))) |
192 |
|
|
193 |
;;;; Zone when idle, or not. |
;;;; Zone when idle, or not. |
194 |
|
|