Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-window.el @ 54:05472e90ae02 r19-16-pre2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-16-pre2
author cvs
date Mon, 13 Aug 2007 08:57:55 +0200
parents ec9a17fef872
children 131b0175ea99
comparison
equal deleted inserted replaced
53:875393c1a535 54:05472e90ae02
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 (let ((vm-mutable-frames (and vm-mutable-frames pop-up-frames)))
111 (let ((w (vm-get-buffer-window buffer))) 108 (vm-maybe-delete-windows-or-frames-on buffer))
112 (and w (set-window-buffer w (other-buffer)))))) 109 (let (w)
110 (while (setq w (vm-get-buffer-window buffer))
111 (set-window-buffer w (other-buffer buffer))))))
113 112
114 (defun vm-load-window-configurations (file) 113 (defun vm-load-window-configurations (file)
115 (save-excursion 114 (save-excursion
116 (let ((work-buffer nil)) 115 (let ((work-buffer nil))
117 (unwind-protect 116 (unwind-protect
131 (let ((work-buffer nil)) 130 (let ((work-buffer nil))
132 (unwind-protect 131 (unwind-protect
133 (progn 132 (progn
134 (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*"))) 133 (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*")))
135 ;; for XEmacs/MULE 134 ;; for XEmacs/MULE
136 (and (vm-xemacs-mule-p) 135 (and vm-xemacs-mule-p
137 (set-file-coding-system 'no-conversion)) 136 (set-buffer-file-coding-system 'no-conversion))
138 (erase-buffer) 137 (erase-buffer)
139 (print vm-window-configurations (current-buffer)) 138 (print vm-window-configurations (current-buffer))
140 (write-region (point-min) (point-max) file nil 0)) 139 (write-region (point-min) (point-max) file nil 0))
141 (and work-buffer (kill-buffer work-buffer)))))) 140 (and work-buffer (kill-buffer work-buffer))))))
142 141
181 (t (throw 'done nil))) 180 (t (throw 'done nil)))
182 (set-buffer message) 181 (set-buffer message)
183 (vm-check-for-killed-presentation) 182 (vm-check-for-killed-presentation)
184 (if vm-presentation-buffer 183 (if vm-presentation-buffer
185 (setq message vm-presentation-buffer)) 184 (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) 185 (vm-check-for-killed-summary)
195 (or summary (setq summary (or vm-summary-buffer nonexistent-summary))) 186 (or summary (setq summary (or vm-summary-buffer nonexistent-summary)))
196 (or composition (setq composition nonexistent)) 187 (or composition (setq composition nonexistent))
197 (or edit (setq edit nonexistent)) 188 (or edit (setq edit nonexistent))
198 (tapestry-replace-tapestry-element (nth 1 config) 'buffer-name 189 (tapestry-replace-tapestry-element (nth 1 config) 'buffer-name
201 (if (symbolp x) 192 (if (symbolp x)
202 (symbol-value x) 193 (symbol-value x)
203 x )))) 194 x ))))
204 (set-tapestry (nth 1 config) 1) 195 (set-tapestry (nth 1 config) 1)
205 (and (get-buffer nonexistent) 196 (and (get-buffer nonexistent)
206 (vm-delete-windows-or-frames-on nonexistent)) 197 (vm-maybe-delete-windows-or-frames-on nonexistent))
207 (if (and (vm-get-buffer-window nonexistent-summary) 198 (if (and (vm-get-buffer-window nonexistent-summary)
208 (not (vm-get-buffer-window message))) 199 (not (vm-get-buffer-window message)))
209 ;; user asked for summary to be displayed but doesn't 200 ;; user asked for summary to be displayed but doesn't
210 ;; have one, nor is the folder buffer displayed. Help 201 ;; have one, nor is the folder buffer displayed. Help
211 ;; the user not to lose here. 202 ;; the user not to lose here.
212 (vm-replace-buffer-in-windows nonexistent-summary message) 203 (vm-replace-buffer-in-windows nonexistent-summary message)
213 (and (get-buffer nonexistent-summary) 204 (and (get-buffer nonexistent-summary)
214 (vm-delete-windows-or-frames-on nonexistent-summary))) 205 (vm-maybe-delete-windows-or-frames-on nonexistent-summary)))
215 (vm-record-current-window-configuration config)
216 config ))) 206 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 207
239 (defun vm-save-window-configuration (tag) 208 (defun vm-save-window-configuration (tag)
240 "Name and save the current window configuration. 209 "Name and save the current window configuration.
241 With this command you associate the current window setup with an 210 With this command you associate the current window setup with an
242 action. Each time you perform this action VM will duplicate this 211 action. Each time you perform this action VM will duplicate this
251 specific configurations are searched for first, then the category 220 specific configurations are searched for first, then the category
252 configurations and then the default configuration. The first 221 configurations and then the default configuration. The first
253 configuration found is the one that is applied. 222 configuration found is the one that is applied.
254 223
255 The value of vm-mutable-windows must be non-nil for VM to use 224 The value of vm-mutable-windows must be non-nil for VM to use
256 window configurations. 225 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 226 (interactive
262 (let ((last-command last-command) 227 (let ((last-command last-command)
263 (this-command this-command)) 228 (this-command this-command))
264 (if (null vm-window-configuration-file) 229 (if (null vm-window-configuration-file)
265 (error "Configurable windows not enabled. Set vm-window-configuration-file to enable.")) 230 (error "Configurable windows not enabled. Set vm-window-configuration-file to enable."))
364 (vm-iconify-frame-xxx)))) 329 (vm-iconify-frame-xxx))))
365 330
366 (defun vm-window-loop (action obj-1 &optional obj-2) 331 (defun vm-window-loop (action obj-1 &optional obj-2)
367 (let ((delete-me nil) 332 (let ((delete-me nil)
368 (done nil) 333 (done nil)
369 (all-frames (if vm-mutable-frames t nil)) 334 (all-frames (if vm-search-other-frames t nil))
370 start w) 335 start w)
371 (setq start (next-window (selected-window) 'nomini all-frames) 336 (setq start (next-window (selected-window) 'nomini all-frames)
372 w start) 337 w start)
373 (and obj-1 (setq obj-1 (get-buffer obj-1))) 338 (and obj-1 (setq obj-1 (get-buffer obj-1)))
374 (while (not done) 339 (while (not done)
438 (if delete-me 403 (if delete-me
439 (progn 404 (progn
440 (vm-error-free-call 'vm-delete-frame delete-me) 405 (vm-error-free-call 'vm-delete-frame delete-me)
441 (setq delete-me nil)))))) 406 (setq delete-me nil))))))
442 407
443 (defun vm-delete-windows-or-frames-on (buffer) 408 (defun vm-maybe-delete-windows-or-frames-on (buffer)
444 (and (eq vm-mutable-windows t) (vm-window-loop 'delete buffer)) 409 (and (eq vm-mutable-windows t) (vm-window-loop 'delete buffer))
445 (and vm-mutable-frames (vm-frame-loop 'delete buffer))) 410 (and vm-mutable-frames (vm-frame-loop 'delete buffer)))
446 411
447 (defun vm-replace-buffer-in-windows (old new) 412 (defun vm-replace-buffer-in-windows (old new)
448 (vm-window-loop 'replace old new)) 413 (vm-window-loop 'replace old new))
449 414
450 (defun vm-bury-buffer (&optional buffer) 415 (defun vm-bury-buffer (&optional buffer)
451 (or buffer (setq buffer (current-buffer))) 416 (or buffer (setq buffer (current-buffer)))
452 (if (vm-xemacs-p) 417 (if vm-xemacs-p
453 (if (vm-multiple-frames-possible-p) 418 (if (vm-multiple-frames-possible-p)
454 (vm-frame-loop 'bury buffer) 419 (vm-frame-loop 'bury buffer)
455 (bury-buffer buffer)) 420 (bury-buffer buffer))
456 (bury-buffer buffer))) 421 (bury-buffer buffer)))
457 422
507 (b (current-buffer)) 472 (b (current-buffer))
508 (wf (and w (vm-window-frame w)))) 473 (wf (and w (vm-window-frame w))))
509 (and w (eq (vm-selected-frame) wf) (vm-created-this-frame-p wf) 474 (and w (eq (vm-selected-frame) wf) (vm-created-this-frame-p wf)
510 (vm-error-free-call 'vm-delete-frame wf)) 475 (vm-error-free-call 'vm-delete-frame wf))
511 (and w (let ((vm-mutable-frames t)) 476 (and w (let ((vm-mutable-frames t))
512 (vm-delete-windows-or-frames-on b))))))) 477 (vm-maybe-delete-windows-or-frames-on b)))))))
513 478
514 (defun vm-register-frame (frame) 479 (defun vm-register-frame (frame)
515 (setq vm-frame-list (cons frame vm-frame-list))) 480 (setq vm-frame-list (cons frame vm-frame-list)))
516 481
517 (defun vm-goto-new-frame (&rest types) 482 (defun vm-goto-new-frame (&rest types)
531 (vm-register-frame (vm-selected-frame)) 496 (vm-register-frame (vm-selected-frame))
532 (and vm-warp-mouse-to-new-frame 497 (and vm-warp-mouse-to-new-frame
533 (vm-warp-mouse-to-frame-maybe (vm-selected-frame))))) 498 (vm-warp-mouse-to-frame-maybe (vm-selected-frame)))))
534 499
535 (defun vm-goto-new-summary-frame-maybe () 500 (defun vm-goto-new-summary-frame-maybe ()
536 (if (and vm-frame-per-summary (vm-multiple-frames-possible-p)) 501 (if (and vm-mutable-frames vm-frame-per-summary
502 (vm-multiple-frames-possible-p))
537 (let ((w (vm-get-buffer-window vm-summary-buffer))) 503 (let ((w (vm-get-buffer-window vm-summary-buffer)))
538 (if (null w) 504 (if (null w)
539 (progn 505 (progn
540 (vm-goto-new-frame 'summary) 506 (vm-goto-new-frame 'summary)
541 (vm-set-hooks-for-frame-deletion)) 507 (vm-set-hooks-for-frame-deletion))
543 (select-window w) 509 (select-window w)
544 (and vm-warp-mouse-to-new-frame 510 (and vm-warp-mouse-to-new-frame
545 (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) 511 (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))))))
546 512
547 (defun vm-goto-new-folder-frame-maybe (&rest types) 513 (defun vm-goto-new-folder-frame-maybe (&rest types)
548 (if (and vm-frame-per-folder (vm-multiple-frames-possible-p)) 514 (if (and vm-mutable-frames vm-frame-per-folder
515 (vm-multiple-frames-possible-p))
549 (let ((w (or (vm-get-buffer-window (current-buffer)) 516 (let ((w (or (vm-get-buffer-window (current-buffer))
550 ;; summary == folder for the purpose 517 ;; summary == folder for the purpose
551 ;; of frame reuse. 518 ;; of frame reuse.
552 (and vm-summary-buffer 519 (and vm-summary-buffer
553 (vm-get-buffer-window vm-summary-buffer)) 520 (vm-get-buffer-window vm-summary-buffer))
564 (and vm-warp-mouse-to-new-frame 531 (and vm-warp-mouse-to-new-frame
565 (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) 532 (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))))))
566 533
567 (defun vm-warp-mouse-to-frame-maybe (&optional frame) 534 (defun vm-warp-mouse-to-frame-maybe (&optional frame)
568 (or frame (setq frame (vm-selected-frame))) 535 (or frame (setq frame (vm-selected-frame)))
569 (if (vm-mouse-support-possible-p) 536 (if (vm-mouse-support-possible-here-p)
570 (cond ((vm-mouse-xemacs-mouse-p) 537 (cond ((vm-mouse-xemacs-mouse-p)
571 (cond ((fboundp 'mouse-position);; XEmacs 19.12 538 (cond ((fboundp 'mouse-position);; XEmacs 19.12
572 (let ((mp (mouse-position))) 539 (let ((mp (mouse-position)))
573 (if (and (car mp) 540 (if (and (car mp)
574 (eq (window-frame (car mp)) (selected-frame))) 541 (eq (window-frame (car mp)) (selected-frame)))
642 609
643 ;; frame-totally-visible-p is broken under XEmacs 19.14 and is 610 ;; frame-totally-visible-p is broken under XEmacs 19.14 and is
644 ;; absent under Emacs 19.34. So vm-frame-per-summary won't work 611 ;; absent under Emacs 19.34. So vm-frame-per-summary won't work
645 ;; quite right under these Emacs versions. XEmacs 19.15 should 612 ;; quite right under these Emacs versions. XEmacs 19.15 should
646 ;; have a working version of this function. 613 ;; have a working version of this function.
647 (if (and (fboundp 'frame-totally-visible-p) 614 ;; 2 April 1997, frame-totally-visible-p apparently still broken
648 (vm-xemacs-p) 615 ;; under 19.15. I give up for now.
649 (or (>= emacs-major-version 20) 616 ;;(if (and (fboundp 'frame-totally-visible-p)
650 (>= emacs-minor-version 15))) 617 ;; vm-xemacs-p
651 (fset 'vm-frame-totally-visible-p 'frame-totally-visible-p) 618 ;; (or (>= emacs-major-version 20)
652 (fset 'vm-frame-totally-visible-p 'vm-frame-visible-p)) 619 ;; (>= emacs-minor-version 15)))
620 ;; (fset 'vm-frame-totally-visible-p 'frame-totally-visible-p)
621 ;; (fset 'vm-frame-totally-visible-p 'vm-frame-visible-p))
622 (fset 'vm-frame-totally-visible-p 'vm-frame-visible-p)
653 623
654 (fset 'vm-window-frame 624 (fset 'vm-window-frame
655 (symbol-function 625 (symbol-function
656 (cond ((fboundp 'window-frame) 'window-frame) 626 (cond ((fboundp 'window-frame) 'window-frame)
657 ((fboundp 'window-screen) 'window-screen) 627 ((fboundp 'window-screen) 'window-screen)