(gnus-summary-refer-thread): Implement a version that uses *-request-thread.
[gnus] / lisp / nnimap.el
index 99aee4c..2c3a38a 100644 (file)
 
 ;;; Code:
 
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
 (eval-and-compile
   (require 'nnheader))
 
@@ -284,6 +288,8 @@ textual parts.")
                        (* 5 60)))
            (nnimap-send-command "NOOP")))))))
 
+(declare-function gnutls-negotiate "subr" (fn file &optional arglist fileonly))
+
 (defun nnimap-open-connection (buffer)
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
@@ -312,11 +318,11 @@ textual parts.")
                 (setq port (or nnimap-server-port "imap")))
                '("imap"))
               ((eq nnimap-stream 'starttls)
-               (let ((tls-program (nnimap-extend-tls-programs)))
+               (let ((tls-program
+                      '("openssl s_client -connect %h:%p -no_ssl2 -ign_eof -starttls imap")))
                  (open-tls-stream
                   "*nnimap*" (current-buffer) nnimap-address
-                  (setq port (or nnimap-server-port "imap"))
-                  'starttls))
+                  (setq port (or nnimap-server-port "imap"))))
                '("imap"))
               ((memq nnimap-stream '(ssl tls))
                (funcall (if (fboundp 'open-gnutls-stream)
@@ -413,19 +419,6 @@ textual parts.")
                (nnimap-command "ENABLE QRESYNC"))
              (nnimap-process nnimap-object))))))))
 
-(defun nnimap-extend-tls-programs ()
-  (let ((programs tls-program)
-       result)
-    (unless (consp programs)
-      (setq programs (list programs)))
-    (dolist (program programs)
-      (when (assoc (car (split-string program)) tls-starttls-switches)
-       (push (if (not (string-match "%s" program))
-                 (concat program " " "%s")
-               program)
-             result)))
-    (nreverse result)))
-
 (defun nnimap-find-parameter (parameter elems)
   (let (result)
     (dolist (elem elems)
@@ -442,6 +435,7 @@ textual parts.")
   (when (nnoo-change-server 'nnimap server nil)
     (ignore-errors
       (delete-process (get-buffer-process (nnimap-buffer))))
+    (nnoo-close-server 'nnimap server)
     t))
 
 (deffoo nnimap-request-close ()
@@ -667,6 +661,12 @@ textual parts.")
 (deffoo nnimap-request-rename-group (group new-name &optional server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
+      ;; Make sure we don't have this group open read/write by asking
+      ;; to examine a mailbox that doesn't exist.  This seems to be
+      ;; the only way that allows us to reliably go back to unselected
+      ;; state on Courier.
+      (nnimap-command "EXAMINE DOES.NOT.EXIST")
+      (setf (nnimap-group nnimap-object) nil)
       (car (nnimap-command "RENAME %S %S"
                           (utf7-encode group t) (utf7-encode new-name t))))))
 
@@ -974,7 +974,8 @@ textual parts.")
                   modseq)
              (push
               (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
-                                         group uidvalidity modseq)
+                                         (utf7-encode group t)
+                                         uidvalidity modseq)
                     'qresync
                     nil group 'qresync)
               sequences)
@@ -992,7 +993,8 @@ textual parts.")
                     ;; examine), but will tell us whether the group
                     ;; is read-only or not.
                     "SELECT")))
-             (push (list (nnimap-send-command "%s %S" command group)
+             (push (list (nnimap-send-command "%s %S" command
+                                              (utf7-encode group t))
                          (nnimap-send-command "UID FETCH %d:* FLAGS" start)
                          start group command)
                    sequences)))
@@ -1066,8 +1068,8 @@ textual parts.")
       (let* ((group (gnus-info-group info))
             (completep (and start-article
                             (= start-article 1)))
-            (active (or (cdr (assq 'active (gnus-info-params info)))
-                        (gnus-active group))))
+            (active (or (gnus-active group)
+                        (cdr (assq 'active (gnus-info-params info))))))
        (when uidnext
          (setq high (1- uidnext)))
        ;; First set the active ranges based on high/low.
@@ -1157,8 +1159,12 @@ textual parts.")
   ;; Add all the vanished articles to the list of read articles.
   (gnus-info-set-read
    info
-   (gnus-range-add (gnus-info-read info)
-                  vanished))
+   (gnus-add-to-range
+    (gnus-add-to-range
+     (gnus-range-add (gnus-info-read info)
+                    vanished)
+     (cdr (assq '%Flagged flags)))
+    (cdr (assq '%Seen flags))))
   (let ((marks (gnus-info-marks info)))
     (dolist (type (cdr nnimap-mark-alist))
       (let ((ticks (assoc (car type) marks))
@@ -1285,7 +1291,7 @@ textual parts.")
                (setq start end))
            (setq start (point))
            (goto-char end))
-         (while (search-forward " FETCH " start t)
+         (while (re-search-forward "^\\* [0-9]+ FETCH " start t)
            (setq elems (read (current-buffer)))
            (push (cons (cadr (memq 'UID elems))
                        (cadr (memq 'FLAGS elems)))
@@ -1305,6 +1311,25 @@ textual parts.")
   (setq nnimap-status-string "Read-only server")
   nil)
 
+(deffoo nnimap-request-thread (id)
+    (let* ((refs (split-string
+              (or (mail-header-references (gnus-summary-article-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))))
+      (gnus-fetch-headers (and (car result)
+          (delete 0 (mapcar #'string-to-number
+                            (cdr (assoc "SEARCH" (cdr result)))))))))
+
 (defun nnimap-possibly-change-group (group server)
   (let ((open-result t))
     (when (and server
@@ -1621,8 +1646,10 @@ textual parts.")
        (forward-char (1+ bytes))
        (setq bytes (nnimap-get-length))
        (delete-region (line-beginning-position) (line-end-position))
-       (forward-char (1+ bytes))
-       (delete-region (line-beginning-position) (line-end-position))))))
+       ;; There's a body; skip past that.
+       (when bytes
+         (forward-char (1+ bytes))
+         (delete-region (line-beginning-position) (line-end-position)))))))
 
 (defun nnimap-dummy-active-number (group &optional server)
   1)