Synch with Oort Gnus.

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

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 9a2e046..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:
 

@@ -281,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.")
 

@@ -379,7 +383,7 @@ restrict visible folders.")
 
 ;; Internal variables:
 
 
 ;; Internal variables:
 

-(defvoo nnimap-mailbox-info (gnus-make-hashtable 997))
+(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*\")")

@@ -941,6 +945,23 @@ 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...")
 (deffoo nnimap-retrieve-groups (groups &optional server)
   (when (nnimap-possibly-change-server server)
     (gnus-message 5 "nnimap: Checking mailboxes...")

@@ -952,7 +973,8 @@ function is generally only called when Gnus is shutting down."
            (setq slowgroups groups)
          (dolist (group groups)
            (gnus-message 7 "nnimap: Checking mailbox %s" group)
            (setq slowgroups groups)
          (dolist (group groups)
            (gnus-message 7 "nnimap: Checking mailbox %s" group)

-           (add-to-list (if (gnus-gethash-safe group nnimap-mailbox-info)
+           (add-to-list (if (gnus-gethash-safe (concat server group)
+                                               nnimap-mailbox-info)

                             'asyncgroups
                           'slowgroups)
                         (list group (imap-mailbox-status-asynch
                             'asyncgroups
                           'slowgroups)
                         (list group (imap-mailbox-status-asynch

@@ -962,10 +984,13 @@ function is generally only called when Gnus is shutting down."
                  (tag   (nth 1 asyncgroup))
                  new old)
              (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
                  (tag   (nth 1 asyncgroup))
                  new old)
              (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))

-               (if (< (car (gnus-gethash group nnimap-mailbox-info))
-                      (imap-mailbox-get 'uidnext group 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)
                    (push (list group) slowgroups)

-                 (insert (cdr (gnus-gethash group nnimap-mailbox-info))))))))
+                 (insert (cdr (gnus-gethash (concat server group)
+                                            nnimap-mailbox-info))))))))

        (dolist (group slowgroups)
          (if nnimap-retrieve-groups-asynchronous
              (setq group (car group)))
        (dolist (group slowgroups)
          (if nnimap-retrieve-groups-asynchronous
              (setq group (car group)))

@@ -984,7 +1009,7 @@ function is generally only called when Gnus is shutting down."
                (insert str)
                (when nnimap-retrieve-groups-asynchronous
                  (gnus-sethash
                (insert str)
                (when nnimap-retrieve-groups-asynchronous
                  (gnus-sethash

-                  group
+                  (concat server group)

                   (cons (or (imap-mailbox-get
                              'uidnext group nnimap-server-buffer)
                             (imap-mailbox-status
                   (cons (or (imap-mailbox-get
                              'uidnext group nnimap-server-buffer)
                             (imap-mailbox-status

@@ -1363,7 +1388,8 @@ function is generally only called when Gnus is shutting down."
                    (while (search-forward "\n" nil t)
                      (replace-match "\r\n"))
                    (when nnmail-cache-accepted-message-ids
                    (while (search-forward "\n" nil t)
                      (replace-match "\r\n"))
                    (when nnmail-cache-accepted-message-ids

-                     (nnmail-cache-insert (nnmail-fetch-field "message-id"))))
+                     (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
                  (when (and last nnmail-cache-accepted-message-ids)
                    (nnmail-cache-close))
                  ;; this 'or' is for Cyrus server bug