comparison lisp/vm/vm-window.el @ 155:43dd3413c7c7 r20-3b4

Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents 585fb297b004
children 2d532a89d707
comparison
equal deleted inserted replaced
154:94141801dd7e 155:43dd3413c7c7
72 (vm-select-frame wf)) 72 (vm-select-frame wf))
73 (cond ((and buffer display) 73 (cond ((and buffer display)
74 (if (and vm-display-buffer-hook 74 (if (and vm-display-buffer-hook
75 (null (vm-get-visible-buffer-window buffer))) 75 (null (vm-get-visible-buffer-window buffer)))
76 (progn (run-hooks 'vm-display-buffer-hook) 76 (progn (run-hooks 'vm-display-buffer-hook)
77 (switch-to-buffer buffer) 77 (switch-to-buffer buffer))
78 (vm-record-current-window-configuration nil))
79 (if (not (and (memq this-command commands) 78 (if (not (and (memq this-command commands)
80 (apply 'vm-set-window-configuration configs) 79 (apply 'vm-set-window-configuration configs)
81 (vm-get-visible-buffer-window buffer))) 80 (vm-get-visible-buffer-window buffer)))
82 (vm-display-buffer buffer)))) 81 (vm-display-buffer buffer))))
83 ((and buffer (not display)) 82 ((and buffer (not display))
84 (if (and vm-undisplay-buffer-hook 83 (if (and vm-undisplay-buffer-hook
85 (vm-get-visible-buffer-window buffer)) 84 (vm-get-visible-buffer-window buffer))
86 (progn (set-buffer buffer) 85 (progn (set-buffer buffer)
87 (run-hooks 'vm-undisplay-buffer-hook) 86 (run-hooks 'vm-undisplay-buffer-hook))
88 (vm-record-current-window-configuration nil))
89 (if (not (and (memq this-command commands) 87 (if (not (and (memq this-command commands)
90 (apply 'vm-set-window-configuration configs))) 88 (apply 'vm-set-window-configuration configs)))
91 (vm-undisplay-buffer buffer)))) 89 (vm-undisplay-buffer buffer))))
92 ((memq this-command commands) 90 ((memq this-command commands)
93 (apply 'vm-set-window-configuration configs)))))) 91 (apply 'vm-set-window-configuration configs))))))
94 92
95 (defun vm-display-buffer (buffer) 93 (defun vm-display-buffer (buffer)
96 (let ((pop-up-windows (eq vm-mutable-windows t)) 94 (let ((pop-up-windows (eq vm-mutable-windows t))
97 (pop-up-frames vm-mutable-frames)) 95 (pop-up-frames (and pop-up-frames vm-mutable-frames)))
98 (vm-record-current-window-configuration nil)
99 (if (or pop-up-frames 96 (if (or pop-up-frames
100 (and (eq vm-mutable-windows t) 97 (and (eq vm-mutable-windows t)
101 (symbolp 98 (symbolp
102 (vm-buffer-to-label 99 (vm-buffer-to-label
103 (window-buffer 100 (window-buffer
105 (select-window (display-buffer buffer)) 102 (select-window (display-buffer buffer))
106 (switch-to-buffer buffer)))) 103 (switch-to-buffer buffer))))
107 104
108 (defun vm-undisplay-buffer (buffer) 105 (defun vm-undisplay-buffer (buffer)
109 (vm-save-buffer-excursion 106 (vm-save-buffer-excursion
110 (vm-delete-windows-or-frames-on buffer) 107 (vm-maybe-delete-windows-or-frames-on buffer)
111 (let ((w (vm-get-buffer-window buffer))) 108 (let ((w (vm-get-buffer-window buffer)))
112 (and w (set-window-buffer w (other-buffer)))))) 109 (and w (set-window-buffer w (other-buffer))))))
113 110
114 (defun vm-load-window-configurations (file) 111 (defun vm-load-window-configurations (file)
115 (save-excursion 112 (save-excursion
181 (t (throw 'done nil))) 178 (t (throw 'done nil)))
182 (set-buffer message) 179 (set-buffer message)
183 (vm-check-for-killed-presentation) 180 (vm-check-for-killed-presentation)
184 (if vm-presentation-buffer 181 (if vm-presentation-buffer
185 (setq message vm-presentation-buffer)) 182 (setq message vm-presentation-buffer))
186 ;; if this configuration is already the current one, don't
187 ;; set it up again.
188 (if (or (and vm-mutable-frames (eq (car config) vm-window-configuration))
189 (and (not vm-mutable-frames)
190 (listp vm-window-configuration)
191 (eq (car config)
192 (cdr (assq selected-frame vm-window-configuration)))))
193 (throw 'done nil))
194 (vm-check-for-killed-summary) 183 (vm-check-for-killed-summary)
195 (or summary (setq summary (or vm-summary-buffer nonexistent-summary))) 184 (or summary (setq summary (or vm-summary-buffer nonexistent-summary)))
196 (or composition (setq composition nonexistent)) 185 (or composition (setq composition nonexistent))
197 (or edit (setq edit nonexistent)) 186 (or edit (setq edit nonexistent))
198 (tapestry-replace-tapestry-element (nth 1 config) 'buffer-name 187 (tapestry-replace-tapestry-element (nth 1 config) 'buffer-name
201 (if (symbolp x) 190 (if (symbolp x)
202 (symbol-value x) 191 (symbol-value x)
203 x )))) 192 x ))))
204 (set-tapestry (nth 1 config) 1) 193 (set-tapestry (nth 1 config) 1)
205 (and (get-buffer nonexistent) 194 (and (get-buffer nonexistent)
206 (vm-delete-windows-or-frames-on nonexistent)) 195 (vm-maybe-delete-windows-or-frames-on nonexistent))
207 (if (and (vm-get-buffer-window nonexistent-summary) 196 (if (and (vm-get-buffer-window nonexistent-summary)
208 (not (vm-get-buffer-window message))) 197 (not (vm-get-buffer-window message)))
209 ;; user asked for summary to be displayed but doesn't 198 ;; user asked for summary to be displayed but doesn't
210 ;; have one, nor is the folder buffer displayed. Help 199 ;; have one, nor is the folder buffer displayed. Help
211 ;; the user not to lose here. 200 ;; the user not to lose here.
212 (vm-replace-buffer-in-windows nonexistent-summary message) 201 (vm-replace-buffer-in-windows nonexistent-summary message)
213 (and (get-buffer nonexistent-summary) 202 (and (get-buffer nonexistent-summary)
214 (vm-delete-windows-or-frames-on nonexistent-summary))) 203 (vm-maybe-delete-windows-or-frames-on nonexistent-summary))) )))
215 (vm-record-current-window-configuration config)
216 config )))
217
218 (defun vm-record-current-window-configuration (config)
219 ;; this function continues to be a no-op.
220 ;;
221 ;; the idea behind this function is that VM can remember what
222 ;; the current window configuration is and not rebuild the
223 ;; configuration for the next command if it matches what we
224 ;; have recorded.
225 ;;
226 ;; the problem with this idea is that the user can do things
227 ;; like C-x 0 and VM has no way of knowing. So VM thinks the
228 ;; right configuration is displayed when in fact it is not,
229 ;; which can cause incorrect displays.
230 '(let (cell)
231 (if (and (listp vm-window-configuration)
232 (setq cell (assq (vm-selected-frame) vm-window-configuration)))
233 (setcdr cell (car config))
234 (setq vm-window-configuration
235 (cons
236 (cons (vm-selected-frame) (car config))
237 vm-window-configuration)))))
238 204
239 (defun vm-save-window-configuration (tag) 205 (defun vm-save-window-configuration (tag)
240 "Name and save the current window configuration. 206 "Name and save the current window configuration.
241 With this command you associate the current window setup with an 207 With this command you associate the current window setup with an
242 action. Each time you perform this action VM will duplicate this 208 action. Each time you perform this action VM will duplicate this
251 specific configurations are searched for first, then the category 217 specific configurations are searched for first, then the category
252 configurations and then the default configuration. The first 218 configurations and then the default configuration. The first
253 configuration found is the one that is applied. 219 configuration found is the one that is applied.
254 220
255 The value of vm-mutable-windows must be non-nil for VM to use 221 The value of vm-mutable-windows must be non-nil for VM to use
256 window configurations. 222 window configurations."
257
258 If vm-mutable-frames is non-nil and Emacs is running under X
259 windows, then VM will use all existing frames. Otherwise VM will
260 restrict its changes to the frame in which it was started."
261 (interactive 223 (interactive
262 (let ((last-command last-command) 224 (let ((last-command last-command)
263 (this-command this-command)) 225 (this-command this-command))
264 (if (null vm-window-configuration-file) 226 (if (null vm-window-configuration-file)
265 (error "Configurable windows not enabled. Set vm-window-configuration-file to enable.")) 227 (error "Configurable windows not enabled. Set vm-window-configuration-file to enable."))
364 (vm-iconify-frame-xxx)))) 326 (vm-iconify-frame-xxx))))
365 327
366 (defun vm-window-loop (action obj-1 &optional obj-2) 328 (defun vm-window-loop (action obj-1 &optional obj-2)
367 (let ((delete-me nil) 329 (let ((delete-me nil)
368 (done nil) 330 (done nil)
369 (all-frames (if vm-mutable-frames t nil)) 331 (all-frames (if vm-search-other-frames t nil))
370 start w) 332 start w)
371 (setq start (next-window (selected-window) 'nomini all-frames) 333 (setq start (next-window (selected-window) 'nomini all-frames)
372 w start) 334 w start)
373 (and obj-1 (setq obj-1 (get-buffer obj-1))) 335 (and obj-1 (setq obj-1 (get-buffer obj-1)))
374 (while (not done) 336 (while (not done)
438 (if delete-me 400 (if delete-me
439 (progn 401 (progn
440 (vm-error-free-call 'vm-delete-frame delete-me) 402 (vm-error-free-call 'vm-delete-frame delete-me)
441 (setq delete-me nil)))))) 403 (setq delete-me nil))))))
442 404
443 (defun vm-delete-windows-or-frames-on (buffer) 405 (defun vm-maybe-delete-windows-or-frames-on (buffer)
444 (and (eq vm-mutable-windows t) (vm-window-loop 'delete buffer)) 406 (and (eq vm-mutable-windows t) (vm-window-loop 'delete buffer))
445 (and vm-mutable-frames (vm-frame-loop 'delete buffer))) 407 (and vm-mutable-frames (vm-frame-loop 'delete buffer)))
446 408
447 (defun vm-replace-buffer-in-windows (old new) 409 (defun vm-replace-buffer-in-windows (old new)
448 (vm-window-loop 'replace old new)) 410 (vm-window-loop 'replace old new))
507 (b (current-buffer)) 469 (b (current-buffer))
508 (wf (and w (vm-window-frame w)))) 470 (wf (and w (vm-window-frame w))))
509 (and w (eq (vm-selected-frame) wf) (vm-created-this-frame-p wf) 471 (and w (eq (vm-selected-frame) wf) (vm-created-this-frame-p wf)
510 (vm-error-free-call 'vm-delete-frame wf)) 472 (vm-error-free-call 'vm-delete-frame wf))
511 (and w (let ((vm-mutable-frames t)) 473 (and w (let ((vm-mutable-frames t))
512 (vm-delete-windows-or-frames-on b))))))) 474 (vm-maybe-delete-windows-or-frames-on b)))))))
513 475
514 (defun vm-register-frame (frame) 476 (defun vm-register-frame (frame)
515 (setq vm-frame-list (cons frame vm-frame-list))) 477 (setq vm-frame-list (cons frame vm-frame-list)))
516 478
517 (defun vm-goto-new-frame (&rest types) 479 (defun vm-goto-new-frame (&rest types)
531 (vm-register-frame (vm-selected-frame)) 493 (vm-register-frame (vm-selected-frame))
532 (and vm-warp-mouse-to-new-frame 494 (and vm-warp-mouse-to-new-frame
533 (vm-warp-mouse-to-frame-maybe (vm-selected-frame))))) 495 (vm-warp-mouse-to-frame-maybe (vm-selected-frame)))))
534 496
535 (defun vm-goto-new-summary-frame-maybe () 497 (defun vm-goto-new-summary-frame-maybe ()
536 (if (and vm-frame-per-summary (vm-multiple-frames-possible-p)) 498 (if (and vm-mutable-frames vm-frame-per-summary
499 (vm-multiple-frames-possible-p))
537 (let ((w (vm-get-buffer-window vm-summary-buffer))) 500 (let ((w (vm-get-buffer-window vm-summary-buffer)))
538 (if (null w) 501 (if (null w)
539 (progn 502 (progn
540 (vm-goto-new-frame 'summary) 503 (vm-goto-new-frame 'summary)
541 (vm-set-hooks-for-frame-deletion)) 504 (vm-set-hooks-for-frame-deletion))
543 (select-window w) 506 (select-window w)
544 (and vm-warp-mouse-to-new-frame 507 (and vm-warp-mouse-to-new-frame
545 (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) 508 (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))))))
546 509
547 (defun vm-goto-new-folder-frame-maybe (&rest types) 510 (defun vm-goto-new-folder-frame-maybe (&rest types)
548 (if (and vm-frame-per-folder (vm-multiple-frames-possible-p)) 511 (if (and vm-mutable-frames vm-frame-per-folder
512 (vm-multiple-frames-possible-p))
549 (let ((w (or (vm-get-buffer-window (current-buffer)) 513 (let ((w (or (vm-get-buffer-window (current-buffer))
550 ;; summary == folder for the purpose 514 ;; summary == folder for the purpose
551 ;; of frame reuse. 515 ;; of frame reuse.
552 (and vm-summary-buffer 516 (and vm-summary-buffer
553 (vm-get-buffer-window vm-summary-buffer)) 517 (vm-get-buffer-window vm-summary-buffer))
564 (and vm-warp-mouse-to-new-frame 528 (and vm-warp-mouse-to-new-frame
565 (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) 529 (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))))))
566 530
567 (defun vm-warp-mouse-to-frame-maybe (&optional frame) 531 (defun vm-warp-mouse-to-frame-maybe (&optional frame)
568 (or frame (setq frame (vm-selected-frame))) 532 (or frame (setq frame (vm-selected-frame)))
569 (if (vm-mouse-support-possible-p) 533 (if (vm-mouse-support-possible-here-p)
570 (cond ((vm-mouse-xemacs-mouse-p) 534 (cond ((vm-mouse-xemacs-mouse-p)
571 (cond ((fboundp 'mouse-position);; XEmacs 19.12 535 (cond ((fboundp 'mouse-position);; XEmacs 19.12
572 (let ((mp (mouse-position))) 536 (let ((mp (mouse-position)))
573 (if (and (car mp) 537 (if (and (car mp)
574 (eq (window-frame (car mp)) (selected-frame))) 538 (eq (window-frame (car mp)) (selected-frame)))