Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.

8 files changed, 125 insertions, 140 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index c4a451248f6..a487b63ffed 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,16 @@
 2010-09-04  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+        * gnus-start.el (gnus-get-unread-articles): Rewrite the way we request
+        data from the backends, so that we only request the list of groups from
+        each method once.  This should speed things up considerably.
+
+        * nnvirtual.el (nnvirtual-request-list): Remove function so that we can
+        detect that it's not implemented.
+
+        * nnmh.el (nnmh-request-list-1): Fix up the recursion behavior so that
+        we actually do recurse down into the tree, but don't stat all leaf
+        nodes.
+
         * gnus-html.el (gnus-html-show-images): If there are no images to show,
         then say so instead of bugging out.
 
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 3d34fa7c002..5cc4ef68bd9 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/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/gnus-int.el b/lisp/gnus/gnus-int.el
index fb9b482b148..1054506acef 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/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/gnus-start.el b/lisp/gnus/gnus-start.el
index 2a332f7c420..16a733d1452 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1684,8 +1684,8 @@ If SCAN, request a scan of that group as well."
            alevel))
          (methods-cache nil)
          (type-cache nil)
-         scanned-methods info group active method retrieve-groups cmethod
-         method-type)
+         infos info group active method cmethod
+         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,74 @@ 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)))))))
     (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 ()
@@ -2043,7 +2023,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/gnus/mail-source.el b/lisp/gnus/mail-source.el
index ec15e982390..08b7a5ebbd2 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/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: " method)
+                              "")
+                            (car source))
           (let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
                 (found 0))
             (unless function
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 2f218681918..b7d834ecd8c 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/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))
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 86f751c7669..4b843e62153 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -209,24 +209,25 @@ as unread by Gnus.")
   ;; Recurse down all directories.
   (let ((files (nnheader-directory-files dir t nil t))
         (max 0)
-        min rdir attributes num)
+        min rdir num subdirectoriesp)
     ;; Recurse down directories.
+    (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2))
     (dolist (rdir files)
-      (setq attributes (file-attributes rdir))
-      (when (null (nth 0 attributes))
-        (setq file (file-name-nondirectory rdir))
-        (when (string-match "^[0-9]+$" file)
-          (setq num (string-to-number file))
-          (setq max (max max num))
-          (when (or (null min)
-                    (< num min))
-            (setq min num))))
-      (when (and (eq (nth 0 attributes) t) ; Is a directory
-                 (> (nth 1 attributes) 2)  ; Has sub-directories
-                 (file-readable-p rdir)
-                 (not (equal (file-truename rdir)
-                             (file-truename dir))))
-        (nnmh-request-list-1 rdir)))
+      (if (or (not subdirectoriesp)
+              (file-regular-p rdir))
+          (progn
+            (setq file (file-name-nondirectory rdir))
+            (when (string-match "^[0-9]+$" file)
+              (setq num (string-to-number file))
+              (setq max (max max num))
+              (when (or (null min)
+                        (< num min))
+                (setq min num))))
+        ;; This is a directory.
+        (when (and (file-readable-p rdir)
+                   (not (equal (file-truename rdir)
+                               (file-truename dir))))
+          (nnmh-request-list-1 rdir))))
     ;; For each directory, generate an active file line.
     (unless (string= (expand-file-name nnmh-toplev) dir)
       (when min
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 74339729500..94f43216b38 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -300,10 +300,6 @@ component group will show up when you enter the virtual group.")
   t)
 
 
-(deffoo nnvirtual-request-list (&optional server)
-  (nnheader-report 'nnvirtual "LIST is not implemented."))
-
-
 (deffoo nnvirtual-request-newgroups (date &optional server)
   (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))