Mercurial > hg > xemacs-beta
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))) |