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)