Synch with Oort Gnus.

[elisp/gnus.git-] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index c88021c..c1c5767 100644 (file)
--- 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 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))
 
 ;;; Code:
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'gnus-clfns))

-(eval-and-compile (require 'imap))
+(require 'imap)

 
 (require 'nnoo)
 (require 'nnmail)
 
 (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"
                         (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")
                               (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
   :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)
 
   :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
 ;; 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-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.")
 
 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:
 
 
 ;; 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*\")")
 (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'."
 (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
 
 (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)
       (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
               (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)))
 
            (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
     (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))))
 
        (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
 
 
 ;; 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)
 (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))
 
     (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 ()
   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)))
 
   (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)
                         (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
                         ;; 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)))
            ;; 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)
        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))
 
   (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
 (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)
                      (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))
                  ;; 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)
 
 (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)
 
 (defun nnimap-acl-get (mailbox server)
   (when (nnimap-possibly-change-server server)