X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=9458e0ed52dab667f320366e6f05ce0b30775fec;hp=ce2076e1341314d26ce4dff76a0ec75388f7a11d;hb=36d27d90fafa6fcc336edc1189a81e5407b615b7;hpb=1714c3f92e1738e9dff788c335e25d89eca75068 diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index ce2076e13..9458e0ed5 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,26 +1,25 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 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: @@ -34,7 +33,15 @@ (require 'gnus-util) (autoload 'message-make-date "message") (autoload 'gnus-agent-read-servers-validate "gnus-agent") -(eval-when-compile (require 'cl)) +(autoload 'gnus-agent-save-local "gnus-agent") +(autoload 'gnus-agent-possibly-alter-active "gnus-agent") + +(eval-when-compile + (require 'cl)) + +(defvar gnus-agent-covered-methods) +(defvar gnus-agent-file-loading-local) +(defvar gnus-agent-file-loading-cache) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") "Your `.newsrc' file. @@ -43,9 +50,10 @@ :type 'file) (defcustom gnus-backup-startup-file 'never - "Whether to create backup files. + "Control use of version numbers for backups of `gnus-startup-file'. This variable takes the same values as the `version-control' variable." + :version "22.1" :group 'gnus-start :type '(choice (const :tag "Never" never) (const :tag "If existing" nil) @@ -56,6 +64,7 @@ variable." the buffer or write directly to the file. The buffer is faster because all of the contents are written at once. The direct write uses considerably less memory." + :version "22.1" :group 'gnus-start :type '(choice (const :tag "Write via buffer" t) (const :tag "Write directly to file" nil))) @@ -167,8 +176,13 @@ properly with all servers." (defconst gnus-level-unsubscribed 7 "Groups with levels less than or equal to this variable are unsubscribed. -Groups with levels less than `gnus-level-subscribed', which should be -less than this variable, are subscribed.") + +Groups with levels less than `gnus-level-subscribed', which +should be less than this variable, are subscribed. Groups with +levels from `gnus-level-subscribed' (exclusive) upto this +variable (inclusive) are unsubscribed. See also +`gnus-level-zombie', `gnus-level-killed' and the Info node `(gnus)Group +Levels' for details.") (defconst gnus-level-zombie 8 "Groups with this level are zombie groups.") @@ -248,7 +262,7 @@ not match this regexp will be removed before saving the list." (and value (not (stringp value)))) :value t) (const nil) - (regexp :format "%t: %v\n" :size 0))) + regexp)) (defcustom gnus-ignored-newsgroups (mapconcat 'identity @@ -289,6 +303,7 @@ claim them." (defcustom gnus-subscribe-newsgroup-hooks nil "*Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." + :version "22.1" :group 'gnus-group-new :type 'hook) @@ -301,8 +316,8 @@ If, for instance, you want to subscribe to all newsgroups in the options -n no.all alt.all -Gnus will the subscribe all new newsgroups in these hierarchies with -the subscription method in this variable." +Gnus will then subscribe all new newsgroups in these hierarchies +with the subscription method in this variable." :group 'gnus-group-new :type '(radio (function-item gnus-subscribe-randomly) (function-item gnus-subscribe-alphabetically) @@ -340,7 +355,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'." (defcustom gnus-options-subscribe nil "*All new groups matching this regexp will be subscribed unconditionally. -Note that this variable deals only with new newsgroups. This variable +Note that this variable deals only with new newsgroups. This variable does not affect old newsgroups. New groups that match this regexp will not be handled by @@ -352,7 +367,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'." (defcustom gnus-options-not-subscribe nil "*All new groups matching this regexp will be ignored. -Note that this variable deals only with new newsgroups. This variable +Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups." :group 'gnus-group-new :type '(choice regexp @@ -377,7 +392,7 @@ This hook is called after Gnus is connected to the NNTP server." :type 'hook) (defcustom gnus-before-startup-hook nil - "A hook called at before startup. + "A hook called before startup. This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) @@ -395,6 +410,7 @@ This hook is called as the first thing when Gnus is started." (defcustom gnus-get-top-new-news-hook nil "A hook run just before Gnus checks for new news globally." + :version "22.1" :group 'gnus-group-new :type 'hook) @@ -445,6 +461,8 @@ Can be used to turn version control on or off." ;;; Internal variables +;; Fixme: deal with old emacs-mule when mm-universal-coding-system is +;; utf-8-emacs. (defvar gnus-ding-file-coding-system mm-universal-coding-system "Coding system for ding file.") @@ -488,19 +506,23 @@ Can be used to turn version control on or off." (defun gnus-subscribe-hierarchical-interactive (groups) (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) + prefixes prefix start ans group starts real-group) (while groups (setq prefixes (list "^")) (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) + (while (not (string-match (car prefixes) + (gnus-group-real-name (car groups)))) (setq prefixes (cdr prefixes))) (setq prefix (car prefixes)) (setq start (1- (length prefix))) - (if (and (string-match "[^\\.]\\." (car groups) start) + (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups)) + start) (cdr groups) (setq prefix - (concat "^" (substring (car groups) 0 (match-end 0)))) - (string-match prefix (cadr groups))) + (concat "^" (substring + (gnus-group-real-name (car groups)) + 0 (match-end 0)))) + (string-match prefix (gnus-group-real-name (cadr groups)))) (progn (push prefix prefixes) (message "Descend hierarchy %s? ([y]nsq): " @@ -512,16 +534,18 @@ Can be used to turn version control on or off." (substring prefix 1 (1- (length prefix))))) (cond ((= ans ?n) (while (and groups - (string-match prefix - (setq group (car groups)))) + (setq group (car groups) + real-group (gnus-group-real-name group)) + (string-match prefix real-group)) (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups))) (setq starts (cdr starts))) ((= ans ?s) (while (and groups - (string-match prefix - (setq group (car groups)))) + (setq group (car groups) + real-group (gnus-group-real-name group)) + (string-match prefix real-group)) (gnus-sethash group group gnus-killed-hashtb) (gnus-subscribe-alphabetically (car groups)) (setq groups (cdr groups))) @@ -593,7 +617,7 @@ Can be used to turn version control on or off." "Subscribe the new GROUP interactively. It is inserted in hierarchical newsgroup order if subscribed. If not, it is killed." - (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) + (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group)) (gnus-subscribe-hierarchically group) (push group gnus-killed-list))) @@ -607,15 +631,14 @@ it is killed." (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. -If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made +If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup." (save-excursion (goto-char (point-min)) ;; We subscribe the group by changing its level to `subscribed'. (gnus-group-change-level newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-gethash (or next "dummy.group") - gnus-newsrc-hashtb)) + gnus-level-killed (gnus-group-entry (or next "dummy.group"))) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) t)) @@ -627,21 +650,20 @@ the first newsgroup." ;;; General various misc type functions. ;; Silence byte-compiler. -(eval-when-compile - (defvar gnus-current-headers) - (defvar gnus-thread-indent-array) - (defvar gnus-newsgroup-name) - (defvar gnus-newsgroup-headers) - (defvar gnus-group-list-mode) - (defvar gnus-group-mark-positions) - (defvar gnus-newsgroup-data) - (defvar gnus-newsgroup-unreads) - (defvar nnoo-state-alist) - (defvar gnus-current-select-method) - (defvar mail-sources) - (defvar nnmail-scan-directory-mail-source-once) - (defvar nnmail-split-history) - (defvar nnmail-spool-file)) +(defvar gnus-current-headers) +(defvar gnus-thread-indent-array) +(defvar gnus-newsgroup-name) +(defvar gnus-newsgroup-headers) +(defvar gnus-group-list-mode) +(defvar gnus-group-mark-positions) +(defvar gnus-newsgroup-data) +(defvar gnus-newsgroup-unreads) +(defvar nnoo-state-alist) +(defvar gnus-current-select-method) +(defvar mail-sources) +(defvar nnmail-scan-directory-mail-source-once) +(defvar nnmail-split-history) +(defvar nnmail-spool-file) (defun gnus-close-all-servers () "Close all servers." @@ -660,6 +682,9 @@ the first newsgroup." (setq gnus-list-of-killed-groups nil gnus-have-read-active-file nil gnus-agent-covered-methods nil + gnus-agent-file-loading-local nil + gnus-agent-file-loading-cache nil + gnus-server-method-cache nil gnus-newsrc-alist nil gnus-newsrc-hashtb nil gnus-killed-list nil @@ -701,11 +726,12 @@ the first newsgroup." (defun gnus-no-server-1 (&optional arg slave) "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." +If ARG is a positive number, Gnus will use that as the startup +level. If ARG is nil, Gnus will be started at level 2 +\(`gnus-level-default-subscribed' minus one). If ARG is non-nil +and not a positive number, Gnus will prompt the user for the name +of an NNTP server to use. As opposed to \\[gnus], this command +will not connect to the local server." (interactive "P") (let ((val (or arg (1- gnus-level-default-subscribed)))) (gnus val t slave) @@ -715,7 +741,7 @@ As opposed to `gnus', this command will not connect to the local server." (defun gnus-1 (&optional arg dont-connect slave) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will +startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") @@ -733,6 +759,13 @@ prompt the user for the name of an NNTP server to use." (nnheader-init-server-buffer) (setq gnus-slave slave) (gnus-read-init-file) + + ;; Add "native" to gnus-predefined-server-alist just to have a + ;; name for the native select method. + (when gnus-select-method + (push (cons "native" gnus-select-method) + gnus-predefined-server-alist)) + (if gnus-agent (gnus-agentize)) @@ -741,8 +774,7 @@ prompt the user for the name of an NNTP server to use." (cond ((featurep 'xemacs) (gnus-xmas-splash)) - ((and window-system - (= (frame-height) (1+ (window-height)))) + (window-system (gnus-x-splash)))) (let ((level (and (numberp arg) (> arg 0) arg)) @@ -766,11 +798,6 @@ prompt the user for the name of an NNTP server to use." (when (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file)) - ;; Allow using GroupLens predictions. - (when gnus-use-grouplens - (bbb-login) - (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) - ;; Do the actual startup. (if gnus-agent (gnus-request-create-group "queue" '(nndraft ""))) @@ -787,10 +814,14 @@ prompt the user for the name of an NNTP server to use." (defun gnus-start-draft-setup () "Make sure the draft group exists." + (interactive) (gnus-request-create-group "drafts" '(nndraft "")) - (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) + (unless (gnus-group-entry "nndraft:drafts") (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))) + (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))) + (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t) + '((gnus-draft-mode))) + (gnus-message 3 "Setting up drafts group") (gnus-group-set-parameter "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) @@ -838,10 +869,13 @@ prompt the user for the name of an NNTP server to use." (defun gnus-dribble-read-file () "Read the dribble file from disk." (let ((dribble-file (gnus-dribble-file-name))) + (unless (file-exists-p (file-name-directory dribble-file)) + (make-directory (file-name-directory dribble-file) t)) (save-excursion (set-buffer (setq gnus-dribble-buffer (gnus-get-buffer-create (file-name-nondirectory dribble-file)))) + (set (make-local-variable 'file-precious-flag) t) (erase-buffer) (setq buffer-file-name dribble-file) (auto-save-mode t) @@ -865,7 +899,7 @@ prompt the user for the name of an NNTP server to use." (when (and (file-exists-p gnus-current-startup-file) (file-exists-p dribble-file) (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) + (gnus-set-file-modes dribble-file modes)) (goto-char (point-min)) (when (search-forward "Gnus was exited on purpose" nil t) (setq purpose t)) @@ -935,18 +969,34 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (gnus-read-newsrc-file rawfile)) ;; Make sure the archive server is available to all and sundry. - (when gnus-message-archive-method - (unless (assoc "archive" gnus-server-alist) - (push `("archive" - nnfolder - "archive" - (nnfolder-directory - ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - gnus-server-alist))) + (let ((method (or (and (stringp gnus-message-archive-method) + (gnus-server-to-method + gnus-message-archive-method)) + gnus-message-archive-method))) + ;; Check whether the archive method is writable. + (unless (or (not method) + (stringp method) + (memq 'respool (assoc (format "%s" (car method)) + gnus-valid-select-methods))) + (setq method "archive")) ;; The default. + (when (stringp method) + (setq method `(nnfolder + ,method + (nnfolder-directory + ,(nnheader-concat message-directory method)) + (nnfolder-active-file + ,(nnheader-concat message-directory + (concat method "/active"))) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t)))) + (if (assoc "archive" gnus-server-alist) + (when gnus-update-message-archive-method + (if method + (setcdr (assoc "archive" gnus-server-alist) method) + (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist) + gnus-server-alist)))) + (when method + (push (cons "archive" method) gnus-server-alist)))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. @@ -1013,9 +1063,12 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (gnus-check-bogus-newsgroups)) ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (not level) - (not dont-connect)) + (when (and (not dont-connect) + gnus-use-nocem + (or (and (numberp gnus-use-nocem) + (numberp level) + (>= level gnus-use-nocem)) + (not level))) (gnus-nocem-scan-groups)) ;; Read any slave files. @@ -1293,16 +1346,16 @@ for new groups, and subscribe the new groups as zombies." (when (and (stringp entry) oldlevel (< oldlevel gnus-level-zombie)) - (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) + (setq entry (gnus-group-entry entry))) (if (and (not oldlevel) (consp entry)) (setq oldlevel (gnus-info-level (nth 2 entry))) (setq oldlevel (or oldlevel gnus-level-killed))) (when (stringp previous) - (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) + (setq previous (gnus-group-entry previous))) (if (and (>= oldlevel gnus-level-zombie) - (gnus-gethash group gnus-newsrc-hashtb)) + (gnus-group-entry group)) ;; We are trying to subscribe a group that is already ;; subscribed. () ; Do nothing. @@ -1326,8 +1379,7 @@ for new groups, and subscribe the new groups as zombies." entry) (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) (when (nth 3 entry) - (setcdr (gnus-gethash (car (nth 3 entry)) - gnus-newsrc-hashtb) + (setcdr (gnus-group-entry (car (nth 3 entry))) (cdr entry))) (setcdr (cdr entry) (cdddr entry))))) @@ -1387,7 +1439,7 @@ for new groups, and subscribe the new groups as zombies." (gnus-sethash group (cons num previous) gnus-newsrc-hashtb)) (when (cdr entry) - (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)) + (setcdr (gnus-group-entry (caadr entry)) entry)) (gnus-dribble-enter (format "(gnus-group-set-info '%S)" info))))) @@ -1398,7 +1450,7 @@ for new groups, and subscribe the new groups as zombies." (defun gnus-kill-newsgroup (newsgroup) "Obsolete function. Kills a newsgroup." (gnus-group-change-level - (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) + (gnus-group-entry newsgroup) gnus-level-killed)) (defun gnus-check-bogus-newsgroups (&optional confirm) "Remove bogus newsgroups. @@ -1426,14 +1478,14 @@ newsgroup." (lambda (group) ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (when (setq entry (gnus-group-entry group)) (gnus-group-change-level entry gnus-level-killed) (setq gnus-killed-list (delete group gnus-killed-list)))) bogus '("group" "groups" "remove")) (while (setq group (pop bogus)) ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (when (setq entry (gnus-group-entry group)) (gnus-group-change-level entry gnus-level-killed) (setq gnus-killed-list (delete group gnus-killed-list))))) ;; Then we remove all bogus groups from the list of killed and @@ -1462,8 +1514,8 @@ newsgroup." (setq killed (cdr killed))))) ;; We want to inline a function from gnus-cache, so we cheat here: +(defvar gnus-cache-active-hashtb) (eval-when-compile - (defvar gnus-cache-active-hashtb) (defun gnus-cache-possibly-alter-active (group active) "Alter the ACTIVE info for GROUP to reflect the articles in the cache." (when gnus-cache-active-hashtb @@ -1475,8 +1527,8 @@ newsgroup." (setcdr active (cdr cache-active)))))))) (defun gnus-activate-group (group &optional scan dont-check method) - ;; Check whether a group has been activated or not. - ;; If SCAN, request a scan of that group as well. + "Check whether a group has been activated or not. +If SCAN, request a scan of that group as well." (let ((method (or method (inline (gnus-find-method-for-group group)))) active) (and (inline (gnus-check-server method)) @@ -1502,16 +1554,26 @@ newsgroup." ;; command may have responded with the `(0 . 0)'. We ;; ignore this if we already have an active entry ;; for the group. - (if (and (zerop (car active)) - (zerop (cdr active)) + (if (and (zerop (or (car active) 0)) + (zerop (or (cdr active) 0)) (gnus-active group)) (gnus-active group) + + ;; If a cache is present, we may have to alter the active info. + (when gnus-use-cache + (inline (gnus-cache-possibly-alter-active + group active))) + + ;; If the agent is enabled, we may have to alter the active info. + (when gnus-agent + (gnus-agent-possibly-alter-active group active)) + (gnus-set-active group active) ;; Return the new active info. active))))) (defun gnus-get-unread-articles-in-group (info active &optional update) - (when active + (when (and info active) ;; Allow the backend to update the info in the group. (when (and update (gnus-request-update-info @@ -1521,10 +1583,19 @@ newsgroup." (let* ((range (gnus-info-read info)) (num 0)) + + ;; These checks are present in gnus-activate-group but skipped + ;; due to setting dont-check in the preceeding call. + ;; If a cache is present, we may have to alter the active info. (when (and gnus-use-cache info) (inline (gnus-cache-possibly-alter-active (gnus-info-group info) active))) + + ;; If the agent is enabled, we may have to alter the active info. + (when (and gnus-agent info) + (gnus-agent-possibly-alter-active (gnus-info-group info) active info)) + ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the ;; number to the group hash table entry. @@ -1592,8 +1663,8 @@ newsgroup." (setq num (max 0 (- (cdr active) num))))) ;; Set the number of unread articles. (when (and info - (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb)) - (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) + (gnus-group-entry (gnus-info-group info))) + (setcar (gnus-group-entry (gnus-info-group info)) num)) num))) ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' @@ -1601,7 +1672,7 @@ newsgroup." (defun gnus-get-unread-articles (&optional level) (setq gnus-server-method-cache nil) (let* ((newsrc (cdr gnus-newsrc-alist)) - (level (or level gnus-activate-level (1+ gnus-level-subscribed))) + (alevel (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level (min (cond ((and gnus-activate-foreign-newsgroups @@ -1610,8 +1681,12 @@ newsgroup." ((numberp gnus-activate-foreign-newsgroups) gnus-activate-foreign-newsgroups) (t 0)) - level)) - scanned-methods info group active method retrieve-groups) + alevel)) + (methods-cache nil) + (type-cache nil) + (gnus-agent-article-local-times 0) + infos info group active method cmethod + method-type method-group-list) (gnus-message 6 "Checking new news...") (while newsrc @@ -1630,104 +1705,102 @@ newsgroup." ;; nil for non-foreign groups that the user has requested not be checked ;; t for unchecked foreign groups or bogus groups, or groups that can't ;; be checked, for one reason or other. - (if (and (setq method (gnus-info-method info)) - (not (inline - (gnus-server-equal - gnus-select-method - (setq method (gnus-server-get-method nil method))))) - (not (gnus-secondary-method-p method))) - ;; These groups are foreign. Check the level. - (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) - ;; Let the Gnus agent save the active file. - (when (and gnus-agent active (gnus-online method)) - (gnus-agent-save-group-info - method (gnus-group-real-name group) active)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method)))) - ;; These groups are native or secondary. - (cond - ;; We don't want these groups. - ((> (gnus-info-level info) level) - (setq active 'ignore)) - ;; Activate groups. - ((not gnus-read-active-file) - (if (gnus-check-backend-function 'retrieve-groups group) - ;; if server support gnus-retrieve-groups we push - ;; the group onto retrievegroups for later checking - (if (assoc method retrieve-groups) - (setcdr (assoc method retrieve-groups) - (cons group (cdr (assoc method retrieve-groups)))) - (push (list method group) retrieve-groups)) - ;; hack: `nnmail-get-new-mail' changes the mail-source depending - ;; on the group, so we must perform a scan for every group - ;; if the users has any directory mail sources. - ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, - ;; for it scan all spool files even when the groups are - ;; not required. - (if (and - (or nnmail-scan-directory-mail-source-once - (null (assq 'directory - (or mail-sources - (if (listp nnmail-spool-file) - nnmail-spool-file - (list nnmail-spool-file)))))) - (member method scanned-methods)) - (setq active (gnus-activate-group group)) - (setq active (gnus-activate-group group 'scan)) - (push method scanned-methods)) - (when active - (gnus-close-group group)))))) - - ;; Get the number of unread articles in the group. - (cond - ((eq active 'ignore) - ;; Don't do anything. - ) - (active - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (let ((tmp (gnus-gethash group gnus-newsrc-hashtb))) - (when tmp - (setcar tmp t)))))) - - ;; iterate through groups on methods which support gnus-retrieve-groups - ;; and fetch a partial active file and use it to find new news. - (dolist (rg retrieve-groups) - (let ((method (or (car rg) gnus-select-method)) - (groups (cdr rg))) - (when (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (gnus-read-active-file-2 - (mapcar (lambda (group) (gnus-group-real-name group)) groups) - method) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) + ;; First go through all the groups, see what select methods they + ;; belong to, and then collect them into lists per unique select + ;; method. + (if (not (setq method (gnus-info-method info))) + (setq method gnus-select-method) + (if (setq cmethod (assoc method methods-cache)) + (setq method (cdr cmethod)) + (setq cmethod (inline (gnus-server-get-method nil method))) + (push (cons method cmethod) methods-cache) + (setq method cmethod))) + (setq method-group-list (assoc method type-cache)) + (unless method-group-list + (setq method-type + (cond + ((gnus-secondary-method-p method) + 'secondary) + ((inline (gnus-server-equal gnus-select-method method)) + 'primary) + (t + 'foreign))) + (push (setq method-group-list (list method method-type nil)) + type-cache)) + (setcar (nthcdr 2 method-group-list) + (cons info (nth 2 method-group-list)))) + + ;; Sort the methods based so that the primary and secondary + ;; methods come first. This is done for legacy reasons to try to + ;; ensure that side-effect behaviour doesn't change from previous + ;; Gnus versions. + (setq type-cache + (sort (nreverse type-cache) + (lambda (c1 c2) + (< (gnus-method-rank (cadr c1) (car c1)) + (gnus-method-rank (cadr c2) (car c2)))))) + + (while type-cache + (setq method (nth 0 (car type-cache)) + method-type (nth 1 (car type-cache)) + infos (nth 2 (car type-cache))) + (pop type-cache) + + (when method + ;; See if any of the groups from this method require updating. + (when (block nil + (dolist (info infos) + (when (<= (gnus-info-level info) + (if (eq method-type 'foreign) + foreign-level + alevel)) + (return t)))) + (gnus-read-active-for-groups method infos) + (dolist (info infos) + (inline (gnus-get-unread-articles-in-group + info (gnus-active (gnus-info-group info)))))))) (gnus-message 6 "Checking new news...done"))) +(defun gnus-method-rank (type method) + (cond + ((eq type 'primary) + 1) + ;; Compute the rank of the secondary methods based on where they + ;; are in the secondary select list. + ((eq type 'secondary) + (let ((i 2)) + (block nil + (dolist (smethod gnus-secondary-select-methods) + (when (equalp method smethod) + (return i)) + (incf i)) + i))) + ;; Just say that all foreign groups have the same rank. + (t + 100))) + +(defun gnus-read-active-for-groups (method infos) + (with-current-buffer nntp-server-buffer + (cond + ((gnus-check-backend-function 'retrieve-groups (car method)) + (gnus-read-active-file-2 + (mapcar (lambda (info) + (gnus-group-real-name (gnus-info-group info))) + infos) + method)) + ((gnus-check-backend-function 'request-list (car method)) + (gnus-read-active-file-1 method nil)) + (t + (dolist (info infos) + (gnus-activate-group (gnus-info-group info) nil nil method)))))) + ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. (defun gnus-make-hashtable-from-newsrc-alist () (let ((alist gnus-newsrc-alist) (ohashtb gnus-newsrc-hashtb) - prev) + prev info method rest methods) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) (setq alist (setq prev (setq gnus-newsrc-alist @@ -1736,14 +1809,30 @@ newsgroup." gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist))))) (while alist - (gnus-sethash - (caar alist) - ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) - prev) - gnus-newsrc-hashtb) - (setq prev alist - alist (cdr alist))))) + (setq info (car alist)) + ;; Make the same select-methods identical Lisp objects. + (when (setq method (gnus-info-method info)) + (if (setq rest (member method methods)) + (gnus-info-set-method info (car rest)) + (push method methods))) + ;; Check for duplicates. + (if (gnus-gethash (car info) gnus-newsrc-hashtb) + ;; Remove this entry from the alist. + (setcdr prev (cddr prev)) + (gnus-sethash + (car info) + ;; Preserve number of unread articles in groups. + (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) + prev) + gnus-newsrc-hashtb) + (setq prev alist)) + (setq alist (cdr alist))) + ;; Make the same select-methods in `gnus-server-alist' identical + ;; as well. + (while methods + (setq method (pop methods)) + (when (setq rest (rassoc method gnus-server-alist)) + (setcdr rest method))))) (defun gnus-make-hashtable-from-killed () "Create a hash table from the killed and zombie lists." @@ -1770,9 +1859,9 @@ newsgroup." (defun gnus-make-articles-unread (group articles) "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb)))) + (let* ((info (nth 2 (or (gnus-group-entry group) + (gnus-group-entry + (gnus-group-real-name group))))) (ranges (gnus-info-read info)) news article) (while articles @@ -1792,9 +1881,8 @@ newsgroup." (defun gnus-make-ascending-articles-unread (group articles) "Mark ascending ARTICLES in GROUP as unread." - (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb))) + (let* ((entry (or (gnus-group-entry group) + (gnus-group-entry (gnus-group-real-name group)))) (info (nth 2 entry)) (ranges (gnus-info-read info)) (r ranges) @@ -1845,7 +1933,7 @@ newsgroup." (setcdr range (1- article)) (setq modified t) ranges)))))))) - + (when modified (when (eq modified 'remove-null) (setq r (delq nil r))) @@ -1866,7 +1954,7 @@ newsgroup." (while lists (setq killed (car lists)) (while killed - (gnus-sethash (car killed) nil hashtb) + (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) @@ -1941,7 +2029,9 @@ newsgroup." (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) + (when (and gnus-agent + (gnus-online method) + (gnus-check-backend-function 'request-scan (car method))) (gnus-request-scan nil method)) (cond ((and (eq gnus-read-active-file 'some) @@ -1953,10 +2043,10 @@ newsgroup." (while (setq info (pop newsrc)) (when (inline (gnus-server-equal - (inline - (gnus-find-method-for-group - (gnus-info-group info) info)) - gmethod)) + (inline + (gnus-find-method-for-group + (gnus-info-group info) info)) + gmethod)) (push (gnus-group-real-name (gnus-info-group info)) groups))) (gnus-read-active-file-2 groups method))) @@ -2003,7 +2093,8 @@ newsgroup." (if (equal method gnus-select-method) (gnus-make-hashtable (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096))))))) + (gnus-make-hashtable 4096)))))) + group max min) ;; Delete unnecessary lines. (goto-char (point-min)) (cond @@ -2038,12 +2129,16 @@ newsgroup." (insert prefix) (zerop (forward-line 1))))))) ;; Store the active file in a hash table. - (goto-char (point-min)) - (let (group max min) + ;; Use a unibyte buffer in order to make `read' read non-ASCII + ;; group names (which have been encoded) as unibyte strings. + (mm-with-unibyte-buffer + (insert-buffer-substring cur) + (setq cur (current-buffer)) + (goto-char (point-min)) (while (not (eobp)) (condition-case () (progn - (narrow-to-region (point) (gnus-point-at-eol)) + (narrow-to-region (point) (point-at-eol)) ;; group gets set to a symbol interned in the hash table ;; (what a hack!!) - jwz (setq group (let ((obarray hashtb)) (read cur))) @@ -2075,7 +2170,7 @@ newsgroup." (unless ignore-errors (gnus-message 3 "Warning - invalid active: %s" (buffer-substring - (gnus-point-at-bol) (gnus-point-at-eol)))))) + (point-at-bol) (point-at-eol)))))) (widen) (forward-line 1))))) @@ -2100,7 +2195,7 @@ newsgroup." (gnus-online method) (gnus-agent-method-p method)) (progn - (gnus-agent-save-groups method) + (gnus-agent-save-active method) (gnus-active-to-gnus-format method hashtb nil real-active)) (goto-char (point-min)) @@ -2176,17 +2271,94 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-convert-old-newsrc)))) (defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." + "Convert old newsrc formats into the current format, if needed." (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) - -(defun gnus-convert-old-ticks () + (gnus-continuum-version gnus-newsrc-file-version))) + (gcv (gnus-continuum-version))) + (when fcv + ;; A newsrc file was loaded. + (let (prompt-displayed + (converters + (sort + (mapcar (lambda (date-func) + (cons (gnus-continuum-version (car date-func)) + date-func)) + ;; This is a list of converters that must be run + ;; to bring the newsrc file up to the current + ;; version. If you create an incompatibility + ;; with older versions, you should create an + ;; entry here. The entry should consist of the + ;; current gnus version (hardcoded so that it + ;; doesn't change with each release) and the + ;; function that must be applied to convert the + ;; previous version into the current version. + '(("September Gnus v0.1" nil + gnus-convert-old-ticks) + ("Oort Gnus v0.08" "legacy-gnus-agent" + gnus-agent-convert-to-compressed-agentview) + ("Gnus v5.10.7" "legacy-gnus-agent" + gnus-agent-unlist-expire-days) + ("Gnus v5.10.7" "legacy-gnus-agent" + gnus-agent-unhook-expire-days))) + #'car-less-than-car))) + ;; Skip converters older than the file version + (while (and converters (>= fcv (caar converters))) + (pop converters)) + + ;; Perform converters to bring older version up to date. + (when (and converters (< fcv (caar converters))) + (while (and converters (< fcv (caar converters)) + (<= (caar converters) gcv)) + (let* ((converter-spec (pop converters)) + (convert-to (nth 1 converter-spec)) + (load-from (nth 2 converter-spec)) + (func (nth 3 converter-spec))) + (when (and load-from + (not (fboundp func))) + (load load-from t)) + (or prompt-displayed + (not (gnus-convert-converter-needs-prompt func)) + (while (let (c + (cursor-in-echo-area t) + (echo-keystrokes 0)) + (message "Convert gnus from version '%s' to '%s'? (n/y/?)" + gnus-newsrc-file-version gnus-version) + (setq c (read-char-exclusive)) + + (cond ((or (eq c ?n) (eq c ?N)) + (error "Can not start gnus without converting")) + ((or (eq c ?y) (eq c ?Y)) + (setq prompt-displayed t) + nil) + ((eq c ?\?) + (message "This conversion is irreversible. \ + To be safe, you should backup your files before proceeding.") + (sit-for 5) + t) + (t + (gnus-message 3 "Ignoring unexpected input") + (sit-for 3) + t))))) + + (funcall func convert-to))) + (gnus-dribble-enter + (format ";Converted gnus from version '%s' to '%s'." + gnus-newsrc-file-version gnus-version))))))) + +(defun gnus-convert-mark-converter-prompt (converter no-prompt) + "Indicate whether CONVERTER requires gnus-convert-old-newsrc to + display the conversion prompt. NO-PROMPT may be nil (prompt), + t (no prompt), or any form that can be called as a function. + The form should return either t or nil." + (put converter 'gnus-convert-no-prompt no-prompt)) + +(defun gnus-convert-converter-needs-prompt (converter) + (let ((no-prompt (get converter 'gnus-convert-no-prompt))) + (not (if (memq no-prompt '(t nil)) + no-prompt + (funcall no-prompt))))) + +(defun gnus-convert-old-ticks (converting-to) (let ((newsrc (cdr gnus-newsrc-alist)) marks info dormant ticked) (while (setq info (pop newsrc)) @@ -2211,11 +2383,11 @@ If FORCE is non-nil, the .newsrc file is read." (eval form)) (error (unless (eq (car type) 'end-of-file) - (let ((error (format "Error in %s line %d" file - (count-lines (point-min) (point))))) + (let ((errmsg (format "Error in %s line %d" file + (count-lines (point-min) (point))))) (ding) - (unless (gnus-yes-or-no-p (concat error "; continue? ")) - (error "%s" error))))))))) + (unless (gnus-yes-or-no-p (concat errmsg "; continue? ")) + (error "%s" errmsg))))))))) (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) @@ -2223,8 +2395,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; We always, always read the .eld file. (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) - (let ((coding-system-for-read gnus-ding-file-coding-system)) - (gnus-load ding-file)) + (gnus-load ding-file) ;; Older versions of `gnus-format-specs' are no longer valid ;; in Oort Gnus 0.01. (let ((version @@ -2235,6 +2406,8 @@ If FORCE is non-nil, the .newsrc file is read." (setq gnus-format-specs gnus-default-format-specs))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) + (dolist (elem gnus-newsrc-alist) + (setcar elem (mm-string-as-unibyte (car elem)))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file @@ -2350,10 +2523,10 @@ If FORCE is non-nil, the .newsrc file is read." ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options (buffer-substring - (gnus-point-at-bol) + (point-at-bol) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) - (progn (beginning-of-line) (point))) + (point-at-bol)) (point))))) (forward-line -1)) (symbol @@ -2379,7 +2552,7 @@ If FORCE is non-nil, the .newsrc file is read." (cond ((looking-at "[0-9]+") ;; We narrow and read a number instead of buffer-substring/ - ;; string-to-int because it's faster. narrow/widen is + ;; string-to-number because it's faster. narrow/widen is ;; faster than save-restriction/narrow, and save-restriction ;; produces a garbage object. (setq num1 (progn @@ -2421,8 +2594,8 @@ If FORCE is non-nil, the .newsrc file is read." ;; The line was buggy. (setq group nil) (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (gnus-point-at-bol) - (gnus-point-at-eol)))) + (buffer-substring (point-at-bol) + (point-at-eol)))) nil)) ;; Skip past ", ". Spaces are invalid in these ranges, but ;; we allow them, because it's a common mistake to put a @@ -2531,9 +2704,9 @@ If FORCE is non-nil, the .newsrc file is read." (while (re-search-forward "[ \t]-n" nil t) (setq eol (or (save-excursion - (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) + (and (re-search-forward "[ \t]-n" (point-at-eol) t) (- (point) 2))) - (gnus-point-at-eol))) + (point-at-eol))) ;; Search for all "words"... (while (re-search-forward "[^ \t,\n]+" eol t) (if (eq (char-after (match-beginning 0)) ?!) @@ -2566,6 +2739,10 @@ If FORCE is non-nil, the .newsrc file is read." ;; from the variable gnus-newsrc-alist. (when (and (or gnus-newsrc-alist gnus-killed-list) gnus-current-startup-file) + ;; Save agent range limits for the currently active method. + (when gnus-agent + (gnus-agent-save-local force)) + (save-excursion (if (and (or gnus-use-dribble-file gnus-slave) (not force) @@ -2583,6 +2760,7 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 8 "Saving %s..." gnus-current-startup-file) (gnus-gnus-to-newsrc-format) (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) + ;; Save .newsrc.eld. (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) (make-local-variable 'version-control) @@ -2612,9 +2790,7 @@ If FORCE is non-nil, the .newsrc file is read." (if (and (eq system-type 'ms-dos) (not (gnus-long-file-names))) "%s#%d.tm#" ; MSDOS limits files to 8+3 - (if (memq system-type '(vax-vms axp-vms)) - "%s$tmp$%d" - "%s#tmp#%d")) + "%s#tmp#%d") working-dir (setq i (1+ i)))) (file-exists-p working-file))) @@ -2636,7 +2812,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes))) (condition-case nil (delete-file working-file) (file-error nil))))) @@ -2649,7 +2825,8 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables) "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format." - (princ ";; -*- emacs-lisp -*-\n") + (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" + gnus-ding-file-coding-system)) (if name (princ (format ";; %s\n" name)) (princ ";; Gnus startup file.\n")) @@ -2668,6 +2845,7 @@ If FORCE is non-nil, the .newsrc file is read." (print-escape-nonascii t) (print-length nil) (print-level nil) + (print-circle nil) (print-escape-newlines t) (gnus-killed-list (if (and gnus-save-killed-list @@ -2687,7 +2865,7 @@ If FORCE is non-nil, the .newsrc file is read." (while variables (when (and (boundp (setq variable (pop variables))) (symbol-value variable)) - (princ "(setq ") + (princ "\n(setq ") (princ (symbol-name variable)) (princ " '") (prin1 (symbol-value variable)) @@ -2714,6 +2892,10 @@ If FORCE is non-nil, the .newsrc file is read." (setq default-directory (file-name-directory buffer-file-name)) (buffer-disable-undo) (erase-buffer) + ;; Use a unibyte buffer since group names are unibyte strings; + ;; in particular, non-ASCII group names are the ones encoded by + ;; a certain coding system. + (mm-disable-multibyte) ;; Write options. (when gnus-newsrc-options (insert gnus-newsrc-options)) @@ -2756,7 +2938,8 @@ If FORCE is non-nil, the .newsrc file is read." (delete-file gnus-startup-file) (clear-visited-file-modtime)) (gnus-run-hooks 'gnus-save-standard-newsrc-hook) - (save-buffer) + (let ((coding-system-for-write 'raw-text)) + (save-buffer)) (kill-buffer (current-buffer))))) @@ -2768,7 +2951,9 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-slave-mode () "Minor mode for slave Gnusae." - (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) + ;; FIXME: gnus-slave-mode appears to never be set (i.e. it'll always be nil): + ;; Remove, or fix and use define-minor-mode. + (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) (gnus-run-hooks 'gnus-slave-mode-hook)) (defun gnus-slave-save-newsrc () @@ -2781,7 +2966,7 @@ If FORCE is non-nil, the .newsrc file is read." (let ((coding-system-for-write gnus-ding-file-coding-system)) (gnus-write-buffer slave-name)) (when modes - (set-file-modes slave-name modes))))) + (gnus-set-file-modes slave-name modes))))) (defun gnus-master-read-slave-newsrc () (let ((slave-files @@ -2866,6 +3051,7 @@ If FORCE is non-nil, the .newsrc file is read." nil) (t (save-excursion + ;; FIXME: Shouldn't save-restriction be done after set-buffer? (save-restriction (set-buffer nntp-server-buffer) (goto-char (point-min)) @@ -2940,12 +3126,10 @@ If this variable is nil, don't do anything." (file-name-as-directory (expand-file-name gnus-default-directory)) default-directory))) -(eval-and-compile -(defalias 'gnus-display-time-event-handler - (if (gnus-boundp 'display-time-timer) - 'display-time-event-handler - (lambda () "Does nothing as `display-time-timer' is not bound. -Would otherwise be an alias for `display-time-event-handler'." nil)))) +(defun gnus-display-time-event-handler () + (if (and (fboundp 'display-time-event-handler) + (gnus-boundp 'display-time-timer)) + (display-time-event-handler))) ;;;###autoload (defun gnus-fixup-nnimap-unread-after-getting-new-news () @@ -2961,9 +3145,42 @@ Would otherwise be an alias for `display-time-event-handler'." nil)))) (symbol-value 'nnimap-mailbox-info) (make-vector 1 0))))) +(defun gnus-check-reasonable-setup () + ;; Check whether nnml and nnfolder share a directory. + (let ((display-warn + (if (fboundp 'display-warning) + 'display-warning + (lambda (type message) + (if noninteractive + (message "Warning (%s): %s" type message) + (let (window) + (with-current-buffer (get-buffer-create "*Warnings*") + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (format "Warning (%s): %s\n" type message)) + (setq window (display-buffer (current-buffer))) + (set-window-start + window + (prog2 + (forward-line (- 1 (window-height window))) + (point) + (goto-char (point-max)))))))))) + method active actives match) + (dolist (server gnus-server-alist) + (setq method (gnus-server-to-method server) + active (intern (format "%s-active-file" (car method)))) + (when (and (member (car method) '(nnml nnfolder)) + (gnus-server-opened method) + (boundp active)) + (when (setq match (assoc (symbol-value active) actives)) + (funcall display-warn 'gnus-server + (format "%s and %s share the same active file %s" + (car method) + (cadr match) + (car match)))) + (push (list (symbol-value active) method) actives))))) (provide 'gnus-start) ;;; gnus-start.el ends here - -