X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-win.el;h=ba77620fc24824f410f00caa108c95889cc3dc3b;hp=03f76f875734cd2c78e6a05a4457dcaeadf5c735;hb=6d3039252bb175eba53a2028cbf3c0e90112388d;hpb=34be01cf143ec2638b057b4606dcc30cebdeea07 diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 03f76f875..ba77620fc 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -1,14 +1,16 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -18,26 +20,52 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: -(require 'gnus-load) +(eval-when-compile (require 'cl)) + +(require 'gnus) +(require 'gnus-util) + +(defgroup gnus-windows nil + "Window configuration." + :group 'gnus) -(defvar gnus-use-full-window t - "*If non-nil, use the entire Emacs screen.") +(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.") - -(defvar gnus-window-min-height 1 - "*Minimum height 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) + +(defcustom gnus-always-force-window-configuration nil + "*If non-nil, always force the Gnus window configurations." + :group 'gnus-windows + :type 'boolean) + +(defcustom gnus-use-frames-on-any-display nil + "*If non-nil, frames on all displays will be considered useable by Gnus. +When nil, only frames on the same display as the selected frame will be +used to display Gnus windows." + :version "22.1" + :group 'gnus-windows + :type 'boolean) (defvar gnus-buffer-configuration '((group @@ -49,17 +77,7 @@ (summary 1.0 point) (if gnus-carpal '(summary-carpal 4)))) (article - (cond - ((and gnus-use-picons (not (eq gnus-picons-display-where 'article))) - '(frame 1.0 - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0)) - (vertical ((height . 5) (width . 15) - (user-position . t) - (left . -1) (top . 1)) - (picons 1.0)))) + (cond (gnus-use-trees '(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) @@ -102,12 +120,16 @@ (vertical 1.0 (summary 0.25) (edit-score 1.0 point))) + (edit-server + (vertical 1.0 + (server 0.5) + (edit-form 1.0 point))) (post (vertical 1.0 (post 1.0 point))) (reply (vertical 1.0 - (article-copy 0.5) + (article 0.5) (message 1.0 point))) (forward (vertical 1.0 @@ -119,9 +141,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) @@ -129,34 +148,36 @@ ("*Shell Command Output*" 1.0))) (bug (vertical 1.0 - ("*Gnus Help Bug*" 0.5) + (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) ("*Gnus Bug*" 1.0 point))) (score-trace (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)))) + (message 1.0 point))) + (display-term + (vertical 1.0 + ("*display*" 1.0))) + (mml-preview + (vertical 1.0 + (message 0.5) + (mml-preview 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) @@ -176,24 +197,38 @@ buffer configuration.") (mail . gnus-message-buffer) (post-news . gnus-message-buffer) (faq . gnus-faq-buffer) - (picons . "*Picons*") (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)) + (draft . gnus-draft-buffer) + (mml-preview . mml-preview-buffer)) "Mapping from short symbols to buffer names or buffer variables.") +(defcustom gnus-configure-windows-hook nil + "*A hook called when configuring windows." + :version "22.1" + :group 'gnus-windows + :type 'hook) + +;;; 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) @@ -217,7 +252,7 @@ buffer configuration.") (memq setting '(group summary article))))) setting (let* ((elem - (cond + (cond ((eq setting 'group) (gnus-window-configuration-element '(group newsgroups ExitNewsgroup))) @@ -255,176 +290,216 @@ 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 - (setq window (get-buffer-window (current-buffer)))) - (select-window window) - ;; This might be an old-stylee buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - (let* ((type (car split)) - (subs (cddr split)) - (len (if (eq type 'horizontal) (window-width) (window-height))) - (total 0) - (window-min-width (or gnus-window-min-width window-min-width)) - (window-min-height (or gnus-window-min-height window-min-height)) - s result new-win rest comp-subs size sub) - (cond - ;; Nothing to do here. - ((null split)) - ;; Don't switch buffers. - ((null type) - (and (memq 'point split) 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) - (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) - ;; We return the window if it has the `point' spec. - (and (memq 'point split) window))) - ;; This is a frame split. - ((eq type 'frame) - (unless gnus-frame-list - (setq gnus-frame-list (list (window-frame - (get-buffer-window (current-buffer)))))) - (let ((i 0) - params frame fresult) - (while (< i (length subs)) - ;; Frame parameter is gotten from the sub-split. - (setq params (cadr (elt subs i))) - ;; It should be a list. - (unless (listp params) - (setq params nil)) - ;; Create a new frame? - (unless (setq frame (elt gnus-frame-list i)) - (nconc gnus-frame-list (list (setq frame (make-frame params)))) - (push frame gnus-created-frames)) - ;; Is the old frame still alive? - (unless (frame-live-p frame) - (setcar (nthcdr i gnus-frame-list) - (setq frame (make-frame params)))) - ;; Select the frame in question and do more splits there. - (select-frame frame) - (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) - (incf i)) - ;; Select the frame that has the selected buffer. - (when fresult - (select-frame (window-frame fresult))))) - ;; This is a normal split. - (t - (when (> (length subs) 0) - ;; First we have to compute the sizes of all new windows. - (while subs - (setq sub (append (pop subs) nil)) - (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) - (setq sub (eval sub))) - (when sub - (push sub comp-subs) - (setq size (cadar comp-subs)) - (cond ((equal size 1.0) - (setq rest (car comp-subs)) - (setq s 0)) - ((floatp size) - (setq s (floor (* size len)))) - ((integerp size) - (setq s size)) - (t - (error "Illegal size: %s" size))) - ;; Try to make sure that we are inside the safe limits. - (cond ((zerop s)) - ((eq type 'horizontal) - (setq s (max s window-min-width))) - ((eq type 'vertical) - (setq s (max s window-min-height)))) - (setcar (cdar comp-subs) s) - (incf total s))) - ;; Take care of the "1.0" spec. - (if rest - (setcar (cdr rest) (- len total)) - (error "No 1.0 specs in %s" split)) - ;; The we do the actual splitting in a nice recursive - ;; fashion. - (setq comp-subs (nreverse comp-subs)) - (while comp-subs - (if (null (cdr comp-subs)) - (setq new-win window) - (setq new-win - (split-window window (cadar comp-subs) - (eq type 'horizontal)))) - (setq result (or (gnus-configure-frame - (car comp-subs) window) result)) - (select-window new-win) - (setq window new-win) - (setq comp-subs (cdr comp-subs)))) - ;; Return the proper window, if any. - (when result - (select-window result)))))) + (let ((current-window + (or (get-buffer-window (current-buffer)) (selected-window)))) + (unless window + (setq window current-window)) + (select-window window) + ;; This might be an old-style buffer config. + (when (vectorp split) + (setq split (append split nil))) + (when (or (consp (car split)) + (vectorp (car split))) + (push 1.0 split) + (push 'vertical split)) + ;; The SPLIT might be something that is to be evaled to + ;; return a new SPLIT. + (while (and (not (assq (car split) gnus-window-to-buffer)) + (symbolp (car split)) (fboundp (car split))) + (setq split (eval split))) + (let* ((type (car split)) + (subs (cddr split)) + (len (if (eq type 'horizontal) (window-width) (window-height))) + (total 0) + (window-min-width (or gnus-window-min-width window-min-width)) + (window-min-height (or gnus-window-min-height window-min-height)) + s result new-win rest comp-subs size sub) + (cond + ;; Nothing to do here. + ((null split)) + ;; Don't switch buffers. + ((null type) + (and (memq 'point split) 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)))))) + (unless buffer + (error "Invalid buffer type: %s" type)) + (let ((buf (gnus-get-buffer-create + (gnus-window-to-buffer-helper buffer)))) + (if (eq buf (window-buffer (selected-window))) (set-buffer buf) + (switch-to-buffer buf))) + (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. + ((eq type 'frame) + (unless gnus-frame-list + (setq gnus-frame-list (list (window-frame current-window)))) + (let ((i 0) + params frame fresult) + (while (< i (length subs)) + ;; Frame parameter is gotten from the sub-split. + (setq params (cadr (elt subs i))) + ;; It should be a list. + (unless (listp params) + (setq params nil)) + ;; Create a new frame? + (unless (setq frame (elt gnus-frame-list i)) + (nconc gnus-frame-list (list (setq frame (make-frame params)))) + (push frame gnus-created-frames)) + ;; Is the old frame still alive? + (unless (frame-live-p frame) + (setcar (nthcdr i gnus-frame-list) + (setq frame (make-frame params)))) + ;; Select the frame in question and do more splits there. + (select-frame frame) + (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) + (incf i)) + ;; Select the frame that has the selected buffer. + (when fresult + (select-frame (window-frame fresult))))) + ;; This is a normal split. + (t + (when (> (length subs) 0) + ;; First we have to compute the sizes of all new windows. + (while subs + (setq sub (append (pop subs) nil)) + (while (and (not (assq (car sub) gnus-window-to-buffer)) + (symbolp (car sub)) (fboundp (car sub))) + (setq sub (eval sub))) + (when sub + (push sub comp-subs) + (setq size (cadar comp-subs)) + (cond ((equal size 1.0) + (setq rest (car comp-subs)) + (setq s 0)) + ((floatp size) + (setq s (floor (* size len)))) + ((integerp size) + (setq s size)) + (t + (error "Invalid size: %s" size))) + ;; Try to make sure that we are inside the safe limits. + (cond ((zerop s)) + ((eq type 'horizontal) + (setq s (max s window-min-width))) + ((eq type 'vertical) + (setq s (max s window-min-height)))) + (setcar (cdar comp-subs) s) + (incf total s))) + ;; Take care of the "1.0" spec. + (if rest + (setcar (cdr rest) (- len total)) + (error "No 1.0 specs in %s" split)) + ;; The we do the actual splitting in a nice recursive + ;; fashion. + (setq comp-subs (nreverse comp-subs)) + (while comp-subs + (if (null (cdr comp-subs)) + (setq new-win window) + (setq new-win + (split-window window (cadar comp-subs) + (eq type 'horizontal)))) + (setq result (or (gnus-configure-frame + (car comp-subs) window) + result)) + (select-window new-win) + (setq window new-win) + (setq comp-subs (cdr comp-subs)))) + ;; Return the proper window, if any. + (when result + (select-window result))))))) (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) + (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 in `gnus-buffer-configuration': %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) + + ;; Make sure "the other" buffer, nntp-server-buffer, is live. + (unless (gnus-buffer-live-p nntp-server-buffer) + (nnheader-init-server-buffer)) + + ;; 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)))))) + ;; on all frames. + (gnus-delete-windows-in-gnusey-frames)) + ;; Just remove some windows. + (gnus-remove-some-windows) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer))) + (select-frame frame))) + + (let (gnus-window-frame-focus) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer)) + (gnus-configure-frame split) + (run-hooks 'gnus-configure-windows-hook) + (when gnus-window-frame-focus + (gnus-select-frame-set-input-focus + (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. @@ -445,7 +520,7 @@ should have point." ;; The SPLIT might be something that is to be evaled to ;; return a new SPLIT. (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) + (symbolp (car split)) (fboundp (car split))) (setq split (eval split))) (setq type (elt split 0)) @@ -457,13 +532,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 (gnus-get-buffer-window buf t))) + (if (memq 'point split) (setq all-visible win)) (setq all-visible nil))) (t @@ -477,47 +549,48 @@ 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) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer))) + (mapcar (lambda (b) (delete-windows-on b t)) + (delq lowest-buf bufs))))) + +(eval-and-compile + (cond + ((fboundp 'frames-on-display-list) + (defalias 'gnus-frames-on-display-list 'frames-on-display-list)) + ((and (featurep 'xemacs) (fboundp 'frame-device)) + (defun gnus-frames-on-display-list () + (apply 'filtered-frame-list 'identity (list (frame-device nil))))) + (t + (defalias 'gnus-frames-on-display-list 'frame-list)))) + +(defun gnus-get-buffer-window (buffer &optional frame) + (cond ((and (null gnus-use-frames-on-any-display) + (memq frame '(t 0 visible))) + (car + (let ((frames (gnus-frames-on-display-list))) + (gnus-remove-if (lambda (win) (not (memq (window-frame win) + frames))) + (get-buffer-window-list buffer nil frame))))) + (t + (get-buffer-window buffer frame)))) (provide 'gnus-win) +;; arch-tag: ccd5a394-2ddf-4397-b8f8-6d80d3e46e2b ;;; gnus-win.el ends here