Rewrite the Gnus group activation method to be more efficient.

The main idea is to gather all groups based on their select methods,
and then issuing one `-request-list' per select method, instead of
activating them group by group.  This should in theory be much, much
faster, but there's a bunch of subtle interactions between a plethora
of variables that doesn't make this trivial to achieve.

This is a first stab at the issue, and seems to work, but I'm sure
that there are corner cases that doesn't quite work right.

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 3d34fa7..5cc4ef6 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -3982,23 +3982,13 @@ re-scanning.  If ARG is non-nil and not a number, this will force
                        (>= arg gnus-use-nocem))
                   (not arg)))
       (gnus-nocem-scan-groups))
-    ;; If ARG is not a number, then we read the active file.
-    (when (and arg (not (numberp arg)))
-      (let ((gnus-read-active-file t))
-       (gnus-read-active-file))
-      (setq arg nil)
-
-      ;; If the user wants it, we scan for new groups.
-      (when (eq gnus-check-new-newsgroups 'always)
-       (gnus-find-new-newsgroups)))
-
-    (setq arg (gnus-group-default-level arg t))
-    (if (and gnus-read-active-file (not arg))
-       (progn
-         (gnus-read-active-file)
-         (gnus-get-unread-articles arg))
-      (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
-       (gnus-get-unread-articles arg)))
+
+    (gnus-get-unread-articles arg)
+
+    ;; If the user wants it, we scan for new groups.
+    (when (eq gnus-check-new-newsgroups 'always)
+      (gnus-find-new-newsgroups))
+
     (gnus-check-reasonable-setup)
     (gnus-run-hooks 'gnus-after-getting-new-news-hook)
     (gnus-group-list-groups (and (numberp arg)

diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index fb9b482..1054506 100644 (file)
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -544,7 +544,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
         (if group (gnus-find-method-for-group group) gnus-command-method))
        (gnus-inhibit-demon t)
        (mail-source-plugged gnus-plugged))
-    (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
+    (when (or gnus-plugged
+             (not (gnus-agent-method-p gnus-command-method)))
       (setq gnus-internal-registry-spool-current-method gnus-command-method)
       (funcall (gnus-get-function gnus-command-method 'request-scan)
               (and group (gnus-group-real-name group))

diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index 2a332f7..3c78ac9 100644 (file)
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -1685,7 +1685,7 @@ If SCAN, request a scan of that group as well."
         (methods-cache nil)
         (type-cache nil)
         scanned-methods info group active method retrieve-groups cmethod
-        method-type)
+        method-type method-group-list)
     (gnus-message 6 "Checking new news...")
 
     (while newsrc
@@ -1704,14 +1704,19 @@ If SCAN, request a scan of that group as well."
       ;; 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)
        (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)))
-      (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)
@@ -1720,99 +1725,73 @@ If SCAN, request a scan of that group as well."
                'primary)
               (t
                'foreign)))
-       (push (cons method method-type) type-cache))
-
-      (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))))
-              (if (and level
-                       ;; If `active' is nil that means the group has
-                       ;; never been read, the group should be marked
-                       ;; as having never been checked (see below).
-                       active
-                       (> (gnus-info-level info) level))
-                  ;; Don't check groups of which levels are higher
-                  ;; than the one that a user specified.
-                  (setq active 'ignore))))
-           ;; These groups are native or secondary.
-           ((> (gnus-info-level info) alevel)
-            ;; 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 mail-sources)))
-                   (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-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))
+             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)
+
+      ;; 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)) t)))))
     (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-info-group info))
+              infos)
+       method))
+     ((gnus-check-backend-function 'request-list (car method))
+      (gnus-read-active-file-1 method nil))
+     (t
+      (error "No method for %S" 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 ()
@@ -2043,7 +2022,9 @@ If SCAN, request a scan of that group as well."
     (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)

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index ec15e98..4a313f2 100644 (file)
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -536,7 +536,7 @@ See `mail-source-bind'."
    (t
     value)))
 
-(defun mail-source-fetch (source callback)
+(defun mail-source-fetch (source callback &optional method)
   "Fetch mail from SOURCE and call CALLBACK zero or more times.
 CALLBACK will be called with the name of the file where (some of)
 the mail from SOURCE is put.
@@ -544,6 +544,11 @@ Return the number of files that were found."
   (mail-source-bind-common source
     (if (or mail-source-plugged plugged)
        (save-excursion
+         (nnheader-message 4 "%sReading incoming mail from %s..."
+                           (if method
+                               (format "%s: ")
+                             "")
+                           (car source))
          (let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
                (found 0))
            (unless function

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index 2f21868..b7d834e 100644 (file)
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -1823,8 +1823,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       ;; The we go through all the existing mail source specification
       ;; and fetch the mail from each.
       (while (setq source (pop fetching-sources))
-       (nnheader-message 4 "%s: Reading incoming mail from %s..."
-                         method (car source))
        (when (setq new
                    (mail-source-fetch
                     source
@@ -1842,8 +1840,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
          (incf i)))
       ;; If we did indeed read any incoming spools, we save all info.
       (if (zerop total)
-         (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
-                           method (car source))
+         (when mail-source-plugged
+           (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
+                             method (car source)))
        (nnmail-save-active
         (nnmail-get-value "%s-group-alist" method)
         (nnmail-get-value "%s-active-file" method))