;;; 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.
;;; 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)
+
+(defcustom gnus-window-min-height 1
+ "*Minimum height of Gnus buffers."
+ :group 'gnus-windows
+ :type 'integer)
-(defvar gnus-window-min-height 1
- "*Minimum height of Gnus buffers.")
+(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
(summary 1.0 point)
(if gnus-carpal '(summary-carpal 4))))
(article
- (cond
- ((and gnus-use-picons (not (eq gnus-picons-display-where 'article)))
+ (cond
+ ((and gnus-use-picons
+ (eq gnus-picons-display-where 'picons))
'(frame 1.0
(vertical 1.0
(summary 0.25 point)
(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)
(vertical 1.0
(summary 0.5 point)
("*Score Trace*" 1.0)))
- (score-trace
+ (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)
(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
(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
;; 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.
((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)
(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))))
(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.
(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)
- (setq all-visible win))
+ (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
(when (eq type 'frame)
(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)