X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=c1c5767cebffc4bc7d369c3b1761dec64923753c;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=a556bc5c7b3edd73ae6ead5ff9dcc31f23d70768;hpb=1bbbc9816723251cb13b4b9518500a8371c8a466;p=elisp%2Fgnus.git- diff --git a/lisp/nnimap.el b/lisp/nnimap.el index a556bc5..c1c5767 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -55,6 +55,7 @@ ;; o What about Gnus's article editing, can we support it? NO! ;; o Use \Draft to support the draft group?? ;; o Duplicate suppression +;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers ;;; Code: @@ -192,7 +193,7 @@ RFC2060 section 6.4.4." :type 'string) (defcustom nnimap-split-fancy nil - "Like `nnmail-split-fancy', which see." + "Like the variable `nnmail-split-fancy', which see." :group 'nnimap :type 'sexp) @@ -214,6 +215,18 @@ the same mailbox will be faster though." :type 'boolean :group 'nnimap) +(defcustom nnimap-retrieve-groups-asynchronous t + "Send asynchronous STATUS commands for each mailbox before checking mail. +If you have mailboxes that rarely receives mail, this speeds up new +mail checking. It works by first sending STATUS commands for each +mailbox, and then only checking groups which has a modified UIDNEXT +more carefully for new mail. + +In summary, the default is O((1-p)*k+p*n) and changing it to nil makes +it O(n). If p is small, then the default is probably faster." + :type 'boolean + :group 'nnimap) + (defvoo nnimap-need-unselect-to-notice-new-mail nil "Unselect mailboxes before looking for new mail in them. Some servers seem to need this under some circumstances.") @@ -269,9 +282,12 @@ typical complete file name would be (defvoo nnimap-nov-file-name-suffix ".novcache" "Suffix for NOV cache base filename.") -(defvoo nnimap-nov-is-evil nil - "If non-nil, nnimap will never generate or use a local nov database for this backend. -Using nov databases will speed up header fetching considerably. +(defvoo nnimap-nov-is-evil gnus-agent + "If non-nil, never generate or use a local nov database for this backend. +Using nov databases should speed up header fetching considerably. +However, it will invoke a UID SEARCH UID command on the server, and +some servers implement this command inefficiently by opening each and +every message in the group, thus making it quite slow. Unlike other backends, you do not need to take special care if you flip this variable.") @@ -367,6 +383,7 @@ restrict visible folders.") ;; Internal variables: +(defvar nnimap-mailbox-info (gnus-make-hashtable 997)) (defvar nnimap-debug nil "Name of buffer to record debugging info. For example: (setq nnimap-debug \"*nnimap-debug*\")") @@ -928,24 +945,77 @@ function is generally only called when Gnus is shutting down." ;; Optional backend functions +(defun nnimap-string-lessp-numerical (s1 s2) + "Return t if first arg string is less than second in numerical order." + (cond ((string= s1 s2) + nil) + ((> (length s1) (length s2)) + nil) + ((< (length s1) (length s2)) + t) + ((< (string-to-number (substring s1 0 1)) + (string-to-number (substring s2 0 1))) + t) + ((> (string-to-number (substring s1 0 1)) + (string-to-number (substring s2 0 1))) + nil) + (t + (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1))))) + (deffoo nnimap-retrieve-groups (groups &optional server) (when (nnimap-possibly-change-server server) (gnus-message 5 "nnimap: Checking mailboxes...") (with-current-buffer nntp-server-buffer (erase-buffer) (nnimap-before-find-minmax-bugworkaround) - (dolist (group groups) - (gnus-message 7 "nnimap: Checking mailbox %s" group) - (or (member "\\NoSelect" - (imap-mailbox-get 'list-flags group nnimap-server-buffer)) - (let ((info (nnimap-find-minmax-uid group 'examine))) - (when (> (or (imap-mailbox-get 'recent group - nnimap-server-buffer) 0) - 0) - (push (list (cons group 0)) nnmail-split-history)) - (insert (format "\"%s\" %d %d y\n" group - (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1)))))))) + (let (asyncgroups slowgroups) + (if (null nnimap-retrieve-groups-asynchronous) + (setq slowgroups groups) + (dolist (group groups) + (gnus-message 7 "nnimap: Checking mailbox %s" group) + (add-to-list (if (gnus-gethash-safe (concat server group) + nnimap-mailbox-info) + 'asyncgroups + 'slowgroups) + (list group (imap-mailbox-status-asynch + group 'uidnext nnimap-server-buffer)))) + (dolist (asyncgroup asyncgroups) + (let ((group (nth 0 asyncgroup)) + (tag (nth 1 asyncgroup)) + new old) + (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) + (if (nnimap-string-lessp-numerical + (car (gnus-gethash + (concat server group) nnimap-mailbox-info)) + (imap-mailbox-get 'uidnext group nnimap-server-buffer)) + (push (list group) slowgroups) + (insert (cdr (gnus-gethash (concat server group) + nnimap-mailbox-info)))))))) + (dolist (group slowgroups) + (if nnimap-retrieve-groups-asynchronous + (setq group (car group))) + (gnus-message 7 "nnimap: Rechecking mailbox %s" group) + (imap-mailbox-put 'uidnext nil group nnimap-server-buffer) + (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group + nnimap-server-buffer)) + (let* ((info (nnimap-find-minmax-uid group 'examine)) + (str (format "\"%s\" %d %d y\n" group + (or (nth 2 info) 0) + (max 1 (or (nth 1 info) 1))))) + (when (> (or (imap-mailbox-get 'recent group + nnimap-server-buffer) 0) + 0) + (push (list (cons group 0)) nnmail-split-history)) + (insert str) + (when nnimap-retrieve-groups-asynchronous + (gnus-sethash + (concat server group) + (cons (or (imap-mailbox-get + 'uidnext group nnimap-server-buffer) + (imap-mailbox-status + group 'uidnext nnimap-server-buffer)) + str) + nnimap-mailbox-info))))))) (gnus-message 5 "nnimap: Checking mailboxes...done") 'active)) @@ -1065,7 +1135,7 @@ function is generally only called when Gnus is shutting down." nil) (defun nnimap-split-fancy () - "Like nnmail-split-fancy, but uses nnimap-split-fancy." + "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'." (let ((nnmail-split-fancy nnimap-split-fancy)) (nnmail-split-fancy))) @@ -1144,6 +1214,10 @@ function is generally only called when Gnus is shutting down." (message "IMAP split moved %s:%s:%d to %s" server inbox article to-group) (setq removeorig t) + (when nnmail-cache-accepted-message-ids + (with-current-buffer nntp-server-buffer + (nnmail-cache-insert (nnmail-fetch-field + "message-id") to-group))) ;; Add the group-art list to the history list. (push (list (cons to-group 0)) nnmail-split-history)) (t @@ -1157,6 +1231,8 @@ function is generally only called when Gnus is shutting down." ;; todo: UID EXPUNGE (if available) to remove splitted articles (imap-mailbox-expunge) (imap-mailbox-close))) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-close)) t)))) (deffoo nnimap-request-scan (&optional group server) @@ -1217,7 +1293,6 @@ function is generally only called when Gnus is shutting down." (gnus-message 5 "nnimap: Marking article %d for deletion..." imap-current-message)) - (defun nnimap-expiry-target (arts group server) (unless (eq nnmail-expiry-target 'delete) (with-temp-buffer @@ -1311,7 +1386,12 @@ function is generally only called when Gnus is shutting down." (kill-region (point) (progn (forward-line) (point)))) ;; turn into rfc822 format (\r\n eol's) (while (search-forward "\n" nil t) - (replace-match "\r\n"))) + (replace-match "\r\n")) + (when nnmail-cache-accepted-message-ids + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group))) + (when (and last nnmail-cache-accepted-message-ids) + (nnmail-cache-close)) ;; this 'or' is for Cyrus server bug (or (null (imap-current-mailbox nnimap-server-buffer)) (imap-mailbox-unselect nnimap-server-buffer))