X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-win.el;h=156f9a020fd0a9928e7aad52845906b5d06b35cb;hp=51934fd9b5fdf967796b98800cf1ce5e2b02b006;hb=b2ea476e0bc6e2973976b376c15be5381fe3127f;hpb=57474dcbadb6e9a970658c6ab8eea3c716b5dec4 diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 51934fd9b..156f9a020 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -1,26 +1,24 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1996-2011 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 +;; 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) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -29,6 +27,7 @@ (eval-when-compile (require 'cl)) (require 'gnus) +(require 'gnus-util) (defgroup gnus-windows nil "Window configuration." @@ -39,9 +38,6 @@ :group 'gnus-windows :type 'boolean) -(defvar gnus-window-configuration nil - "Obsolete variable. See `gnus-buffer-configuration'.") - (defcustom gnus-window-min-width 2 "*Minimum width of Gnus buffers." :group 'gnus-windows @@ -57,28 +53,23 @@ :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 (vertical 1.0 - (group 1.0 point) - (if gnus-carpal '(group-carpal 4)))) + (group 1.0 point))) (summary (vertical 1.0 - (summary 1.0 point) - (if gnus-carpal '(summary-carpal 4)))) + (summary 1.0 point))) (article (cond - ((and gnus-use-picons - (eq gnus-picons-display-where 'picons)) - '(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)))) (gnus-use-trees '(vertical 1.0 (summary 0.25 point) @@ -87,16 +78,13 @@ (t '(vertical 1.0 (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) (article 1.0))))) (server (vertical 1.0 - (server 1.0 point) - (if gnus-carpal '(server-carpal 2)))) + (server 1.0 point))) (browse (vertical 1.0 - (browse 1.0 point) - (if gnus-carpal '(browse-carpal 2)))) + (browse 1.0 point))) (message (vertical 1.0 (message 1.0 point))) @@ -110,6 +98,9 @@ (vertical 1.0 (summary 0.25) (faq 1.0 point))) + (only-article + (vertical 1.0 + (article 1.0 point))) (edit-article (vertical 1.0 (article 1.0 point))) @@ -121,12 +112,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 @@ -141,11 +136,10 @@ (pipe (vertical 1.0 (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) ("*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 @@ -165,7 +159,14 @@ (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. See the Gnus manual for an explanation of the syntax used.") @@ -178,25 +179,27 @@ See the Gnus manual for an explanation of the syntax used.") (edit-group . gnus-group-edit-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) - (server-carpal . gnus-carpal-server-buffer) - (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) (message . gnus-message-buffer) (mail . gnus-message-buffer) (post-news . gnus-message-buffer) (faq . gnus-faq-buffer) - (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)) + (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 @@ -215,56 +218,6 @@ See the Gnus manual for an explanation of the syntax used.") (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 '(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* ((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) - (while (< i 3) - (or (not (numberp (nth i elem))) - (zerop (nth i elem)) - (progn - (setq perc (if (= i 2) - 1.0 - (/ (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 (defun gnus-add-configuration (conf) "Add the window configuration CONF to `gnus-buffer-configuration'." @@ -286,22 +239,13 @@ See the Gnus manual for an explanation of the syntax used.") (defun gnus-configure-frame (split &optional window) "Split WINDOW according to SPLIT." - (let ((current-window - (or (get-buffer-window (current-buffer)) (selected-window)))) - (unless window - (setq window current-window)) + (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window))) + (window (or window current-window))) (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))) + (symbolp (car split)) (fboundp (car split))) (setq split (eval split))) (let* ((type (car split)) (subs (cddr split)) @@ -364,7 +308,7 @@ See the Gnus manual for an explanation of the syntax used.") (while subs (setq sub (append (pop subs) nil)) (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) + (symbolp (car sub)) (fboundp (car sub))) (setq sub (eval sub))) (when sub (push sub comp-subs) @@ -416,50 +360,55 @@ See the Gnus manual for an explanation of the syntax used.") (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) + (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)) + (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. - (gnus-delete-windows-in-gnusey-frames)) - ;; Just remove some windows. - (gnus-remove-some-windows) - (set-buffer nntp-server-buffer)) - (select-frame frame))) - - (let (gnus-window-frame-focus) - (set-buffer nntp-server-buffer) - (gnus-configure-frame split) - (when gnus-window-frame-focus - (select-frame (window-frame gnus-window-frame-focus)))))))) + (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. + (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." @@ -488,17 +437,13 @@ should have point." type buffer win buf) (while (and (setq split (pop stack)) all-visible) - ;; Be backwards compatible. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) + (when (consp (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))) + (symbolp (car split)) (fboundp (car split))) (setq split (eval split))) (setq type (elt split 0)) @@ -512,7 +457,7 @@ should have point." (unless buffer (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))) + (setq win (gnus-get-buffer-window buf t))) (if (memq 'point split) (setq all-visible win)) (setq all-visible nil))) @@ -524,6 +469,7 @@ should have point." all-visible))) (defun gnus-window-top-edge (&optional window) + "Return the top coordinate of WINDOW." (nth 1 (window-edges window))) (defun gnus-remove-some-windows () @@ -541,8 +487,32 @@ should have point." lowest-buf buf)))) (when lowest-buf (pop-to-buffer lowest-buf) - (set-buffer nntp-server-buffer)) - (mapcar (lambda (b) (delete-windows-on b t)) bufs)))) + (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)