Commit 8e39ec68 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen Committed by Katsumi Yamaoka
Browse files

[Gnus] Make moving IMAP articles faster in large groups

parent 44df0a8f
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.
......
......@@ -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
......
......@@ -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))))
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment