From 8e39ec680c7068c2dc2143bf915e5acca7bf7c0f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 26 Jan 2015 04:18:57 +0000 Subject: [PATCH] [Gnus] Make moving IMAP articles faster in large groups --- lisp/gnus/ChangeLog | 15 +++++++ lisp/gnus/gnus-group.el | 4 +- lisp/gnus/gnus-int.el | 8 ++++ lisp/gnus/nnimap.el | 117 +++++++++++++++++++++++++++--------------------- 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 + + * 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 * 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) -- 2.11.4.GIT