/[emacs]/emacs/lisp/play/zone.el
ViewVC logotype

Diff of /emacs/lisp/play/zone.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by deego, Sun Sep 18 12:32:51 2005 UTC revision 1.25 by ttn, Thu Oct 6 18:23:23 2005 UTC
# Line 135  If the element is a function or a list o Line 135  If the element is a function or a list o
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    

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26