X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=c1c5767cebffc4bc7d369c3b1761dec64923753c;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=c88021c6d8deb3ade932c3a2e6e24d8ed6bd297c;hpb=61a6a32796c29e8bb7e8d58152b30aa18e3b7722;p=elisp%2Fgnus.git- diff --git a/lisp/nnimap.el b/lisp/nnimap.el index c88021c..c1c5767 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -55,12 +55,13 @@ ;; 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: (eval-when-compile (require 'cl)) (eval-when-compile (require 'gnus-clfns)) -(eval-and-compile (require 'imap)) +(require 'imap) (require 'nnoo) (require 'nnmail) @@ -174,7 +175,7 @@ group/function elements." (nnimap-strict-function :tag "User-defined function")) (repeat :menu-tag "Multi-server (extended)" :tag "Multi-server list" - (list (regexp :tag "Server regexp") + (list (regexp :tag "Server regexp") (list (regexp :tag "Incoming Mailbox regexp") (repeat :tag "Rules for matching server(s) and mailbox(es)" (list (string :tag "Destination mailbox") @@ -192,10 +193,44 @@ 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) +;; Performance / bug workaround variables + +(defcustom nnimap-close-asynchronous t + "Close mailboxes asynchronously in `nnimap-close-group'. +This means that errors cought by nnimap when closing the mailbox will +not prevent Gnus from updating the group status, which may be harmful. +However, it increases speed." + :type 'boolean + :group 'nnimap) + +(defcustom nnimap-dont-close t + "Never close mailboxes. +This increases the speed of closing mailboxes (quiting group) but may +decrease the speed of selecting another mailbox later. Re-selecting +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.") + ;; Authorization / Privacy variables (defvoo nnimap-auth-method nil @@ -247,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.") @@ -345,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*\")") @@ -413,16 +452,18 @@ If SERVER is nil, uses the current server." (defun nnimap-before-find-minmax-bugworkaround () "Function called before iterating through mailboxes with `nnimap-find-minmax-uid'." - ;; XXX this is for UoW imapd problem, it doesn't notice new mail in - ;; currently selected mailbox without a re-select/examine. - (or (null (imap-current-mailbox nnimap-server-buffer)) - (imap-mailbox-unselect nnimap-server-buffer))) + (when nnimap-need-unselect-to-notice-new-mail + ;; XXX this is for UoW imapd problem, it doesn't notice new mail in + ;; currently selected mailbox without a re-select/examine. + (or (null (imap-current-mailbox nnimap-server-buffer)) + (imap-mailbox-unselect nnimap-server-buffer)))) (defun nnimap-find-minmax-uid (group &optional examine) "Find lowest and highest active article nummber in GROUP. If EXAMINE is non-nil the group is selected read-only." (with-current-buffer nnimap-server-buffer - (when (imap-mailbox-select group examine) + (when (or (string= group (imap-current-mailbox)) + (imap-mailbox-select group examine)) (let (minuid maxuid) (when (> (imap-mailbox-get 'exists) 0) (imap-fetch "1,*" "UID" nil 'nouidfetch) @@ -647,8 +688,8 @@ If EXAMINE is non-nil the group is selected read-only." (cons low high) group server)) (when (buffer-modified-p) (nnmail-write-region - 1 (point-max) (nnimap-group-overview-filename group server) - nil 'nomesg)) + (point-min) (point-max) + (nnimap-group-overview-filename group server) nil 'nomesg)) (nnheader-nov-delete-outside-range low high)))) 'nov))) @@ -838,15 +879,18 @@ function is generally only called when Gnus is shutting down." (when (and (imap-opened) (nnimap-possibly-change-group group server)) (case nnimap-expunge-on-close - ('always (imap-mailbox-expunge) - (imap-mailbox-close)) - ('ask (if (and (imap-search "DELETED") - (gnus-y-or-n-p (format - "Expunge articles in group `%s'? " - imap-current-mailbox))) - (progn (imap-mailbox-expunge) - (imap-mailbox-close)) - (imap-mailbox-unselect))) + (always (progn + (imap-mailbox-expunge nnimap-close-asynchronous) + (unless nnimap-dont-close + (imap-mailbox-close nnimap-close-asynchronous)))) + (ask (if (and (imap-search "DELETED") + (gnus-y-or-n-p (format "Expunge articles in group `%s'? " + imap-current-mailbox))) + (progn + (imap-mailbox-expunge nnimap-close-asynchronous) + (unless nnimap-dont-close + (imap-mailbox-close nnimap-close-asynchronous))) + (imap-mailbox-unselect))) (t (imap-mailbox-unselect))) (not imap-current-mailbox)))) @@ -901,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)) @@ -1038,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))) @@ -1117,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 @@ -1130,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) @@ -1190,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 @@ -1284,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)) @@ -1308,7 +1415,7 @@ function is generally only called when Gnus is shutting down." (defun nnimap-expunge (mailbox server) (when (nnimap-possibly-change-group mailbox server) - (imap-mailbox-expunge nnimap-server-buffer))) + (imap-mailbox-expunge nil nnimap-server-buffer))) (defun nnimap-acl-get (mailbox server) (when (nnimap-possibly-change-server server)