Mercurial > hg > xemacs-beta
diff lisp/vm/vm-window.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 05472e90ae02 |
children | c0c698873ce1 |
line wrap: on
line diff
--- a/lisp/vm/vm-window.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/vm/vm-window.el Mon Aug 13 09:02:59 2007 +0200 @@ -1,5 +1,5 @@ ;;; Window management code for VM -;;; Copyright (C) 1989-1997 Kyle E. Jones +;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -17,8 +17,7 @@ (provide 'vm-window) -(defun vm-display (buffer display commands configs - &optional do-not-raise) +(defun vm-display (buffer display commands configs) ;; the clearinghouse VM display function. ;; ;; First arg BUFFER non-nil is a buffer to display or undisplay. @@ -63,18 +62,18 @@ ;; configuration is done, and only then if the value of ;; this-command is found in the COMMANDS list. (vm-save-buffer-excursion - (let* ((w (and buffer (vm-get-buffer-window buffer))) - (wf (and w (vm-window-frame w)))) + (let ((w (and buffer (vm-get-buffer-window buffer)))) (and buffer (set-buffer buffer)) - (if (and w display (not do-not-raise)) - (vm-raise-frame wf)) - (if (and w display (not (eq (vm-selected-frame) wf))) - (vm-select-frame wf)) +; (and w display (vm-raise-frame (vm-window-frame w))) + (and w display (vm-window-frame w)) + (and w display (not (eq (vm-selected-frame) (vm-window-frame w))) + (vm-select-frame (vm-window-frame w))) (cond ((and buffer display) (if (and vm-display-buffer-hook (null (vm-get-visible-buffer-window buffer))) (progn (run-hooks 'vm-display-buffer-hook) - (switch-to-buffer buffer)) + (switch-to-buffer buffer) + (vm-record-current-window-configuration nil)) (if (not (and (memq this-command commands) (apply 'vm-set-window-configuration configs) (vm-get-visible-buffer-window buffer))) @@ -82,8 +81,8 @@ ((and buffer (not display)) (if (and vm-undisplay-buffer-hook (vm-get-visible-buffer-window buffer)) - (progn (set-buffer buffer) - (run-hooks 'vm-undisplay-buffer-hook)) + (progn (run-hooks 'vm-undisplay-buffer-hook) + (vm-record-current-window-configuration nil)) (if (not (and (memq this-command commands) (apply 'vm-set-window-configuration configs))) (vm-undisplay-buffer buffer)))) @@ -92,7 +91,8 @@ (defun vm-display-buffer (buffer) (let ((pop-up-windows (eq vm-mutable-windows t)) - (pop-up-frames (and pop-up-frames vm-mutable-frames))) + (pop-up-frames vm-mutable-frames)) + (vm-record-current-window-configuration nil) (if (or pop-up-frames (and (eq vm-mutable-windows t) (symbolp @@ -104,11 +104,9 @@ (defun vm-undisplay-buffer (buffer) (vm-save-buffer-excursion - (let ((vm-mutable-frames (and vm-mutable-frames pop-up-frames))) - (vm-maybe-delete-windows-or-frames-on buffer)) - (let (w) - (while (setq w (vm-get-buffer-window buffer)) - (set-window-buffer w (other-buffer buffer)))))) + (vm-delete-windows-or-frames-on buffer) + (let ((w (vm-get-buffer-window buffer))) + (and w (set-window-buffer w (other-buffer)))))) (defun vm-load-window-configurations (file) (save-excursion @@ -131,9 +129,6 @@ (unwind-protect (progn (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*"))) - ;; for XEmacs/MULE - (and vm-xemacs-mule-p - (set-buffer-file-coding-system 'no-conversion)) (erase-buffer) (print vm-window-configurations (current-buffer)) (write-region (point-min) (point-max) file nil 0)) @@ -161,16 +156,12 @@ (setq message vm-mail-buffer))) ((eq major-mode 'vm-mode) (setq message (current-buffer))) - ((eq major-mode 'vm-presentation-mode) - (setq message vm-mail-buffer)) ((eq major-mode 'vm-virtual-mode) (setq message (current-buffer))) ((eq major-mode 'mail-mode) (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) (throw 'done nil) - (setq message vm-mail-buffer - ;; assume that the proximity implies affinity - composition (current-buffer)))) + (setq message vm-mail-buffer))) ((eq vm-system-state 'editing) (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) (throw 'done nil) @@ -179,9 +170,14 @@ ;; not in a VM related buffer, bail... (t (throw 'done nil))) (set-buffer message) - (vm-check-for-killed-presentation) - (if vm-presentation-buffer - (setq message vm-presentation-buffer)) + ;; if this configuration is already the current one, don't + ;; set it up again. + (if (or (and vm-mutable-frames (eq (car config) vm-window-configuration)) + (and (not vm-mutable-frames) + (listp vm-window-configuration) + (eq (car config) + (cdr (assq selected-frame vm-window-configuration))))) + (throw 'done nil)) (vm-check-for-killed-summary) (or summary (setq summary (or vm-summary-buffer nonexistent-summary))) (or composition (setq composition nonexistent)) @@ -194,7 +190,7 @@ x )))) (set-tapestry (nth 1 config) 1) (and (get-buffer nonexistent) - (vm-maybe-delete-windows-or-frames-on nonexistent)) + (vm-delete-windows-or-frames-on nonexistent)) (if (and (vm-get-buffer-window nonexistent-summary) (not (vm-get-buffer-window message))) ;; user asked for summary to be displayed but doesn't @@ -202,9 +198,31 @@ ;; the user not to lose here. (vm-replace-buffer-in-windows nonexistent-summary message) (and (get-buffer nonexistent-summary) - (vm-maybe-delete-windows-or-frames-on nonexistent-summary))) + (vm-delete-windows-or-frames-on nonexistent-summary))) + (vm-record-current-window-configuration config) config ))) +(defun vm-record-current-window-configuration (config) + ;; this function continues to be a no-op. + ;; + ;; the idea behind this function is that VM can remember what + ;; the current window configuration is and not rebuild the + ;; configuration for the next command if it matches what we + ;; have recorded. + ;; + ;; the problem with this idea is that the user can do things + ;; like C-x 0 and VM has no way of knowing. So VM thinks the + ;; right configuration is displayed when in fact it is not, + ;; which can cause incorrect displays. + '(let (cell) + (if (and (listp vm-window-configuration) + (setq cell (assq (vm-selected-frame) vm-window-configuration))) + (setcdr cell (car config)) + (setq vm-window-configuration + (cons + (cons (vm-selected-frame) (car config)) + vm-window-configuration))))) + (defun vm-save-window-configuration (tag) "Name and save the current window configuration. With this command you associate the current window setup with an @@ -222,7 +240,11 @@ configuration found is the one that is applied. The value of vm-mutable-windows must be non-nil for VM to use -window configurations." +window configurations. + +If vm-mutable-frames is non-nil and Emacs is running under X +windows, then VM will use all existing frames. Otherwise VM will +restrict its changes to the frame in which it was started." (interactive (let ((last-command last-command) (this-command this-command)) @@ -331,7 +353,7 @@ (defun vm-window-loop (action obj-1 &optional obj-2) (let ((delete-me nil) (done nil) - (all-frames (if vm-search-other-frames t nil)) + (all-frames (if vm-mutable-frames t nil)) start w) (setq start (next-window (selected-window) 'nomini all-frames) w start) @@ -374,8 +396,7 @@ (progn (condition-case nil (progn - (if (vm-created-this-frame-p delete-me) - (vm-delete-frame delete-me)) + (vm-delete-frame delete-me) (if (eq delete-me start) (setq start nil))) (error nil)) @@ -405,7 +426,7 @@ (vm-error-free-call 'vm-delete-frame delete-me) (setq delete-me nil)))))) -(defun vm-maybe-delete-windows-or-frames-on (buffer) +(defun vm-delete-windows-or-frames-on (buffer) (and (eq vm-mutable-windows t) (vm-window-loop 'delete buffer)) (and vm-mutable-frames (vm-frame-loop 'delete buffer))) @@ -414,7 +435,7 @@ (defun vm-bury-buffer (&optional buffer) (or buffer (setq buffer (current-buffer))) - (if vm-xemacs-p + (if (vm-xemacs-p) (if (vm-multiple-frames-possible-p) (vm-frame-loop 'bury buffer) (bury-buffer buffer)) @@ -453,31 +474,21 @@ (defun vm-set-hooks-for-frame-deletion () (make-local-variable 'vm-undisplay-buffer-hook) + (make-local-variable 'kill-buffer-hook) (add-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) (add-hook 'kill-buffer-hook 'vm-delete-buffer-frame)) -(defun vm-created-this-frame-p (&optional frame) - (memq (or frame (vm-selected-frame)) vm-frame-list)) - (defun vm-delete-buffer-frame () - ;; kludge. we only want to this to run on VM related buffers - ;; but this function is generally on a global hook. Check for - ;; vm-undisplay-buffer-hook set; this is a good sign that this - ;; is a VM buffer. - (if vm-undisplay-buffer-hook - (save-excursion - ;; run once only per buffer. - (remove-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) - (let* ((w (vm-get-visible-buffer-window (current-buffer))) - (b (current-buffer)) - (wf (and w (vm-window-frame w)))) - (and w (eq (vm-selected-frame) wf) (vm-created-this-frame-p wf) - (vm-error-free-call 'vm-delete-frame wf)) - (and w (let ((vm-mutable-frames t)) - (vm-maybe-delete-windows-or-frames-on b))))))) - -(defun vm-register-frame (frame) - (setq vm-frame-list (cons frame vm-frame-list))) + (save-excursion + (let ((w (vm-get-visible-buffer-window (current-buffer))) + (b (current-buffer))) + (and w (eq (vm-selected-frame) (vm-window-frame w)) + (vm-error-free-call 'vm-delete-frame (vm-window-frame w))) + (and w (let ((vm-mutable-frames t)) + (vm-delete-windows-or-frames-on b))))) + ;; do it only once + (remove-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) + (remove-hook 'kill-buffer-hook 'vm-delete-buffer-frame)) (defun vm-goto-new-frame (&rest types) (let ((params nil)) @@ -493,47 +504,12 @@ (select-screen (make-screen params))) ((fboundp 'new-screen) (select-screen (new-screen params)))) - (vm-register-frame (vm-selected-frame)) (and vm-warp-mouse-to-new-frame (vm-warp-mouse-to-frame-maybe (vm-selected-frame))))) -(defun vm-goto-new-summary-frame-maybe () - (if (and vm-mutable-frames vm-frame-per-summary - (vm-multiple-frames-possible-p)) - (let ((w (vm-get-buffer-window vm-summary-buffer))) - (if (null w) - (progn - (vm-goto-new-frame 'summary) - (vm-set-hooks-for-frame-deletion)) - (save-excursion - (select-window w) - (and vm-warp-mouse-to-new-frame - (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) - -(defun vm-goto-new-folder-frame-maybe (&rest types) - (if (and vm-mutable-frames vm-frame-per-folder - (vm-multiple-frames-possible-p)) - (let ((w (or (vm-get-buffer-window (current-buffer)) - ;; summary == folder for the purpose - ;; of frame reuse. - (and vm-summary-buffer - (vm-get-buffer-window vm-summary-buffer)) - ;; presentation == folder for the purpose - ;; of frame reuse. - (and vm-presentation-buffer - (vm-get-buffer-window vm-presentation-buffer))))) - (if (null w) - (progn - (apply 'vm-goto-new-frame types) - (vm-set-hooks-for-frame-deletion)) - (save-excursion - (select-window w) - (and vm-warp-mouse-to-new-frame - (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) - (defun vm-warp-mouse-to-frame-maybe (&optional frame) (or frame (setq frame (vm-selected-frame))) - (if (vm-mouse-support-possible-here-p) + (if (vm-mouse-support-possible-p) (cond ((vm-mouse-xemacs-mouse-p) (cond ((fboundp 'mouse-position);; XEmacs 19.12 (let ((mp (mouse-position))) @@ -602,25 +578,6 @@ ((fboundp 'screen-visible-p) 'screen-visible-p) (t 'ignore)))) -(if (fboundp 'frame-iconified-p) - (fset 'vm-frame-iconified-p 'frame-iconified-p) - (defun vm-frame-iconified-p (&optional frame) - (eq (vm-frame-visible-p frame) 'icon))) - -;; frame-totally-visible-p is broken under XEmacs 19.14 and is -;; absent under Emacs 19.34. So vm-frame-per-summary won't work -;; quite right under these Emacs versions. XEmacs 19.15 should -;; have a working version of this function. -;; 2 April 1997, frame-totally-visible-p apparently still broken -;; under 19.15. I give up for now. -;;(if (and (fboundp 'frame-totally-visible-p) -;; vm-xemacs-p -;; (or (>= emacs-major-version 20) -;; (>= emacs-minor-version 15))) -;; (fset 'vm-frame-totally-visible-p 'frame-totally-visible-p) -;; (fset 'vm-frame-totally-visible-p 'vm-frame-visible-p)) -(fset 'vm-frame-totally-visible-p 'vm-frame-visible-p) - (fset 'vm-window-frame (symbol-function (cond ((fboundp 'window-frame) 'window-frame)