merge trunk

[gnu-emacs] / lisp / gnus / nnimap.el

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index dc8b38b8f9a24bc4ea3f77101799b3e3abd69621..0b0fc918c873753608ff71d37fd0d99e764d6ec2 100644 (file)
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,6 +1,6 @@
 ;;; nnimap.el --- IMAP interface for Gnus
 
 ;;; nnimap.el --- IMAP interface for Gnus
 

-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Simon Josefsson <simon@josefsson.org>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Simon Josefsson <simon@josefsson.org>


@@ -168,6 +168,8 @@ textual parts.")
                   nnmail-extra-headers))))
 
 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
                   nnmail-extra-headers))))
 
 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (when (nnimap-possibly-change-group group server)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (when (nnimap-possibly-change-group group server)


@@ -190,7 +192,7 @@ textual parts.")
   (let (article bytes lines size string)
     (block nil
       (while (not (eobp))
   (let (article bytes lines size string)
     (block nil
       (while (not (eobp))

-       (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)"))
+       (while (not (looking-at "\\* [0-9]+ FETCH.+?UID \\([0-9]+\\)"))

          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))
          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))


@@ -216,9 +218,14 @@ textual parts.")
          (let ((structure (ignore-errors
                             (read (current-buffer)))))
            (while (and (consp structure)
          (let ((structure (ignore-errors
                             (read (current-buffer)))))
            (while (and (consp structure)

-                       (not (stringp (car structure))))
+                       (not (atom (car structure))))

              (setq structure (car structure)))
              (setq structure (car structure)))

-           (setq lines (nth 7 structure))))
+           (setq lines (if (and
+                            (stringp (car structure))
+                            (equal (upcase (nth 0 structure)) "MESSAGE")
+                            (equal (upcase (nth 1 structure)) "RFC822"))
+                           (nth 9 structure)
+                         (nth 7 structure)))))

        (delete-region (line-beginning-position) (line-end-position))
        (insert (format "211 %s Article retrieved." article))
        (forward-line 1)
        (delete-region (line-beginning-position) (line-end-position))
        (insert (format "211 %s Article retrieved." article))
        (forward-line 1)


@@ -338,6 +345,11 @@ textual parts.")
        nil
       stream)))
 
        nil
       stream)))
 

+(defun nnimap-map-port (port)
+  (if (equal port "imaps")
+      "993"
+    port))
+

 (defun nnimap-open-connection-1 (buffer)
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
 (defun nnimap-open-connection-1 (buffer)
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)


@@ -345,7 +357,6 @@ textual parts.")
   (with-current-buffer (nnimap-make-process-buffer buffer)
     (let* ((coding-system-for-read 'binary)
           (coding-system-for-write 'binary)
   (with-current-buffer (nnimap-make-process-buffer buffer)
     (let* ((coding-system-for-read 'binary)
           (coding-system-for-write 'binary)

-          (port nil)

           (ports
            (cond
             ((memq nnimap-stream '(network plain starttls))
           (ports
            (cond
             ((memq nnimap-stream '(network plain starttls))


@@ -367,7 +378,8 @@ textual parts.")
        (push nnimap-server-port ports))
       (let* ((stream-list
              (open-protocol-stream
        (push nnimap-server-port ports))
       (let* ((stream-list
              (open-protocol-stream

-              "*nnimap*" (current-buffer) nnimap-address (car ports)
+              "*nnimap*" (current-buffer) nnimap-address
+              (nnimap-map-port (car ports))

               :type nnimap-stream
               :return-list t
               :shell-command nnimap-shell-program
               :type nnimap-stream
               :return-list t
               :shell-command nnimap-shell-program


@@ -385,12 +397,20 @@ textual parts.")
             (stream-type (plist-get props :type)))
        (when (and stream (not (memq (process-status stream) '(open run))))
          (setq stream nil))
             (stream-type (plist-get props :type)))
        (when (and stream (not (memq (process-status stream) '(open run))))
          (setq stream nil))

+
+        (when (and (fboundp 'set-network-process-option) ;; Not in XEmacs.
+                   (fboundp 'process-type) ;; Emacs 22 doesn't provide it.
+                   (eq (process-type stream) 'network))
+          ;; Use TCP-keepalive so that connections that pass through a NAT
+          ;; router don't hang when left idle.
+          (set-network-process-option stream :keepalive t))
+

        (setf (nnimap-process nnimap-object) stream)
        (setf (nnimap-stream-type nnimap-object) stream-type)
        (if (not stream)
            (progn
              (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
        (setf (nnimap-process nnimap-object) stream)
        (setf (nnimap-stream-type nnimap-object) stream-type)
        (if (not stream)
            (progn
              (nnheader-report 'nnimap "Unable to contact %s:%s via %s"

-                              nnimap-address port nnimap-stream)
+                              nnimap-address (car ports) nnimap-stream)

              'no-connect)
          (gnus-set-process-query-on-exit-flag stream nil)
          (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))
              'no-connect)
          (gnus-set-process-query-on-exit-flag stream nil)
          (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))


@@ -420,9 +440,9 @@ textual parts.")
                        (nnimap-login (car credentials) (cadr credentials))))
                (if (car login-result)
                    (progn
                        (nnimap-login (car credentials) (cadr credentials))))
                (if (car login-result)
                    (progn

-                    ;; Save the credentials if a save function exists
-                    ;; (such a function will only be passed if a new
-                    ;; token was created).
+                     ;; Save the credentials if a save function exists
+                     ;; (such a function will only be passed if a new
+                     ;; token was created).

                      (when (functionp (nth 2 credentials))
                        (funcall (nth 2 credentials)))
                      ;; See if CAPABILITY is set as part of login
                      (when (functionp (nth 2 credentials))
                        (funcall (nth 2 credentials)))
                      ;; See if CAPABILITY is set as part of login


@@ -519,6 +539,8 @@ textual parts.")
   nnimap-status-string)
 
 (deffoo nnimap-request-article (article &optional group server to-buffer)
   nnimap-status-string)
 
 (deffoo nnimap-request-article (article &optional group server to-buffer)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))
          parts structure)
   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))
          parts structure)


@@ -550,6 +572,8 @@ textual parts.")
            (cons group article)))))))
 
 (deffoo nnimap-request-head (article &optional group server to-buffer)
            (cons group article)))))))
 
 (deffoo nnimap-request-head (article &optional group server to-buffer)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (when (stringp article)
   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (when (stringp article)


@@ -656,12 +680,13 @@ textual parts.")
       (if (consp (caar structure))
          (nnimap-insert-partial-structure (pop structure) parts t)
        (let ((bit (pop structure)))
       (if (consp (caar structure))
          (nnimap-insert-partial-structure (pop structure) parts t)
        (let ((bit (pop structure)))

-         (insert (format  "Content-type: %s/%s"
-                          (downcase (nth 0 bit))
-                          (downcase (nth 1 bit))))
-         (if (member "CHARSET" (nth 2 bit))
+         (insert (format "Content-type: %s/%s"
+                         (downcase (nth 0 bit))
+                         (downcase (nth 1 bit))))
+         (if (member-ignore-case "CHARSET" (nth 2 bit))

              (insert (format
              (insert (format

-                      "; charset=%S\n" (cadr (member "CHARSET" (nth 2 bit)))))
+                      "; charset=%S\n"
+                      (cadr (member-ignore-case "CHARSET" (nth 2 bit)))))

            (insert "\n"))
          (insert (format "Content-transfer-encoding: %s\n"
                          (nth 5 bit)))
            (insert "\n"))
          (insert (format "Content-transfer-encoding: %s\n"
                          (nth 5 bit)))


@@ -696,7 +721,11 @@ textual parts.")
        (incf num)))
     (nreverse parts)))
 
        (incf num)))
     (nreverse parts)))
 

+(defun nnimap-decode-gnus-group (group)
+  (decode-coding-string group 'utf-8))
+

 (deffoo nnimap-request-group (group &optional server dont-check info)
 (deffoo nnimap-request-group (group &optional server dont-check info)

+  (setq group (nnimap-decode-gnus-group group))

   (let ((result (nnimap-possibly-change-group
                 ;; Don't SELECT the group if we're going to select it
                 ;; later, anyway.
   (let ((result (nnimap-possibly-change-group
                 ;; Don't SELECT the group if we're going to select it
                 ;; later, anyway.


@@ -746,16 +775,19 @@ textual parts.")
        t))))
 
 (deffoo nnimap-request-create-group (group &optional server args)
        t))))
 
 (deffoo nnimap-request-create-group (group &optional server args)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-delete-group (group &optional force server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-delete-group (group &optional force server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-rename-group (group new-name &optional server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-rename-group (group new-name &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (nnimap-unselect-group)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (nnimap-unselect-group)


@@ -770,6 +802,7 @@ textual parts.")
   (nnimap-command "EXAMINE DOES.NOT.EXIST"))
 
 (deffoo nnimap-request-expunge-group (group &optional server)
   (nnimap-command "EXAMINE DOES.NOT.EXIST"))
 
 (deffoo nnimap-request-expunge-group (group &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "EXPUNGE")))))
   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "EXPUNGE")))))


@@ -797,6 +830,7 @@ textual parts.")
 
 (deffoo nnimap-request-move-article (article group server accept-form
                                             &optional last internal-move-group)
 
 (deffoo nnimap-request-move-article (article group server accept-form
                                             &optional last internal-move-group)

+  (setq group (nnimap-decode-gnus-group group))

   (with-temp-buffer
     (mm-disable-multibyte)
     (when (funcall (if internal-move-group
   (with-temp-buffer
     (mm-disable-multibyte)
     (when (funcall (if internal-move-group


@@ -825,6 +859,7 @@ textual parts.")
              result)))))))
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
              result)))))))
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)

+  (setq group (nnimap-decode-gnus-group group))

   (cond
    ((null articles)
     nil)
   (cond
    ((null articles)
     nil)


@@ -880,15 +915,18 @@ textual parts.")
          (with-temp-buffer
            (mm-disable-multibyte)
            (when (nnimap-request-article article group server (current-buffer))
          (with-temp-buffer
            (mm-disable-multibyte)
            (when (nnimap-request-article article group server (current-buffer))

-             (nnheader-message 7 "Expiring article %s:%d" group article)

              (when (functionp target)
                (setq target (funcall target group)))
              (when (functionp target)
                (setq target (funcall target group)))

-             (when (and target
-                        (not (eq target 'delete)))
-               (if (or (gnus-request-group target t)
-                       (gnus-request-create-group target))
-                   (nnmail-expiry-target-group target group)
-                 (setq target nil)))
+             (if (and target
+                      (not (eq target 'delete)))
+                 (if (or (gnus-request-group target t)
+                         (gnus-request-create-group target))
+                     (progn
+                       (nnmail-expiry-target-group target group)
+                       (nnheader-message 7 "Expiring article %s:%d to %s"
+                                         group article target))
+                   (setq target nil))
+               (nnheader-message 7 "Expiring article %s:%d" group article))

              (when target
                (push article deleted-articles))))))))
     ;; Change back to the current group again.
              (when target
                (push article deleted-articles))))))))
     ;; Change back to the current group again.


@@ -929,7 +967,7 @@ textual parts.")
                 (car (setq result (nnimap-parse-response))))
        ;; Select the last instance of the message in the group.
        (and (setq article
                 (car (setq result (nnimap-parse-response))))
        ;; Select the last instance of the message in the group.
        (and (setq article

-                  (car (last (assoc "SEARCH" (cdr result)))))
+                  (car (last (cdr (assoc "SEARCH" (cdr result))))))

             (string-to-number article))))))
 
 (defun nnimap-delete-article (articles)
             (string-to-number article))))))
 
 (defun nnimap-delete-article (articles)


@@ -949,11 +987,14 @@ textual parts.")
                                 "delete this article now"))))))
 
 (deffoo nnimap-request-scan (&optional group server)
                                 "delete this article now"))))))
 
 (deffoo nnimap-request-scan (&optional group server)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (when (and (nnimap-possibly-change-group nil server)
             nnimap-inbox
             nnimap-split-methods)
     (nnheader-message 7 "nnimap %s splitting mail..." server)
   (when (and (nnimap-possibly-change-group nil server)
             nnimap-inbox
             nnimap-split-methods)
     (nnheader-message 7 "nnimap %s splitting mail..." server)

-    (nnimap-split-incoming-mail)))
+    (nnimap-split-incoming-mail)
+    (nnheader-message 7 "nnimap %s splitting mail...done" server)))

 
 (defun nnimap-marks-to-flags (marks)
   (let (flags flag)
 
 (defun nnimap-marks-to-flags (marks)
   (let (flags flag)


@@ -963,6 +1004,7 @@ textual parts.")
     flags))
 
 (deffoo nnimap-request-update-group-status (group status &optional server)
     flags))
 
 (deffoo nnimap-request-update-group-status (group status &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (let ((command (assoc
                    status
   (when (nnimap-possibly-change-group nil server)
     (let ((command (assoc
                    status


@@ -973,6 +1015,7 @@ textual parts.")
          (nnimap-command "%s %S" (cadr command) (utf7-encode group t)))))))
 
 (deffoo nnimap-request-set-mark (group actions &optional server)
          (nnimap-command "%s %S" (cadr command) (utf7-encode group t)))))))
 
 (deffoo nnimap-request-set-mark (group actions &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group group server)
     (let (sequence)
       (with-current-buffer (nnimap-buffer)
   (when (nnimap-possibly-change-group group server)
     (let (sequence)
       (with-current-buffer (nnimap-buffer)


@@ -992,11 +1035,12 @@ textual parts.")
                                 ((eq action 'set) ""))
                                (mapconcat #'identity flags " ")))))))
        ;; Wait for the last command to complete to avoid later
                                 ((eq action 'set) ""))
                                (mapconcat #'identity flags " ")))))))
        ;; Wait for the last command to complete to avoid later

-       ;; syncronisation problems with the stream.
+       ;; synchronization problems with the stream.

        (when sequence
          (nnimap-wait-for-response sequence))))))
 
 (deffoo nnimap-request-accept-article (group &optional server last)
        (when sequence
          (nnimap-wait-for-response sequence))))))
 
 (deffoo nnimap-request-accept-article (group &optional server last)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (nnmail-check-syntax)
     (let ((message-id (message-field-value "message-id"))
   (when (nnimap-possibly-change-group nil server)
     (nnmail-check-syntax)
     (let ((message-id (message-field-value "message-id"))


@@ -1073,6 +1117,7 @@ textual parts.")
     result))
 
 (deffoo nnimap-request-replace-article (article group buffer)
     result))
 
 (deffoo nnimap-request-replace-article (article group buffer)

+  (setq group (nnimap-decode-gnus-group group))

   (let (group-art)
     (when (and (nnimap-possibly-change-group group nil)
               ;; Put the article into the group.
   (let (group-art)
     (when (and (nnimap-possibly-change-group group nil)
               ;; Put the article into the group.


@@ -1103,9 +1148,9 @@ textual parts.")
            (separator (read (current-buffer)))
            (group (read (current-buffer))))
        (unless (member '%NoSelect flags)
            (separator (read (current-buffer)))
            (group (read (current-buffer))))
        (unless (member '%NoSelect flags)

-         (push (if (stringp group)
-                   group
-                 (format "%s" group))
+         (push (utf7-decode (if (stringp group)
+                                group
+                              (format "%s" group)) t)

                groups))))
     (nreverse groups)))
 
                groups))))
     (nreverse groups)))
 


@@ -1164,7 +1209,7 @@ textual parts.")
                       (nnimap-get-groups)))
        (unless (assoc group nnimap-current-infos)
          ;; Insert dummy numbers here -- they don't matter.
                       (nnimap-get-groups)))
        (unless (assoc group nnimap-current-infos)
          ;; Insert dummy numbers here -- they don't matter.

-         (insert (format "%S 0 1 y\n" group))))
+         (insert (format "%S 0 1 y\n" (utf7-encode group)))))

       t)))
 
 (deffoo nnimap-retrieve-group-data-early (server infos)
       t)))
 
 (deffoo nnimap-retrieve-group-data-early (server infos)


@@ -1178,7 +1223,8 @@ textual parts.")
        ;; what and how to request the data.
        (dolist (info infos)
          (setq params (gnus-info-params info)
        ;; what and how to request the data.
        (dolist (info infos)
          (setq params (gnus-info-params info)

-               group (gnus-group-real-name (gnus-info-group info))
+               group (nnimap-decode-gnus-group
+                      (gnus-group-real-name (gnus-info-group info)))

                active (cdr (assq 'active params))
                uidvalidity (cdr (assq 'uidvalidity params))
                modseq (cdr (assq 'modseq params)))
                active (cdr (assq 'active params))
                uidvalidity (cdr (assq 'uidvalidity params))
                modseq (cdr (assq 'modseq params)))


@@ -1227,7 +1273,11 @@ textual parts.")
 
 (deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
   (when (and sequences
 
 (deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
   (when (and sequences

-            (nnimap-possibly-change-group nil server))
+            (nnimap-possibly-change-group nil server)
+            ;; Check that the process is still alive.
+            (get-buffer-process (nnimap-buffer))
+            (memq (process-status (get-buffer-process (nnimap-buffer)))
+                  '(open run)))

     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
       (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync)
     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
       (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync)


@@ -1250,13 +1300,15 @@ textual parts.")
                   (active (gnus-active group)))
              (when active
                (insert (format "%S %d %d y\n"
                   (active (gnus-active group)))
              (when active
                (insert (format "%S %d %d y\n"

-                               (gnus-group-real-name group)
+                               (decode-coding-string
+                                (gnus-group-real-name group) 'utf-8)

                                (cdr active)
                                (car active)))))))))))
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)
                                (cdr active)
                                (car active)))))))))))
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)

-    (let* ((group (gnus-group-real-name (gnus-info-group info)))
+    (let* ((group (nnimap-decode-gnus-group
+                  (gnus-group-real-name (gnus-info-group info))))

           (marks (cdr (assoc group flags))))
       (when marks
        (nnimap-update-info info marks)))))
           (marks (cdr (assoc group flags))))
       (when marks
        (nnimap-update-info info marks)))))


@@ -1280,7 +1332,8 @@ textual parts.")
             (cdr (assq 'uidvalidity (gnus-info-params info)))))
        (and old-uidvalidity
             (not (equal old-uidvalidity uidvalidity))
             (cdr (assq 'uidvalidity (gnus-info-params info)))))
        (and old-uidvalidity
             (not (equal old-uidvalidity uidvalidity))

-            (> start-article 1)))
+             (or (not start-article)
+                 (> start-article 1))))

       (gnus-group-remove-parameter info 'uidvalidity)
       (gnus-group-remove-parameter info 'modseq))
      ;; We have the data needed to update.
       (gnus-group-remove-parameter info 'uidvalidity)
       (gnus-group-remove-parameter info 'modseq))
      ;; We have the data needed to update.


@@ -1514,7 +1567,7 @@ textual parts.")
                 (goto-char start)
                 (setq vanished
                       (and (eq flag-sequence 'qresync)
                 (goto-char start)
                 (setq vanished
                       (and (eq flag-sequence 'qresync)

-                           (re-search-forward "^\\* VANISHED .* \\([0-9:,]+\\)"
+                           (re-search-forward "^\\* VANISHED .*? \\([0-9:,]+\\)"

                                               (or end (point-min)) t)
                            (match-string 1)))
                 (goto-char start)
                                               (or end (point-min)) t)
                            (match-string 1)))
                 (goto-char start)


@@ -1557,26 +1610,21 @@ textual parts.")
 (declare-function gnus-fetch-headers "gnus-sum"
                  (articles &optional limit force-new dependencies))
 
 (declare-function gnus-fetch-headers "gnus-sum"
                  (articles &optional limit force-new dependencies))
 

-(deffoo nnimap-request-thread (header)
-  (let* ((id (mail-header-id header))
-        (refs (split-string
-               (or (mail-header-references header)
-                   "")))
-        (cmd (let ((value
-                    (format
-                     "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
-                     id id)))
-               (dolist (refid refs value)
-                 (setq value (format
-                              "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
-                              refid refid value)))))
-        (result (with-current-buffer (nnimap-buffer)
-                  (nnimap-command  "UID SEARCH %s" cmd))))
-    (when result
-      (gnus-fetch-headers
-       (and (car result) (delete 0 (mapcar #'string-to-number
-                                          (cdr (assoc "SEARCH" (cdr result))))))
-       nil t))))
+(deffoo nnimap-request-thread (header &optional group server)
+  (when group
+    (setq group (nnimap-decode-gnus-group group)))
+  (if gnus-refer-thread-use-nnir
+      (nnir-search-thread header)
+    (when (nnimap-possibly-change-group group server)
+      (let* ((cmd (nnimap-make-thread-query header))
+             (result (with-current-buffer (nnimap-buffer)
+                       (nnimap-command  "UID SEARCH %s" cmd))))
+        (when result
+          (gnus-fetch-headers
+           (and (car result)
+               (delete 0 (mapcar #'string-to-number
+                                 (cdr (assoc "SEARCH" (cdr result))))))
+           nil t))))))

 
 (defun nnimap-possibly-change-group (group server)
   (let ((open-result t))
 
 (defun nnimap-possibly-change-group (group server)
   (let ((open-result t))


@@ -1686,7 +1734,8 @@ textual parts.")
                                      (looking-at "\\*"))))
                        (not (looking-at (format "%d .*\n" sequence)))))
            (when messagep
                                      (looking-at "\\*"))))
                        (not (looking-at (format "%d .*\n" sequence)))))
            (when messagep

-             (nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000)))
+             (nnheader-message-maybe
+              7 "nnimap read %dk" (/ (buffer-size) 1000)))

            (nnheader-accept-process-output process)
            (goto-char (point-max)))
           openp)
            (nnheader-accept-process-output process)
            (goto-char (point-max)))
           openp)


@@ -1798,9 +1847,14 @@ textual parts.")
 (defun nnimap-split-incoming-mail ()
   (with-current-buffer (nnimap-buffer)
     (let ((nnimap-incoming-split-list nil)
 (defun nnimap-split-incoming-mail ()
   (with-current-buffer (nnimap-buffer)
     (let ((nnimap-incoming-split-list nil)

-         (nnmail-split-methods (if (eq nnimap-split-methods 'default)
-                                   nnmail-split-methods
-                                 nnimap-split-methods))
+         (nnmail-split-methods
+          (cond
+           ((eq nnimap-split-methods 'default)
+            nnmail-split-methods)
+           (nnimap-split-methods
+            nnimap-split-methods)
+           (nnimap-split-fancy
+            'nnmail-split-fancy)))

          (nnmail-split-fancy (or nnimap-split-fancy
                                  nnmail-split-fancy))
          (nnmail-inhibit-default-split-group t)
          (nnmail-split-fancy (or nnimap-split-fancy
                                  nnmail-split-fancy))
          (nnmail-inhibit-default-split-group t)


@@ -1937,6 +1991,21 @@ textual parts.")
                  group-art))
          nnimap-incoming-split-list)))
 
                  group-art))
          nnimap-incoming-split-list)))
 

+(defun nnimap-make-thread-query (header)
+  (let* ((id  (mail-header-id header))
+        (refs (split-string
+               (or (mail-header-references header)
+                   "")))
+        (value
+         (format
+          "(OR HEADER REFERENCES %S HEADER Message-Id %S)"
+          id id)))
+    (dolist (refid refs value)
+      (setq value (format
+                  "(OR (OR HEADER Message-Id %S HEADER REFERENCES %S) %s)"
+                  refid refid value)))))
+
+

 (provide 'nnimap)
 
 ;;; nnimap.el ends here
 (provide 'nnimap)
 
 ;;; nnimap.el ends here