Split -request-update-info into -request-marks and -update-info.
[gnus] / lisp / gnus-start.el
index e9c066f..fdf6b92 100644 (file)
@@ -1,26 +1,25 @@
 ;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;;        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 <larsi@gnus.org>
 ;; 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 <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 (autoload 'gnus-agent-save-local "gnus-agent")
 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
 
-(eval-when-compile 
-  (require 'cl)
+(eval-when-compile
+  (require 'cl))
 
-  (defvar gnus-agent-covered-methods nil)
-  (defvar gnus-agent-file-loading-local nil)
-  (defvar gnus-agent-file-loading-cache nil))
+(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.
   :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 "21.4"
+  :version "22.1"
   :group 'gnus-start
   :type '(choice (const :tag "Never" never)
                 (const :tag "If existing" nil)
@@ -65,7 +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 "21.4"
+  :version "22.1"
   :group 'gnus-start
   :type '(choice (const :tag "Write via buffer" t)
                  (const :tag "Write directly to file" nil)))
@@ -177,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.")
@@ -264,7 +268,7 @@ not match this regexp will be removed before saving the list."
   (mapconcat 'identity
             '("^to\\."                 ; not "real" groups
               "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
-              "^[\"][]\"[#'()]"        ; bogus characters
+              "^[\"][\"#'()]"  ; bogus characters
               )
             "\\|")
   "*A regexp to match uninteresting newsgroups in the active file.
@@ -299,7 +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 "21.4"
+  :version "22.1"
   :group 'gnus-group-new
   :type 'hook)
 
@@ -312,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)
@@ -351,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
@@ -363,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
@@ -388,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)
@@ -406,7 +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 "21.4"
+  :version "22.1"
   :group 'gnus-group-new
   :type 'hook)
 
@@ -457,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.")
 
@@ -588,8 +594,7 @@ Can be used to turn version control on or off."
 (defun gnus-subscribe-hierarchically (newgroup)
   "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
-  (save-excursion
-    (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
+  (with-current-buffer (nnheader-find-file-noselect gnus-current-startup-file)
     (prog1
        (let ((groupkey newgroup) before)
          (while (and (not before) groupkey)
@@ -611,7 +616,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)))
 
@@ -625,7 +630,7 @@ 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))
@@ -644,21 +649,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."
@@ -701,6 +705,7 @@ the first newsgroup."
        nnoo-state-alist nil
        gnus-current-select-method nil
        nnmail-split-history nil
+       gnus-extended-servers nil
        gnus-ephemeral-servers nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
@@ -721,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)
@@ -735,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")
 
@@ -753,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))
 
@@ -761,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))
@@ -802,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-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)))))
 
@@ -841,8 +857,7 @@ prompt the user for the name of an NNTP server to use."
       ;; it's not needed).
       ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
       (bury-buffer gnus-dribble-buffer)
-      (save-excursion
-       (set-buffer gnus-group-buffer)
+      (with-current-buffer gnus-group-buffer
        (gnus-group-set-mode-line))
       (set-buffer obuf))))
 
@@ -853,10 +868,12 @@ 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)))
-    (save-excursion
-      (set-buffer (setq gnus-dribble-buffer
-                       (gnus-get-buffer-create
-                        (file-name-nondirectory dribble-file))))
+    (unless (file-exists-p (file-name-directory dribble-file))
+      (make-directory (file-name-directory dribble-file) t))
+    (with-current-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)
@@ -904,8 +921,7 @@ prompt the user for the name of an NNTP server to use."
   (when (file-exists-p (gnus-dribble-file-name))
     (delete-file (gnus-dribble-file-name)))
   (when gnus-dribble-buffer
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (let ((auto (make-auto-save-file-name)))
        (when (file-exists-p auto)
          (delete-file auto))
@@ -915,14 +931,12 @@ prompt the user for the name of an NNTP server to use."
 (defun gnus-dribble-save ()
   (when (and gnus-dribble-buffer
             (buffer-name gnus-dribble-buffer))
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (save-buffer))))
 
 (defun gnus-dribble-clear ()
   (when (gnus-buffer-exists-p gnus-dribble-buffer)
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
+    (with-current-buffer gnus-dribble-buffer
       (erase-buffer)
       (set-buffer-modified-p nil)
       (setq buffer-saved-size (buffer-size)))))
@@ -950,30 +964,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)
-       (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 (stringp method)
-                     (memq 'respool (assoc (format "%s" (car method))
-                                           gnus-valid-select-methods)))
-           (setq method "archive")) ;; The default.
-         (push (if (stringp method)
-                   `("archive"
-                     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))
-                 (cons "archive" method))
-               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.
@@ -1040,9 +1058,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.
@@ -1276,8 +1297,7 @@ for new groups, and subscribe the new groups as zombies."
          (when (gnus-active group)
            (gnus-group-change-level
             group gnus-level-default-subscribed gnus-level-killed)))
-       (save-excursion
-         (set-buffer gnus-group-buffer)
+       (with-current-buffer gnus-group-buffer
          ;; Don't error if the group already exists. This happens when a
          ;; first-time user types 'F'. -- didier
          (gnus-group-make-help-group t))
@@ -1488,8 +1508,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
@@ -1500,7 +1520,8 @@ newsgroup."
          (when (> (cdr cache-active) (cdr active))
            (setcdr active (cdr cache-active))))))))
 
-(defun gnus-activate-group (group &optional scan dont-check method)
+(defun gnus-activate-group (group &optional scan dont-check method
+                                 dont-sub-check)
   "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))))
@@ -1515,9 +1536,13 @@ If SCAN, request a scan of that group as well."
                (gnus-request-scan group method))
           t)
         (if (or debug-on-error debug-on-quit)
-            (inline (gnus-request-group group dont-check method))
+            (inline (gnus-request-group group (or dont-sub-check dont-check)
+                                        method
+                                        (gnus-get-info group)))
           (condition-case nil
-              (inline (gnus-request-group group dont-check method))
+              (inline (gnus-request-group group (or dont-sub-check dont-check)
+                                          method
+                                          (gnus-get-info group)))
             ;;(error nil)
             (quit
              (message "Quit activating %s" group)
@@ -1528,8 +1553,8 @@ If SCAN, request a scan of that group as well."
           ;; 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)
 
@@ -1646,148 +1671,154 @@ If SCAN, request a scan of that group as well."
 (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
-                      (not (numberp gnus-activate-foreign-newsgroups)))
-                 (1+ gnus-level-subscribed))
-                ((numberp gnus-activate-foreign-newsgroups)
-                 gnus-activate-foreign-newsgroups)
-                (t 0))
-          level))
+         (or
+          level
+          (min
+           (cond ((and gnus-activate-foreign-newsgroups
+                       (not (numberp gnus-activate-foreign-newsgroups)))
+                  (1+ gnus-level-subscribed))
+                 ((numberp gnus-activate-foreign-newsgroups)
+                  gnus-activate-foreign-newsgroups)
+                 (t 0))
+           alevel)))
         (methods-cache nil)
         (type-cache nil)
-        scanned-methods info group active method retrieve-groups cmethod
-        method-type ignore)
+        (gnus-agent-article-local-times 0)
+        (archive-method (gnus-server-to-method "archive"))
+        infos info group active method cmethod
+        method-type method-group-list entry)
     (gnus-message 6 "Checking new news...")
 
     (while newsrc
       (setq active (gnus-active (setq group (gnus-info-group
                                             (setq info (pop newsrc))))))
-
-      ;; Check newsgroups.  If the user doesn't want to check them, or
-      ;; they can't be checked (for instance, if the news server can't
-      ;; be reached) we just set the number of unread articles in this
-      ;; newsgroup to t.  This means that Gnus thinks that there are
-      ;; unread articles, but it has no idea how many.
-
-      ;; To be more explicit:
-      ;; >0 for an active group with messages
-      ;; 0 for an active group with no unread messages
-      ;; 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.
-      (when (setq method (gnus-info-method info))
+      ;; 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)
+       ;; There may be several similar methods.  Possibly extend the
+       ;; method.
        (if (setq cmethod (assoc method methods-cache))
            (setq method (cdr cmethod))
-         (setq cmethod (inline (gnus-server-get-method nil method)))
+         (setq cmethod (if (stringp method)
+                           (gnus-server-to-method method)
+                         (inline (gnus-find-method-for-group
+                                  (gnus-info-group info) info))))
          (push (cons method cmethod) methods-cache)
          (setq method cmethod)))
-      (when (and method
-                (not (setq method-type (cdr (assoc method type-cache)))))
+      (setq method-group-list (assoc method type-cache))
+      (unless method-group-list
        (setq method-type
              (cond
-              ((gnus-secondary-method-p method)
+              ((or (gnus-secondary-method-p method)
+                   (and (gnus-archive-server-wanted-p)
+                        (gnus-methods-equal-p archive-method method)))
                'secondary)
               ((inline (gnus-server-equal gnus-select-method method))
                'primary)
               (t
                'foreign)))
-       (push (cons method method-type) type-cache))
-
-      (setq ignore nil)
-      (cond ((and method (eq method-type 'foreign))
-            ;; These groups are foreign.  Check the level.
-            (if (<= (gnus-info-level info) foreign-level)
-                (when (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))))
-              (setq ignore t)))
-           ;; These groups are native or secondary.
-           ((> (gnus-info-level info) level)
-            ;; We don't want these groups.
-            (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.
-       )
-       ((and active ignore)
-       ;; The level of the foreign group is higher than the specified
-       ;; value.
-       )
-       (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-group-entry group)))
-         (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-group-entry group) t)))))))
-
+       (push (setq method-group-list (list method method-type nil nil))
+             type-cache))
+      ;; Only add groups that need updating.
+      (if (<= (gnus-info-level info)
+             (if (eq (cadr method-group-list) 'foreign)
+                 foreign-level
+               alevel))
+         (setcar (nthcdr 2 method-group-list)
+                 (cons info (nth 2 method-group-list)))
+       ;; The group is inactive, so we nix out the number of unread articles.
+       ;; It leads `(gnus-group-unread group)' to return t.  See also
+       ;; `gnus-group-prepare-flat'.
+       (unless active
+         (when (setq entry (gnus-group-entry group))
+           (setcar entry t)))))
+
+    ;; 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))))))
+
+    ;; Start early async retrieval of data.
+    (dolist (elem type-cache)
+      (destructuring-bind (method method-type infos dummy) elem
+       (when (and method infos
+                  (not (gnus-method-denied-p method)))
+         (unless (gnus-server-opened method)
+           (gnus-open-server method))
+         (when (gnus-check-backend-function
+                'retrieve-group-data-early (car method))
+           (when (gnus-check-backend-function 'request-scan (car method))
+             (gnus-request-scan nil method))
+           (setcar (nthcdr 3 elem)
+                   (gnus-retrieve-group-data-early method infos))))))
+
+    ;; Do the rest of the retrieval.
+    (dolist (elem type-cache)
+      (destructuring-bind (method method-type infos early-data) elem
+       (when (and method infos)
+         (let ((updatep (gnus-check-backend-function
+                         'request-update-info (car method))))
+           ;; See if any of the groups from this method require updating.
+           (gnus-read-active-for-groups method infos early-data)
+           (dolist (info infos)
+             (inline (gnus-get-unread-articles-in-group
+                      info (gnus-active (gnus-info-group info))
+                      updatep)))))))
     (gnus-message 6 "Checking new news...done")))
 
+(defun gnus-method-rank (type method)
+  (cond
+   ;; Get info for virtual groups last.
+   ((eq (car method) 'nnvirtual)
+    200)
+   ((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 (equal 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 early-data)
+  (with-current-buffer nntp-server-buffer
+    (cond
+     ((and
+       (gnus-check-backend-function 'finish-retrieve-group-infos (car method))
+       (or (not (gnus-agent-method-p method))
+          (gnus-online method)))
+      (gnus-finish-retrieve-group-infos method infos early-data)
+      (gnus-agent-save-active method))
+     ((gnus-check-backend-function 'retrieve-groups (car method))
+      (when (gnus-check-backend-function 'request-scan (car method))
+       (gnus-request-scan nil method))
+      (let (groups)
+       (gnus-read-active-file-2
+        (dolist (info infos (nreverse groups))
+          (push (gnus-group-real-name (gnus-info-group info)) groups))
+        method)))
+     ((gnus-check-backend-function 'request-list (car method))
+      (gnus-read-active-file-1 method nil infos))
+     (t
+      (dolist (info infos)
+       (gnus-activate-group (gnus-info-group info) nil nil method t))))))
+
 ;; 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 ()
@@ -1808,14 +1839,18 @@ If SCAN, request a scan of that group as well."
        (if (setq rest (member method methods))
            (gnus-info-set-method info (car rest))
          (push method methods)))
-      (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
-           alist (cdr alist)))
+      ;; 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
@@ -1837,8 +1872,7 @@ If SCAN, request a scan of that group as well."
 
 (defun gnus-parse-active ()
   "Parse active info in the nntp server buffer."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer
     (goto-char (point-min))
     ;; Parse the result we got from `gnus-request-group'.
     (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
@@ -1922,7 +1956,7 @@ If SCAN, request a scan of that group as well."
                             (setcdr range (1- article))
                             (setq modified t)
                             ranges))))))))
-                  
+
     (when modified
       (when (eq modified 'remove-null)
         (setq r (delq nil r)))
@@ -1943,7 +1977,7 @@ If SCAN, request a scan of that group as well."
     (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)))))
 
@@ -1992,8 +2026,7 @@ If SCAN, request a scan of that group as well."
             (list "archive")))))
        method)
     (setq gnus-have-read-active-file nil)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
+    (with-current-buffer nntp-server-buffer
       (while (setq method (pop methods))
        ;; Only do each method once, in case the methods appear more
        ;; than once in this list.
@@ -2008,17 +2041,20 @@ If SCAN, request a scan of that group as well."
               (message "Quit reading the active file")
               nil))))))))
 
-(defun gnus-read-active-file-1 (method force)
+(defun gnus-read-active-file-1 (method force &optional infos)
   (let (where mesg)
     (setq where (nth 1 method)
          mesg (format "Reading active file%s via %s..."
                       (if (and where (not (zerop (length where))))
                           (concat " from " where) "")
                       (car method)))
-    (gnus-message 5 mesg)
+    (gnus-message 5 "%s" 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 (or (and gnus-agent
+                         (gnus-online method))
+                    (not gnus-agent))
+                (gnus-check-backend-function 'request-scan (car method)))
        (gnus-request-scan nil method))
       (cond
        ((and (eq gnus-read-active-file 'some)
@@ -2044,7 +2080,7 @@ If SCAN, request a scan of that group as well."
            (unless (equal method gnus-message-archive-method)
              (gnus-error 1 "Cannot read active file from %s server"
                          (car method)))
-         (gnus-message 5 mesg)
+         (gnus-message 5 "%s" mesg)
          (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
          ;; We mark this active file as read.
          (push method gnus-have-read-active-file)
@@ -2053,8 +2089,7 @@ If SCAN, request a scan of that group as well."
 (defun gnus-read-active-file-2 (groups method)
   "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
   (when groups
-    (save-excursion
-      (set-buffer nntp-server-buffer)
+    (with-current-buffer nntp-server-buffer
       (gnus-check-server method)
       (let ((list-type (gnus-retrieve-groups groups method)))
        (cond ((not list-type)
@@ -2080,7 +2115,8 @@ If SCAN, request a scan of that group as well."
                            (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
@@ -2115,8 +2151,12 @@ If SCAN, request a scan of that group as well."
                      (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
@@ -2255,7 +2295,8 @@ If FORCE is non-nil, the .newsrc file is read."
 (defun gnus-convert-old-newsrc ()
   "Convert old newsrc formats into the current format, if needed."
   (let ((fcv (and gnus-newsrc-file-version
-                 (gnus-continuum-version gnus-newsrc-file-version))))
+                 (gnus-continuum-version gnus-newsrc-file-version)))
+       (gcv (gnus-continuum-version)))
     (when fcv
       ;; A newsrc file was loaded.
       (let (prompt-displayed
@@ -2288,7 +2329,8 @@ If FORCE is non-nil, the .newsrc file is read."
 
         ;; Perform converters to bring older version up to date.
        (when (and converters (< fcv (caar converters)))
-         (while (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))
@@ -2321,7 +2363,7 @@ If FORCE is non-nil, the .newsrc file is read."
                                   t)))))
 
               (funcall func convert-to)))
-          (gnus-dribble-enter 
+          (gnus-dribble-enter
            (format ";Converted gnus from version '%s' to '%s'."
                    gnus-newsrc-file-version gnus-version)))))))
 
@@ -2363,11 +2405,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")))
@@ -2375,8 +2417,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
@@ -2387,6 +2428,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
@@ -2531,7 +2574,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
@@ -2727,8 +2770,7 @@ If FORCE is non-nil, the .newsrc file is read."
               (not force)
               (or (not gnus-dribble-buffer)
                   (not (buffer-name gnus-dribble-buffer))
-                  (zerop (save-excursion
-                           (set-buffer gnus-dribble-buffer)
+                  (zerop (with-current-buffer gnus-dribble-buffer
                            (buffer-size)))))
          (gnus-message 4 "(No changes need to be saved)")
        (gnus-run-hooks 'gnus-save-newsrc-hook)
@@ -2769,9 +2811,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)))
 
@@ -2806,7 +2846,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"))
@@ -2825,6 +2866,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
@@ -2844,7 +2886,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))
@@ -2862,8 +2904,7 @@ If FORCE is non-nil, the .newsrc file is read."
 
 (defun gnus-gnus-to-newsrc-format ()
   ;; Generate and save the .newsrc file.
-  (save-excursion
-    (set-buffer (create-file-buffer gnus-current-startup-file))
+  (with-current-buffer (create-file-buffer gnus-current-startup-file)
     (let ((newsrc (cdr gnus-newsrc-alist))
          (standard-output (current-buffer))
          info ranges range method)
@@ -2871,6 +2912,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))
@@ -2913,7 +2958,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)))))
 
 \f
@@ -2925,12 +2971,13 @@ If FORCE is non-nil, the .newsrc file is read."
 
 (defun gnus-slave-mode ()
   "Minor mode for slave Gnusae."
+  ;; 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 ()
-  (save-excursion
-    (set-buffer gnus-dribble-buffer)
+  (with-current-buffer gnus-dribble-buffer
     (let ((slave-name
           (mm-make-temp-file (concat gnus-current-startup-file "-slave-")))
          (modes (ignore-errors
@@ -2954,8 +3001,7 @@ If FORCE is non-nil, the .newsrc file is read."
     (if (not slave-files)
        ()                              ; There are no slave files to read.
       (gnus-message 7 "Reading slave newsrcs...")
-      (save-excursion
-       (set-buffer (gnus-get-buffer-create " *gnus slave*"))
+      (with-current-buffer (gnus-get-buffer-create " *gnus slave*")
        (setq slave-files
              (sort (mapcar (lambda (file)
                              (list (nth 5 (file-attributes file)) file))
@@ -3023,6 +3069,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))
@@ -3074,8 +3121,7 @@ If FORCE is non-nil, the .newsrc file is read."
 (defun gnus-group-get-description (group)
   "Get the description of a group by sending XGTITLE to the server."
   (when (gnus-request-group-description group)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
+    (with-current-buffer nntp-server-buffer
       (goto-char (point-min))
       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
        (match-string 1)))))
@@ -3097,12 +3143,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 ()
@@ -3156,7 +3200,4 @@ Would otherwise be an alias for `display-time-event-handler'." nil))))
 
 (provide 'gnus-start)
 
-;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
 ;;; gnus-start.el ends here
-
-