Synch with Oort Gnus.

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

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index a556bc5..c1c5767 100644 (file)
--- 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 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:
 
 
 ;;; Code:
 

@@ -192,7 +193,7 @@ 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)
 

@@ -214,6 +215,18 @@ the same mailbox will be faster though."
   :type 'boolean
   :group 'nnimap)
 
   :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.")
 (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-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.")
 

@@ -367,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*\")")

@@ -928,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))
 

@@ -1065,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)))
 

@@ -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)
                         (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

@@ -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)))
            ;; 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)

@@ -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))
 
   (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

@@ -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)
                      (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))