[Gnus] Make moving IMAP articles faster in large groups

4 files changed, 93 insertions, 51 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 08e904adf48..e47e8ad282c 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,18 @@
+2015-01-26  Lars Ingebrigtsen  <larsi@gnus.org>
+
+        * nnimap.el (nnimap-request-accept-article): Allow respooling using
+        nnimap.
+
+        * gnus-group.el (gnus-group-get-new-news-this-group): Explicitly
+        request rescans when being run interactively.
+
+        * nnimap.el (nnimap-request-group): Don't rescan the group here,
+        because that can be very slow in large groups.
+
+        * gnus-int.el (gnus-request-group-scan): New backend function.
+
+        * nnimap.el (nnimap-request-scan-group): Implement in on IMAP.
+
 2015-01-25  Lars Ingebrigtsen  <larsi@gnus.org>
 
         * gnus-group.el (gnus-group-suspend): Close all backends.
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index dc11442656d..e22138b7028 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -4075,7 +4075,9 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
       (gnus-group-remove-mark group)
       ;; Bypass any previous denials from the server.
       (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
-      (if (gnus-activate-group group (if dont-scan nil 'scan) nil method)
+      (if (or (and (not dont-scan)
+                   (gnus-request-group-scan group (gnus-get-info group)))
+              (gnus-activate-group group (if dont-scan nil 'scan) nil method))
           (let ((info (gnus-get-info group))
                 (active (gnus-active group)))
             (when info
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 487b85f581d..dd938ce0758 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -439,6 +439,14 @@ If it is down, start it up (again)."
       (funcall (gnus-get-function gnus-command-method func)
                (gnus-group-real-name group) (nth 1 gnus-command-method)))))
 
+(defun gnus-request-group-scan (group info)
+  "Request that GROUP get a complete rescan."
+  (let ((gnus-command-method (gnus-find-method-for-group group))
+        (func 'request-group-description))
+    (when (gnus-check-backend-function func group)
+      (funcall (gnus-get-function gnus-command-method func)
+               (gnus-group-real-name group) (nth 1 gnus-command-method) info))))
+
 (defun gnus-close-group (group)
   "Request the GROUP be closed."
   (let ((gnus-command-method (inline (gnus-find-method-for-group group))))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index f3a89574430..ced55619881 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -792,43 +792,55 @@ textual parts.")
         articles active marks high low)
     (with-current-buffer nntp-server-buffer
       (when result
-        (if (and dont-check
-                 (setq active (nth 2 (assoc group nnimap-current-infos))))
-            (insert (format "211 %d %d %d %S\n"
-                            (- (cdr active) (car active))
-                            (car active)
-                            (cdr active)
-                            group))
-          (with-current-buffer (nnimap-buffer)
-            (erase-buffer)
-            (let ((group-sequence
-                   (nnimap-send-command "SELECT %S" (utf7-encode group t)))
-                  (flag-sequence
-                   (nnimap-send-command "UID FETCH 1:* FLAGS")))
-              (setf (nnimap-group nnimap-object) group)
-              (nnimap-wait-for-response flag-sequence)
-              (setq marks
-                    (nnimap-flags-to-marks
-                     (nnimap-parse-flags
-                      (list (list group-sequence flag-sequence
-                                  1 group "SELECT")))))
-              (when (and info
-                         marks)
-                (nnimap-update-infos marks (list info))
-                (nnimap-store-info info (gnus-active (gnus-info-group info))))
-              (goto-char (point-max))
-              (let ((uidnext (nth 5 (car marks))))
-                (setq high (or (if uidnext
-                                   (1- uidnext)
-                                 (nth 3 (car marks)))
-                               0)
-                      low (or (nth 4 (car marks)) uidnext 1)))))
-          (erase-buffer)
-          (insert
-           (format
-            "211 %d %d %d %S\n" (1+ (- high low)) low high group)))
+        (when (or (not dont-check)
+                  (not (setq active
+                             (nth 2 (assoc group nnimap-current-infos)))))
+          (let ((sequences (nnimap-retrieve-group-data-early
+                            server (list info))))
+            (nnimap-finish-retrieve-group-infos server (list info) sequences
+                                                t)
+            (setq active (nth 2 (assoc group nnimap-current-infos)))))
+        (insert (format "211 %d %d %d %S\n"
+                        (- (cdr active) (car active))
+                        (car active)
+                        (cdr active)
+                        group))
         t))))
 
+(deffoo nnimap-request-scan-group (group &optional server info)
+  (setq group (nnimap-decode-gnus-group group))
+  (let (marks high low)
+    (with-current-buffer (nnimap-buffer)
+      (erase-buffer)
+      (let ((group-sequence
+             (nnimap-send-command "SELECT %S" (utf7-encode group t)))
+            (flag-sequence
+             (nnimap-send-command "UID FETCH 1:* FLAGS")))
+        (setf (nnimap-group nnimap-object) group)
+        (nnimap-wait-for-response flag-sequence)
+        (setq marks
+              (nnimap-flags-to-marks
+               (nnimap-parse-flags
+                (list (list group-sequence flag-sequence
+                            1 group "SELECT")))))
+        (when (and info
+                   marks)
+          (nnimap-update-infos marks (list info))
+          (nnimap-store-info info (gnus-active (gnus-info-group info))))
+        (goto-char (point-max))
+        (let ((uidnext (nth 5 (car marks))))
+          (setq high (or (if uidnext
+                             (1- uidnext)
+                           (nth 3 (car marks)))
+                         0)
+                low (or (nth 4 (car marks)) uidnext 1)))))
+    (with-current-buffer nntp-server-buffer
+      (erase-buffer)
+      (insert
+       (format
+        "211 %d %d %d %S\n" (1+ (- high low)) low high group))
+      t)))
+
 (deffoo nnimap-request-create-group (group &optional server args)
   (setq group (nnimap-decode-gnus-group group))
   (when (nnimap-change-group nil server)
@@ -1122,8 +1134,11 @@ If LIMIT, first try to limit the search to the N last articles."
     (setq group
           (caar
            (nnmail-article-group
+            ;; We don't really care about the article number, because
+            ;; that's determined by the IMAP server later.  So just
+            ;; return the group name.
             `(lambda (group)
-               (nnml-active-number group ,server))))))
+               (list (list group)))))))
   (setq group (nnimap-decode-gnus-group group))
   (when (nnimap-change-group nil server)
     (nnmail-check-syntax)
@@ -1371,7 +1386,8 @@ If LIMIT, first try to limit the search to the N last articles."
         command
       (nth 2 quirk))))
 
-(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
+(deffoo nnimap-finish-retrieve-group-infos (server infos sequences
+                                                   &optional dont-insert)
   (when (and sequences
              (nnimap-change-group nil server t)
              ;; Check that the process is still alive.
@@ -1391,19 +1407,20 @@ If LIMIT, first try to limit the search to the N last articles."
                               (nnimap-parse-flags
                                (nreverse sequences)))
                              infos)
-        ;; Finally, just return something resembling an active file in
-        ;; the nntp buffer, so that the agent can save the info, too.
-        (with-current-buffer nntp-server-buffer
-          (erase-buffer)
-          (dolist (info infos)
-            (let* ((group (gnus-info-group info))
-                   (active (gnus-active group)))
-              (when active
-                (insert (format "%S %d %d y\n"
-                                (decode-coding-string
-                                 (gnus-group-real-name group) 'utf-8)
-                                (cdr active)
-                                (car active)))))))))))
+        (unless dont-insert
+          ;; Finally, just return something resembling an active file in
+          ;; the nntp buffer, so that the agent can save the info, too.
+          (with-current-buffer nntp-server-buffer
+            (erase-buffer)
+            (dolist (info infos)
+              (let* ((group (gnus-info-group info))
+                     (active (gnus-active group)))
+                (when active
+                  (insert (format "%S %d %d y\n"
+                                  (decode-coding-string
+                                   (gnus-group-real-name group) 'utf-8)
+                                  (cdr active)
+                                  (car active))))))))))))
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)