[Gnus] Make moving IMAP articles faster in large groups

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 08e904adf48676afce91feab52c573992f9c892f..e47e8ad282ca5162bffd5e488dbb7b835f07337e 100644 (file)
--- 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 dc11442656d8c2593a76edc0207495ec9a7e428c..e22138b7028408cf2b664f14fd64beee508b4086 100644 (file)
--- 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 487b85f581d48436da59f8ac413ce2900921e5e7..dd938ce07586caeeada7ee51f02574cc7c28e3e8 100644 (file)
--- 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 f3a895744306a5db6810c88b34bf5e722dc61435..ced556198811f684d8d22cfbd92cae121b2e4407 100644 (file)
--- 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)