diff lisp/vm/vm-window.el @ 98:0d2f883870bc r20-1b1

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents c0c698873ce1
children 4be1180a9e89
line wrap: on
line diff
--- a/lisp/vm/vm-window.el	Mon Aug 13 09:12:43 2007 +0200
+++ b/lisp/vm/vm-window.el	Mon Aug 13 09:13:56 2007 +0200
@@ -1,5 +1,5 @@
 ;;; Window management code for VM
-;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones
+;;; Copyright (C) 1989-1997 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,7 +17,8 @@
 
 (provide 'vm-window)
 
-(defun vm-display (buffer display commands configs)
+(defun vm-display (buffer display commands configs
+		   &optional do-not-raise)
 ;; the clearinghouse VM display function.
 ;;
 ;; First arg BUFFER non-nil is a buffer to display or undisplay.
@@ -62,11 +63,13 @@
 ;; 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))))
+   (let* ((w (and buffer (vm-get-buffer-window buffer)))
+	  (wf (and w (vm-window-frame w))))
      (and buffer (set-buffer buffer))
-     (and w display (vm-raise-frame (vm-window-frame w)))
-     (and w display (not (eq (vm-selected-frame) (vm-window-frame w)))
-	  (vm-select-frame (vm-window-frame w)))
+     (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))
      (cond ((and buffer display)
 	    (if (and vm-display-buffer-hook
 		     (null (vm-get-visible-buffer-window buffer)))
@@ -155,12 +158,16 @@
 	       (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)))
+	       (setq message vm-mail-buffer
+		     ;; assume that the proximity implies affinity
+		     composition (current-buffer))))
 	    ((eq vm-system-state 'editing)
 	     (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer)))
 		 (throw 'done nil)
@@ -169,6 +176,9 @@
 	    ;; 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))
@@ -395,7 +405,8 @@
 	      (progn
 		(condition-case nil
 		    (progn
-		      (vm-delete-frame delete-me)
+		      (if (vm-created-this-frame-p delete-me)
+			  (vm-delete-frame delete-me))
 		      (if (eq delete-me start)
 			  (setq start nil)))
 		  (error nil))
@@ -473,21 +484,31 @@
 
 (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 ()
-  (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))
+  ;; 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-delete-windows-or-frames-on b)))))))
+
+(defun vm-register-frame (frame)
+  (setq vm-frame-list (cons frame vm-frame-list)))
 
 (defun vm-goto-new-frame (&rest types)
   (let ((params nil))
@@ -503,9 +524,42 @@
 	   (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-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-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-p)
@@ -577,6 +631,22 @@
 	     ((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.
+(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-window-frame
       (symbol-function
        (cond ((fboundp 'window-frame) 'window-frame)