X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-win.el;h=ca2a2d44b9e53a62e16825bae655b84ad0aba384;hb=0f02de60a02d0ca6ba8987750a764106ad91424b;hp=1f662b3b23aeb0f1b323a0dd742fd2fd999bed18;hpb=03551fdba7d496a4ff418d39f289057921bfe4e4;p=gnus

diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el
index 1f662b3b2..ca2a2d44b 100644
--- a/lisp/gnus-win.el
+++ b/lisp/gnus-win.el
@@ -1,7 +1,7 @@
 ;;; gnus-win.el --- window configuration functions for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -25,19 +25,36 @@
 
 ;;; Code:
 
-(require 'gnus-load)
+(eval-when-compile (require 'cl))
 
-(defvar gnus-use-full-window t
-  "*If non-nil, use the entire Emacs screen.")
+(require 'gnus)
+
+(defgroup gnus-windows nil
+  "Window configuration."
+  :group 'gnus)
+
+(defcustom gnus-use-full-window t
+  "*If non-nil, use the entire Emacs screen."
+  :group 'gnus-windows
+  :type 'boolean)
 
 (defvar gnus-window-configuration nil
   "Obsolete variable.  See `gnus-buffer-configuration'.")
 
-(defvar gnus-window-min-width 2
-  "*Minimum width of Gnus buffers.")
+(defcustom gnus-window-min-width 2
+  "*Minimum width of Gnus buffers."
+  :group 'gnus-windows
+  :type 'integer)
 
-(defvar gnus-window-min-height 1
-  "*Minimum height of Gnus buffers.")
+(defcustom gnus-window-min-height 1
+  "*Minimum height of Gnus buffers."
+  :group 'gnus-windows
+  :type 'integer)
+
+(defcustom gnus-always-force-window-configuration nil
+  "*If non-nil, always force the Gnus window configurations."
+  :group 'gnus-windows
+  :type 'boolean)
 
 (defvar gnus-buffer-configuration
   '((group
@@ -49,8 +66,9 @@
 	       (summary 1.0 point)
 	       (if gnus-carpal '(summary-carpal 4))))
     (article
-     (cond 
-      (gnus-use-picons
+     (cond
+      ((and gnus-use-picons
+	    (eq gnus-picons-display-where 'picons))
        '(frame 1.0
 	       (vertical 1.0
 			 (summary 0.25 point)
@@ -67,9 +85,9 @@
 		  (article 1.0)))
       (t
        '(vertical 1.0
-		 (summary 0.25 point)
-		 (if gnus-carpal '(summary-carpal 4))
-		 (article 1.0)))))
+		  (summary 0.25 point)
+		  (if gnus-carpal '(summary-carpal 4))
+		  (article 1.0)))))
     (server
      (vertical 1.0
 	       (server 1.0 point)
@@ -91,6 +109,9 @@
      (vertical 1.0
 	       (summary 0.25)
 	       (faq 1.0 point)))
+    (edit-article
+     (vertical 1.0
+	       (article 1.0 point)))
     (edit-form
      (vertical 1.0
 	       (group 0.5)
@@ -116,9 +137,6 @@
      (vertical 1.0
 	       (article 0.5)
 	       (message 1.0 point)))
-    (draft
-     (vertical 1.0
-	       (draft 1.0 point)))
     (pipe
      (vertical 1.0
 	       (summary 0.25 point)
@@ -128,24 +146,27 @@
      (vertical 1.0
 	       ("*Gnus Help Bug*" 0.5)
 	       ("*Gnus Bug*" 1.0 point)))
+    (score-trace
+     (vertical 1.0
+	       (summary 0.5 point)
+	       ("*Score Trace*" 1.0)))
+    (score-words
+     (vertical 1.0
+	       (summary 0.5 point)
+	       ("*Score Words*" 1.0)))
+    (split-trace
+     (vertical 1.0
+	       (summary 0.5 point)
+	       ("*Split Trace*" 1.0)))
+    (category
+     (vertical 1.0
+	       (category 1.0)))
     (compose-bounce
      (vertical 1.0
 	       (article 0.5)
 	       (message 1.0 point))))
   "Window configuration for all possible Gnus buffers.
-This variable is a list of lists.  Each of these lists has a NAME and
-a RULE.	 The NAMEs are commonsense names like `group', which names a
-rule used when displaying the group buffer; `summary', which names a
-rule for what happens when you enter a group and do not display an
-article buffer; and so on.  See the value of this variable for a
-complete list of NAMEs.
-
-Each RULE is a list of vectors.	 The first element in this vector is
-the name of the buffer to be displayed; the second element is the
-percentage of the screen this buffer is to occupy (a number in the
-0.0-0.99 range); the optional third element is `point', which should
-be present to denote which buffer point is to go to after making this
-buffer configuration.")
+See the Gnus manual for an explanation of the syntax used.")
 
 (defvar gnus-window-to-buffer
   '((group . gnus-group-buffer)
@@ -154,7 +175,7 @@ buffer configuration.")
     (server . gnus-server-buffer)
     (browse . "*Gnus Browse Server*")
     (edit-group . gnus-group-edit-buffer)
-    (edit-group . gnus-edit-form-buffer)
+    (edit-form . gnus-edit-form-buffer)
     (edit-server . gnus-server-edit-buffer)
     (group-carpal . gnus-carpal-group-buffer)
     (summary-carpal . gnus-carpal-summary-buffer)
@@ -165,62 +186,82 @@ buffer configuration.")
     (mail . gnus-message-buffer)
     (post-news . gnus-message-buffer)
     (faq . gnus-faq-buffer)
-    (picons . "*Picons*")
+    (picons . gnus-picons-buffer-name)
     (tree . gnus-tree-buffer)
+    (score-trace . "*Score Trace*")
+    (split-trace . "*Split Trace*")
     (info . gnus-info-buffer)
+    (category . gnus-category-buffer)
     (article-copy . gnus-article-copy)
     (draft . gnus-draft-buffer))
   "Mapping from short symbols to buffer names or buffer variables.")
 
+;;; Internal variables.
+
+(defvar gnus-current-window-configuration nil
+  "The most recently set window configuration.")
+
 (defvar gnus-created-frames nil)
+(defvar gnus-window-frame-focus nil)
 
 (defun gnus-kill-gnus-frames ()
   "Kill all frames Gnus has created."
   (while gnus-created-frames
     (when (frame-live-p (car gnus-created-frames))
-      ;; We slap a condition-case around this `delete-frame' to ensure 
+      ;; We slap a condition-case around this `delete-frame' to ensure
       ;; against errors if we try do delete the single frame that's left.
-      (condition-case ()
-	  (delete-frame (car gnus-created-frames))
-	(error nil)))
+      (ignore-errors
+	(delete-frame (car gnus-created-frames))))
     (pop gnus-created-frames)))
 
+(defun gnus-window-configuration-element (list)
+  (while (and list
+	      (not (assq (car list) gnus-window-configuration)))
+    (pop list))
+  (cadr (assq (car list) gnus-window-configuration)))
+
 (defun gnus-windows-old-to-new (setting)
   ;; First we take care of the really, really old Gnus 3 actions.
   (when (symbolp setting)
     (setq setting
 	  ;; Take care of ooold GNUS 3.x values.
 	  (cond ((eq setting 'SelectArticle) 'article)
-		((memq setting '(SelectSubject ExpandSubject)) 'summary)
-		((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
+		((memq setting '(SelectNewsgroup SelectSubject ExpandSubject))
+		 'summary)
+		((memq setting '(ExitNewsgroup)) 'group)
 		(t setting))))
   (if (or (listp setting)
 	  (not (and gnus-window-configuration
 		    (memq setting '(group summary article)))))
       setting
-    (let* ((setting (if (eq setting 'group)
-			(if (assq 'newsgroup gnus-window-configuration)
-			    'newsgroup
-			  'newsgroups) setting))
-	   (elem (cadr (assq setting gnus-window-configuration)))
+    (let* ((elem
+	    (cond
+	     ((eq setting 'group)
+	      (gnus-window-configuration-element
+	       '(group newsgroups ExitNewsgroup)))
+	     ((eq setting 'summary)
+	      (gnus-window-configuration-element
+	       '(summary SelectNewsgroup SelectSubject ExpandSubject)))
+	     ((eq setting 'article)
+	      (gnus-window-configuration-element
+	       '(article SelectArticle)))))
 	   (total (apply '+ elem))
 	   (types '(group summary article))
 	   (pbuf (if (eq setting 'newsgroups) 'group 'summary))
 	   (i 0)
-	   perc
-	   out)
+	   perc out)
       (while (< i 3)
 	(or (not (numberp (nth i elem)))
 	    (zerop (nth i elem))
 	    (progn
 	      (setq perc (if (= i 2)
 			     1.0
-			   (/ (float (nth 0 elem)) total)))
-	      (setq out (cons (if (eq pbuf (nth i types))
-				  (list (nth i types) perc 'point)
-				(list (nth i types) perc))
-			      out))))
-	(setq i (1+ i)))
+			   (/ (float (nth i elem)) total)))
+	      (push (if (eq pbuf (nth i types))
+			(list (nth i types) perc 'point)
+		      (list (nth i types) perc))
+		    out)))
+	(incf i))
       `(vertical 1.0 ,@(nreverse out)))))
 
 ;;;###autoload
@@ -232,6 +273,16 @@ buffer configuration.")
 
 (defvar gnus-frame-list nil)
 
+(defun gnus-window-to-buffer-helper (obj)
+  (cond ((not (symbolp obj))
+	 obj)
+	((boundp obj)
+	 (symbol-value obj))
+	((fboundp obj)
+	 (funcall obj))
+	(t
+	 nil)))
+
 (defun gnus-configure-frame (split &optional window)
   "Split WINDOW according to SPLIT."
   (unless window
@@ -265,15 +316,13 @@ buffer configuration.")
      ;; This is a buffer to be selected.
      ((not (memq type '(frame horizontal vertical)))
       (let ((buffer (cond ((stringp type) type)
-			  (t (cdr (assq type gnus-window-to-buffer)))))
-	    buf)
+			  (t (cdr (assq type gnus-window-to-buffer))))))
 	(unless buffer
-	  (error "Illegal buffer type: %s" type))
-	(unless (setq buf (get-buffer (if (symbolp buffer)
-					  (symbol-value buffer) buffer)))
-	  (setq buf (get-buffer-create (if (symbolp buffer)
-					   (symbol-value buffer) buffer))))
-	(switch-to-buffer buf)
+	  (error "Invalid buffer type: %s" type))
+	(switch-to-buffer (gnus-get-buffer-create
+			   (gnus-window-to-buffer-helper buffer)))
+	(when (memq 'frame-focus split)
+	  (setq gnus-window-frame-focus window))
 	;; We return the window if it has the `point' spec.
 	(and (memq 'point split) window)))
      ;; This is a frame split.
@@ -324,7 +373,7 @@ buffer configuration.")
 		  ((integerp size)
 		   (setq s size))
 		  (t
-		   (error "Illegal size: %s" size)))
+		   (error "Invalid size: %s" size)))
 	    ;; Try to make sure that we are inside the safe limits.
 	    (cond ((zerop s))
 		  ((eq type 'horizontal)
@@ -347,7 +396,8 @@ buffer configuration.")
 		  (split-window window (cadar comp-subs)
 				(eq type 'horizontal))))
 	  (setq result (or (gnus-configure-frame
-			    (car comp-subs) window) result))
+			    (car comp-subs) window)
+			   result))
 	  (select-window new-win)
 	  (setq window new-win)
 	  (setq comp-subs (cdr comp-subs))))
@@ -358,50 +408,68 @@ buffer configuration.")
 (defvar gnus-frame-split-p nil)
 
 (defun gnus-configure-windows (setting &optional force)
-  (setq setting (gnus-windows-old-to-new setting))
-  (let ((split (if (symbolp setting)
-		   (cadr (assq setting gnus-buffer-configuration))
-		 setting))
-	all-visible)
-
-    (setq gnus-frame-split-p nil)
-
-    (unless split
-      (error "No such setting: %s" setting))
-
-    (if (and (setq all-visible (gnus-all-windows-visible-p split))
-	     (not force))
-	;; All the windows mentioned are already visible, so we just
-	;; put point in the assigned buffer, and do not touch the
-	;; winconf.
-	(select-window all-visible)
-
-      ;; Either remove all windows or just remove all Gnus windows.
-      (let ((frame (selected-frame)))
-	(unwind-protect
-	    (if gnus-use-full-window
-		;; We want to remove all other windows.
-		(if (not gnus-frame-split-p)
-		    ;; This is not a `frame' split, so we ignore the
-		    ;; other frames.  
-		    (delete-other-windows)
-		  ;; This is a `frame' split, so we delete all windows
-		  ;; on all frames.
-		  (mapcar 
-		   (lambda (frame)
-		     (unless (eq (cdr (assq 'minibuffer
-					    (frame-parameters frame)))
-				 'only)
-		       (select-frame frame)
-		       (delete-other-windows)))
-		   (frame-list)))
-	      ;; Just remove some windows.
-	      (gnus-remove-some-windows)
-	      (switch-to-buffer nntp-server-buffer))
-	  (select-frame frame)))
-
-      (switch-to-buffer nntp-server-buffer)
-      (gnus-configure-frame split (get-buffer-window (current-buffer))))))
+  (if (window-configuration-p setting)
+      (set-window-configuration setting)
+    (setq gnus-current-window-configuration setting)
+    (setq force (or force gnus-always-force-window-configuration))
+    (setq setting (gnus-windows-old-to-new setting))
+    (let ((split (if (symbolp setting)
+		     (cadr (assq setting gnus-buffer-configuration))
+		   setting))
+	  all-visible)
+
+      (setq gnus-frame-split-p nil)
+
+      (unless split
+	(error "No such setting: %s" setting))
+
+      (if (and (setq all-visible (gnus-all-windows-visible-p split))
+	       (not force))
+	  ;; All the windows mentioned are already visible, so we just
+	  ;; put point in the assigned buffer, and do not touch the
+	  ;; winconf.
+	  (select-window all-visible)
+
+	;; Either remove all windows or just remove all Gnus windows.
+	(let ((frame (selected-frame)))
+	  (unwind-protect
+	      (if gnus-use-full-window
+		  ;; We want to remove all other windows.
+		  (if (not gnus-frame-split-p)
+		      ;; This is not a `frame' split, so we ignore the
+		      ;; other frames.
+		      (delete-other-windows)
+		    ;; This is a `frame' split, so we delete all windows
+		    ;; on all frames.
+		    (gnus-delete-windows-in-gnusey-frames))
+		;; Just remove some windows.
+		(gnus-remove-some-windows)
+		(switch-to-buffer nntp-server-buffer))
+	    (select-frame frame)))
+
+	(switch-to-buffer nntp-server-buffer)
+	(let (gnus-window-frame-focus)
+	  (gnus-configure-frame split (get-buffer-window (current-buffer)))
+	  (when gnus-window-frame-focus
+	    (select-frame (window-frame gnus-window-frame-focus))))))))
+
+(defun gnus-delete-windows-in-gnusey-frames ()
+  "Do a `delete-other-windows' in all frames that have Gnus windows."
+  (let ((buffers (gnus-buffers)))
+    (mapcar
+     (lambda (frame)
+       (unless (eq (cdr (assq 'minibuffer
+			      (frame-parameters frame)))
+		   'only)
+	 (select-frame frame)
+	 (let (do-delete)
+	   (walk-windows
+	    (lambda (window)
+	      (when (memq (window-buffer window) buffers)
+		(setq do-delete t))))
+	   (when do-delete
+	     (delete-other-windows)))))
+     (frame-list))))
 
 (defun gnus-all-windows-visible-p (split)
   "Say whether all buffers in SPLIT are currently visible.
@@ -434,13 +502,10 @@ should have point."
 	(setq buffer (cond ((stringp type) type)
 			   (t (cdr (assq type gnus-window-to-buffer)))))
 	(unless buffer
-	  (error "Illegal buffer type: %s" type))
-	(when (setq buf (get-buffer (if (symbolp buffer)
-					(symbol-value buffer)
-				      buffer)))
-	  (setq win (get-buffer-window buf t)))
-	(if win
-	    (when (memq 'point split)
+	  (error "Invalid buffer type: %s" type))
+	(if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer)))
+		 (setq win (get-buffer-window buf t)))
+	    (if (memq 'point split)
 		(setq all-visible win))
 	  (setq all-visible nil)))
        (t
@@ -454,46 +519,22 @@ should have point."
   (nth 1 (window-edges window)))
 
 (defun gnus-remove-some-windows ()
-  (let ((buffers gnus-window-to-buffer)
+  (let ((buffers (gnus-buffers))
 	buf bufs lowest-buf lowest)
     (save-excursion
       ;; Remove windows on all known Gnus buffers.
-      (while buffers
-	(setq buf (cdar buffers))
-	(if (symbolp buf)
-	    (setq buf (and (boundp buf) (symbol-value buf))))
-	(and buf
-	     (get-buffer-window buf)
-	     (progn
-	       (setq bufs (cons buf bufs))
-	       (pop-to-buffer buf)
-	       (if (or (not lowest)
-		       (< (gnus-window-top-edge) lowest))
-		   (progn
-		     (setq lowest (gnus-window-top-edge))
-		     (setq lowest-buf buf)))))
-	(setq buffers (cdr buffers)))
-      ;; Remove windows on *all* summary buffers.
-      (walk-windows
-       (lambda (win)
-	 (let ((buf (window-buffer win)))
-	   (if (string-match	"^\\*Summary" (buffer-name buf))
-	       (progn
-		 (setq bufs (cons buf bufs))
-		 (pop-to-buffer buf)
-		 (if (or (not lowest)
-			 (< (gnus-window-top-edge) lowest))
-		     (progn
-		       (setq lowest-buf buf)
-		       (setq lowest (gnus-window-top-edge)))))))))
-      (and lowest-buf
-	   (progn
-	     (pop-to-buffer lowest-buf)
-	     (switch-to-buffer nntp-server-buffer)))
-      (while bufs
-	(and (not (eq (car bufs) lowest-buf))
-	     (delete-windows-on (car bufs)))
-	(setq bufs (cdr bufs))))))
+      (while (setq buf (pop buffers))
+	(when (get-buffer-window buf)
+	  (push buf bufs)
+	  (pop-to-buffer buf)
+	  (when (or (not lowest)
+		    (< (gnus-window-top-edge) lowest))
+	    (setq lowest (gnus-window-top-edge)
+		  lowest-buf buf))))
+      (when lowest-buf
+	(pop-to-buffer lowest-buf)
+	(switch-to-buffer nntp-server-buffer))
+      (mapcar (lambda (b) (delete-windows-on b t)) bufs))))
 
 (provide 'gnus-win)