(nnimap-transform-headers): Unfold quoted {42} headers.

[gnus] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 4c3eaac..f927a86 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -32,7 +32,12 @@
 (eval-when-compile
   (require 'cl))
 
 (eval-when-compile
   (require 'cl))
 

+(require 'nnheader)
+(require 'gnus-util)
+(require 'gnus)
+(require 'nnoo)

 (require 'netrc)
 (require 'netrc)

+(require 'parse-time)

 
 (nnoo-declare nnimap)
 
 
 (nnoo-declare nnimap)
 


@@ -46,7 +51,7 @@ it will default to `imap'.")
 
 (defvoo nnimap-stream 'ssl
   "How nnimap will talk to the IMAP server.
 
 (defvoo nnimap-stream 'ssl
   "How nnimap will talk to the IMAP server.

-Values are `ssl' and `network'.")
+Values are `ssl', `network' or `shell'.")

 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)
 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)


@@ -57,11 +62,23 @@ Values are `ssl' and `network'.")
 (defvoo nnimap-inbox nil
   "The mail box where incoming mail arrives and should be split out of.")
 
 (defvoo nnimap-inbox nil
   "The mail box where incoming mail arrives and should be split out of.")
 

-(defvoo nnimap-expunge-inbox nil
-  "If non-nil, expunge the inbox after fetching mail.
+(defvoo nnimap-authenticator nil
+  "How nnimap authenticate itself to the server.
+Possible choices are nil (use default methods) or `anonymous'.")
+
+(defvoo nnimap-fetch-partial-articles nil
+  "If non-nil, nnimap will fetch partial articles.
+If t, nnimap will fetch only the first part.  If a string, it
+will fetch all parts that have types that match that string.  A
+likely value would be \"text/\" to automatically fetch all
+textual parts.")
+
+(defvoo nnimap-expunge t
+  "If non-nil, expunge articles after deleting them.

 This is always done if the server supports UID EXPUNGE, but it's
 not done by default on servers that doesn't support that command.")
 
 This is always done if the server supports UID EXPUNGE, but it's
 not done by default on servers that doesn't support that command.")
 

+

 (defvoo nnimap-connection-alist nil)
 
 (defvoo nnimap-current-infos nil)
 (defvoo nnimap-connection-alist nil)
 
 (defvoo nnimap-current-infos nil)


@@ -74,14 +91,14 @@ not done by default on servers that doesn't support that command.")
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap

-  group process commands capabilities select-result)
+  group process commands capabilities select-result newlinep server)

 
 (defvar nnimap-object nil)
 
 (defvar nnimap-mark-alist
 
 (defvar nnimap-object nil)
 
 (defvar nnimap-mark-alist

-  '((read "\\Seen")
-    (tick "\\Flagged")
-    (reply "\\Answered")
+  '((read "\\Seen" %Seen)
+    (tick "\\Flagged" %Flagged)
+    (reply "\\Answered" %Answered)

     (expire "gnus-expire")
     (dormant "gnus-dormant")
     (score "gnus-score")
     (expire "gnus-expire")
     (dormant "gnus-dormant")
     (score "gnus-score")


@@ -122,19 +139,33 @@ not done by default on servers that doesn't support that command.")
 
 (defun nnimap-transform-headers ()
   (goto-char (point-min))
 
 (defun nnimap-transform-headers ()
   (goto-char (point-min))

-  (let (article bytes lines)
+  (let (article bytes lines size string)

     (block nil
       (while (not (eobp))
        (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))
     (block nil
       (while (not (eobp))
        (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))

-       (setq article (match-string 1)
-             bytes (nnimap-get-length)
+       (setq article (match-string 1))
+       ;; Unfold quoted {number} strings.
+       (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n"
+                                 (1+ (line-end-position)) t)
+         (setq size (string-to-number (match-string 1)))
+         (delete-region (+ (match-beginning 0) 2) (point))
+         (setq string (delete-region (point) (+ (point) size)))
+         (insert (format "%S" string)))
+       (setq bytes (nnimap-get-length)

              lines nil)
        (beginning-of-line)
              lines nil)
        (beginning-of-line)

+       (setq size
+             (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
+                                     (line-end-position)
+                                     t)
+                  (match-string 1)))
+       (beginning-of-line)

        (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
        (when (search-forward "BODYSTRUCTURE" (line-end-position) t)

-         (let ((structure (ignore-errors (read (current-buffer)))))
+         (let ((structure (ignore-errors
+                            (read (current-buffer)))))

            (while (and (consp structure)
                        (not (stringp (car structure))))
              (setq structure (car structure)))
            (while (and (consp structure)
                        (not (stringp (car structure))))
              (setq structure (car structure)))


@@ -142,7 +173,8 @@ not done by default on servers that doesn't support that command.")
        (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)

-       (insert (format "Bytes: %d\n" bytes))
+       (when size
+         (insert (format "Chars: %s\n" size)))

        (when lines
          (insert (format "Lines: %s\n" lines)))
        (re-search-forward "^\r$")
        (when lines
          (insert (format "Lines: %s\n" lines)))
        (re-search-forward "^\r$")


@@ -188,21 +220,22 @@ not done by default on servers that doesn't support that command.")
     (buffer-disable-undo)
     (gnus-add-buffer)
     (set (make-local-variable 'after-change-functions) nil)
     (buffer-disable-undo)
     (gnus-add-buffer)
     (set (make-local-variable 'after-change-functions) nil)

-    (set (make-local-variable 'nnimap-object) (make-nnimap))
+    (set (make-local-variable 'nnimap-object)
+        (make-nnimap :server (nnoo-current-server 'nnimap)))

     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (current-buffer)))
 
 (defun nnimap-open-shell-stream (name buffer host port)
     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (current-buffer)))
 
 (defun nnimap-open-shell-stream (name buffer host port)

-  (let ((process (start-process name buffer shell-file-name
-                               shell-command-switch
-                               (format-spec
-                                nnimap-shell-program
-                                (format-spec-make
-                                 ?s host
-                                 ?p port)))))
-    process))
-
-(defun nnimap-credentials (address &rest ports)
+  (let ((process-connection-type nil))
+    (start-process name buffer shell-file-name
+                  shell-command-switch
+                  (format-spec
+                   nnimap-shell-program
+                   (format-spec-make
+                    ?s host
+                    ?p port)))))
+
+(defun nnimap-credentials (address ports)

   (let (port credentials)
     ;; Request the credentials from all ports, but only query on the
     ;; last port if all the previous ones have failed.
   (let (port credentials)
     ;; Request the credentials from all ports, but only query on the
     ;; last port if all the previous ones have failed.


@@ -217,45 +250,59 @@ not done by default on servers that doesn't support that command.")
   (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)

-          (credentials
+          (ports

            (cond
             ((eq nnimap-stream 'network)
            (cond
             ((eq nnimap-stream 'network)

-             (open-network-stream "*nnimap*" (current-buffer) nnimap-address
-                                  (or nnimap-server-port
-                                      (if (netrc-find-service-number "imap")
-                                          "imap"
-                                        "143")))
-             (nnimap-credentials nnimap-address "143" "imap"))
-            ((eq nnimap-stream 'stream)
+             (open-network-stream
+              "*nnimap*" (current-buffer) nnimap-address
+              (or nnimap-server-port
+                  (if (netrc-find-service-number "imap")
+                      "imap"
+                    "143")))
+             '("143" "imap"))
+            ((eq nnimap-stream 'shell)

              (nnimap-open-shell-stream
               "*nnimap*" (current-buffer) nnimap-address
               (or nnimap-server-port "imap"))
              (nnimap-open-shell-stream
               "*nnimap*" (current-buffer) nnimap-address
               (or nnimap-server-port "imap"))

-             (nnimap-credentials nnimap-address "imap"))
+             '("imap"))

             ((eq nnimap-stream 'ssl)
             ((eq nnimap-stream 'ssl)

-             (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
-                              (or nnimap-server-port
-                                  (if (netrc-find-service-number "imaps")
-                                      "imaps"
-                                    "993")))
-             (nnimap-credentials nnimap-address "143" "993" "imap" "imaps")))))
+             (open-tls-stream
+              "*nnimap*" (current-buffer) nnimap-address
+              (or nnimap-server-port
+                  (if (netrc-find-service-number "imaps")
+                      "imaps"
+                    "993")))
+             '("143" "993" "imap" "imaps"))))
+          connection-result login-result credentials)

       (setf (nnimap-process nnimap-object)
            (get-buffer-process (current-buffer)))
       (setf (nnimap-process nnimap-object)
            (get-buffer-process (current-buffer)))

-      (unless credentials
-       (delete-process (nnimap-process nnimap-object)))

       (when (and (nnimap-process nnimap-object)
                 (memq (process-status (nnimap-process nnimap-object))
                       '(open run)))
        (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
       (when (and (nnimap-process nnimap-object)
                 (memq (process-status (nnimap-process nnimap-object))
                       '(open run)))
        (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)

-       (let ((result (nnimap-command "LOGIN %S %S"
-                                     (car credentials) (cadr credentials))))
-         (if (not (car result))
-             (progn
+       (when (setq connection-result (nnimap-wait-for-connection))
+         (unless (equal connection-result "PREAUTH")
+           (if (not (setq credentials
+                          (if (eq nnimap-authenticator 'anonymous)
+                              (list "anonymous"
+                                    (message-make-address))
+                            (nnimap-credentials
+                             nnimap-address
+                             (if nnimap-server-port
+                                 (cons (format "%s" nnimap-server-port) ports)
+                               ports)))))
+               (setq nnimap-object nil)
+             (setq login-result (nnimap-command "LOGIN %S %S"
+                                                (car credentials)
+                                                (cadr credentials)))
+             (unless (car login-result)

                (delete-process (nnimap-process nnimap-object))
                (delete-process (nnimap-process nnimap-object))

-               nil)
+               (setq nnimap-object nil))))
+         (when nnimap-object

            (setf (nnimap-capabilities nnimap-object)
                  (mapcar
                   #'upcase
            (setf (nnimap-capabilities nnimap-object)
                  (mapcar
                   #'upcase

-                  (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+                  (or (nnimap-find-parameter "CAPABILITY" (cdr login-result))

                       (nnimap-find-parameter
                        "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
            (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
                       (nnimap-find-parameter
                        "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
            (when (member "QRESYNC" (nnimap-capabilities nnimap-object))


@@ -291,7 +338,8 @@ not done by default on servers that doesn't support that command.")
 
 (deffoo nnimap-request-article (article &optional group server to-buffer)
   (with-current-buffer nntp-server-buffer
 
 (deffoo nnimap-request-article (article &optional group server to-buffer)
   (with-current-buffer nntp-server-buffer

-    (let ((result (nnimap-possibly-change-group group server)))
+    (let ((result (nnimap-possibly-change-group group server))
+         parts)

       (when (stringp article)
        (setq article (nnimap-find-article-by-message-id group article)))
       (when (and result
       (when (stringp article)
        (setq article (nnimap-find-article-by-message-id group article)))
       (when (and result


@@ -299,15 +347,27 @@ not done by default on servers that doesn't support that command.")
        (erase-buffer)
        (with-current-buffer (nnimap-buffer)
          (erase-buffer)
        (erase-buffer)
        (with-current-buffer (nnimap-buffer)
          (erase-buffer)

+         (when nnimap-fetch-partial-articles
+           (if (eq nnimap-fetch-partial-articles t)
+               (setq parts '(1))
+             (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
+             (goto-char (point-min))
+             (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
+               (let ((structure (ignore-errors (read (current-buffer)))))
+                 (setq parts (nnimap-find-wanted-parts structure))))))

          (setq result
                (nnimap-command
                 (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
                     "UID FETCH %d BODY.PEEK[]"
                   "UID FETCH %d RFC822.PEEK")
          (setq result
                (nnimap-command
                 (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
                     "UID FETCH %d BODY.PEEK[]"
                   "UID FETCH %d RFC822.PEEK")

-                article)))
+                article))
+         ;; Check that we really got an article.
+         (goto-char (point-min))
+         (unless (looking-at "\\* [0-9]+ FETCH")
+           (setq result nil)))

        (let ((buffer (nnimap-find-process-buffer (current-buffer))))
          (when (car result)
        (let ((buffer (nnimap-find-process-buffer (current-buffer))))
          (when (car result)

-           (with-current-buffer to-buffer
+           (with-current-buffer (or to-buffer nntp-server-buffer)

              (insert-buffer-substring buffer)
              (goto-char (point-min))
              (let ((bytes (nnimap-get-length)))
              (insert-buffer-substring buffer)
              (goto-char (point-min))
              (let ((bytes (nnimap-get-length)))


@@ -316,12 +376,35 @@ not done by default on servers that doesn't support that command.")
                (goto-char (+ (point) bytes))
                (delete-region (point) (point-max))
                (nnheader-ms-strip-cr))
                (goto-char (+ (point) bytes))
                (delete-region (point) (point-max))
                (nnheader-ms-strip-cr))

-             t)))))))
+             (cons group article))))))))
+
+(defun nnimap-find-wanted-parts (structure)
+  (message-flatten-list (nnimap-find-wanted-parts-1 structure "")))
+
+(defun nnimap-find-wanted-parts-1 (structure prefix)
+  (let ((num 1)
+       parts)
+    (while (consp (car structure))
+      (let ((sub (pop structure)))
+       (if (consp (car sub))
+           (push (nnimap-find-wanted-parts-1
+                  sub (if (string= prefix "")
+                          (number-to-string num)
+                        (format "%s.%s" prefix num)))
+                 parts)
+         (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))))
+           (when (string-match nnimap-fetch-partial-articles type)
+             (push (if (string= prefix "")
+                       (number-to-string num)
+                     (format "%s.%s" prefix num))
+                   parts)))
+         (incf num))))
+    (nreverse parts)))

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

-  (with-current-buffer nntp-server-buffer
-    (let ((result (nnimap-possibly-change-group group server))
-         articles active marks)
+  (let ((result (nnimap-possibly-change-group group server))
+       articles active marks high low)
+    (with-current-buffer nntp-server-buffer

       (when result
        (if (and dont-check
                 (setq active (nth 2 (assoc group nnimap-current-infos))))
       (when result
        (if (and dont-check
                 (setq active (nth 2 (assoc group nnimap-current-infos))))


@@ -333,7 +416,7 @@ not done by default on servers that doesn't support that command.")
          (with-current-buffer (nnimap-buffer)
            (erase-buffer)
            (let ((group-sequence
          (with-current-buffer (nnimap-buffer)
            (erase-buffer)
            (let ((group-sequence

-                  (nnimap-send-command "SELECT %S" (utf7-encode group)))
+                  (nnimap-send-command "SELECT %S" (utf7-encode group t)))

                  (flag-sequence
                   (nnimap-send-command "UID FETCH 1:* FLAGS")))
              (nnimap-wait-for-response flag-sequence)
                  (flag-sequence
                   (nnimap-send-command "UID FETCH 1:* FLAGS")))
              (nnimap-wait-for-response flag-sequence)


@@ -342,17 +425,34 @@ not done by default on servers that doesn't support that command.")
                     (nnimap-parse-flags
                      (list (list group-sequence flag-sequence 1 group)))))
              (when info
                     (nnimap-parse-flags
                      (list (list group-sequence flag-sequence 1 group)))))
              (when info

-               (nnimap-update-infos marks (list info)))))
+               (nnimap-update-infos marks (list info)))
+             (goto-char (point-max))
+             (let ((uidnext (nth 5 (car marks))))
+               (setq high (if uidnext
+                              (1- uidnext)
+                            (nth 3 (car marks)))
+                     low (or (nth 4 (car marks)) uidnext)))))

          (erase-buffer)
          (erase-buffer)

-         (let ((high (nth 3 (car marks)))
-               (low (nth 4 (car marks))))
-           (insert
-            (format
-             "211 %d %d %d %S\n"
-             (1+ (- high low))
-             low high group))))
+         (insert
+          (format
+           "211 %d %d %d %S\n" (1+ (- high low)) low high group)))

        t))))
 
        t))))
 

+(deffoo nnimap-request-create-group (group &optional server args)
+  (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 "DELETE %S" (utf7-encode group t))))))
+
+(deffoo nnimap-request-expunge-group (group &optional server)
+  (when (nnimap-possibly-change-group group server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "EXPUNGE")))))
+

 (defun nnimap-get-flags (spec)
   (let ((articles nil)
        elems)
 (defun nnimap-get-flags (spec)
   (let ((articles nil)
        elems)


@@ -373,22 +473,23 @@ not done by default on servers that doesn't support that command.")
 
 (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)

-  (when (nnimap-possibly-change-group group server)
-    ;; If the move is internal (on the same server), just do it the easy
-    ;; way.
-    (let ((message-id (message-field-value "message-id")))
-      (if internal-move-group
-         (let ((result
-                (with-current-buffer (nnimap-buffer)
-                  (nnimap-command "UID COPY %d %S"
-                                  article
-                                  (utf7-encode internal-move-group t)))))
-           (when (car result)
-             (nnimap-delete-article article)
-             (cons internal-move-group
-                   (nnimap-find-article-by-message-id
-                    internal-move-group message-id))))
-       (with-temp-buffer
+  (with-temp-buffer
+    (when (nnimap-request-article article group server (current-buffer))
+      ;; If the move is internal (on the same server), just do it the easy
+      ;; way.
+      (let ((message-id (message-field-value "message-id")))
+       (if internal-move-group
+           (let ((result
+                  (with-current-buffer (nnimap-buffer)
+                    (nnimap-command "UID COPY %d %S"
+                                    article
+                                    (utf7-encode internal-move-group t)))))
+             (when (car result)
+               (nnimap-delete-article article)
+               (cons internal-move-group
+                     (nnimap-find-article-by-message-id
+                      internal-move-group message-id))))
+         ;; Move the article to a different method.

          (let ((result (eval accept-form)))
            (when result
              (nnimap-delete-article article)
          (let ((result (eval accept-form)))
            (when result
              (nnimap-delete-article article)


@@ -396,14 +497,72 @@ not done by default on servers that doesn't support that command.")
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
   (cond
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
   (cond

+   ((null articles)
+    nil)

    ((not (nnimap-possibly-change-group group server))
     articles)
    ((not (nnimap-possibly-change-group group server))
     articles)

-   (force
+   ((and force
+        (eq nnmail-expiry-target 'delete))

     (unless (nnimap-delete-article articles)
       (message "Article marked for deletion, but not expunged."))
     nil)
    (t
     (unless (nnimap-delete-article articles)
       (message "Article marked for deletion, but not expunged."))
     nil)
    (t

-    articles)))
+    (let ((deletable-articles
+          (if (or force
+                  (eq nnmail-expiry-wait 'immediate))
+              articles
+            (gnus-sorted-intersection
+             articles
+             (nnimap-find-expired-articles group)))))
+      (if (null deletable-articles)
+         articles
+       (if (eq nnmail-expiry-target 'delete)
+           (nnimap-delete-article deletable-articles)
+         (setq deletable-articles
+               (nnimap-process-expiry-targets
+                deletable-articles group server)))
+       ;; Return the articles we didn't delete.
+       (gnus-sorted-complement articles deletable-articles))))))
+
+(defun nnimap-process-expiry-targets (articles group server)
+  (let ((deleted-articles nil))
+    (dolist (article articles)
+      (let ((target nnmail-expiry-target))
+       (with-temp-buffer
+         (when (nnimap-request-article article group server (current-buffer))
+           (message "Expiring article %s:%d" group article)
+           (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)))
+           (when target
+             (push article deleted-articles))))))
+    ;; Change back to the current group again.
+    (nnimap-possibly-change-group group server)
+    (setq deleted-articles (nreverse deleted-articles))
+    (nnimap-delete-article deleted-articles)
+    deleted-articles))
+
+(defun nnimap-find-expired-articles (group)
+  (let ((cutoff (nnmail-expired-article-p group nil nil)))
+    (with-current-buffer (nnimap-buffer)
+      (let ((result
+            (nnimap-command
+             "UID SEARCH SENTBEFORE %s"
+             (format-time-string
+              (format "%%d-%s-%%Y"
+                      (upcase
+                       (car (rassoc (nth 4 (decode-time cutoff))
+                                    parse-time-months))))
+              cutoff))))
+       (and (car result)
+            (delete 0 (mapcar #'string-to-number
+                              (cdr (assoc "SEARCH" (cdr result))))))))))
+

 
 (defun nnimap-find-article-by-message-id (group message-id)
   (when (nnimap-possibly-change-group group nil)
 
 (defun nnimap-find-article-by-message-id (group message-id)
   (when (nnimap-possibly-change-group group nil)


@@ -421,16 +580,23 @@ not done by default on servers that doesn't support that command.")
   (with-current-buffer (nnimap-buffer)
     (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)"
                    (nnimap-article-ranges articles))
   (with-current-buffer (nnimap-buffer)
     (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)"
                    (nnimap-article-ranges articles))

-    (when (member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s"
-                          (nnimap-article-ranges articles))
-      t)))
+    (cond
+     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+      (nnimap-command "UID EXPUNGE %s"
+                     (nnimap-article-ranges articles))
+      t)
+     (nnimap-expunge
+      (nnimap-command "EXPUNGE")
+      t)
+     (t (gnus-message 7 (concat "nnimap: nnimap-expunge is not set and the "
+                                "server doesn't support UIDPLUS, so we won't "
+                                "delete this article now"))))))

 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)
 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)

-            (equal group nnimap-inbox)

             nnimap-inbox
             nnimap-split-methods)
             nnimap-inbox
             nnimap-split-methods)

+    (message "nnimap %s splitting mail..." server)

     (nnimap-split-incoming-mail)))
 
 (defun nnimap-marks-to-flags (marks)
     (nnimap-split-incoming-mail)))
 
 (defun nnimap-marks-to-flags (marks)


@@ -459,7 +625,8 @@ not done by default on servers that doesn't support that command.")
                                (mapconcat #'identity flags " ")))))))
        ;; Wait for the last command to complete to avoid later
        ;; syncronisation problems with the stream.
                                (mapconcat #'identity flags " ")))))))
        ;; Wait for the last command to complete to avoid later
        ;; syncronisation problems with the stream.

-       (nnimap-wait-for-response sequence)))))
+       (when sequence
+         (nnimap-wait-for-response sequence))))))

 
 (deffoo nnimap-request-accept-article (group &optional server last)
   (when (nnimap-possibly-change-group nil server)
 
 (deffoo nnimap-request-accept-article (group &optional server last)
   (when (nnimap-possibly-change-group nil server)


@@ -472,7 +639,10 @@ not done by default on servers that doesn't support that command.")
                        "APPEND %S {%d}" (utf7-encode group t)
                        (length message)))
        (process-send-string (get-buffer-process (current-buffer)) message)
                        "APPEND %S {%d}" (utf7-encode group t)
                        (length message)))
        (process-send-string (get-buffer-process (current-buffer)) message)

-       (process-send-string (get-buffer-process (current-buffer)) "\r\n")
+       (process-send-string (get-buffer-process (current-buffer))
+                            (if (nnimap-newlinep nnimap-object)
+                                "\n"
+                              "\r\n"))

        (let ((result (nnimap-get-response sequence)))
          (when result
            (cons group
        (let ((result (nnimap-get-response sequence)))
          (when result
            (cons group


@@ -504,6 +674,7 @@ not done by default on servers that doesn't support that command.")
          sequences responses)
       (when groups
        (with-current-buffer (nnimap-buffer)
          sequences responses)
       (when groups
        (with-current-buffer (nnimap-buffer)

+         (setf (nnimap-group nnimap-object) nil)

          (dolist (group groups)
            (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
                        group)
          (dolist (group groups)
            (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
                        group)


@@ -553,6 +724,7 @@ not done by default on servers that doesn't support that command.")
                groups))
        ;; Then request the data.
        (erase-buffer)
                groups))
        ;; Then request the data.
        (erase-buffer)

+       (setf (nnimap-group nnimap-object) nil)

        (dolist (elem groups)
          (if (and qresyncp
                   (nth 2 elem))
        (dolist (elem groups)
          (if (and qresyncp
                   (nth 2 elem))


@@ -589,7 +761,19 @@ not done by default on servers that doesn't support that command.")
       (nnimap-update-infos (nnimap-flags-to-marks
                            (nnimap-parse-flags
                             (nreverse sequences)))
       (nnimap-update-infos (nnimap-flags-to-marks
                            (nnimap-parse-flags
                             (nreverse sequences)))

-                          infos))))
+                          infos)
+      ;; Finally, just return something resembling an active file in
+      ;; the nntp buffer, so that the agent can save the info, too.
+      (with-current-buffer nntp-server-buffer
+       (erase-buffer)
+       (dolist (info infos)
+         (let* ((group (gnus-info-group info))
+                (active (gnus-active group)))
+           (when active
+             (insert (format "%S %d %d y\n"
+                             (gnus-group-real-name group)
+                             (cdr active)
+                             (car active))))))))))

 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)


@@ -598,35 +782,42 @@ not done by default on servers that doesn't support that command.")
 
 (defun nnimap-update-info (info marks)
   (when marks
 
 (defun nnimap-update-info (info marks)
   (when marks

-    (destructuring-bind (existing flags high low uidnext start-article) marks
+    (destructuring-bind (existing flags high low uidnext start-article
+                                 permanent-flags) marks

       (let ((group (gnus-info-group info))
            (completep (and start-article
                            (= start-article 1))))
       (let ((group (gnus-info-group info))
            (completep (and start-article
                            (= start-article 1))))

+       (when uidnext
+         (setq high (1- uidnext)))

        ;; First set the active ranges based on high/low.
        (if (or completep
                (not (gnus-active group)))
            (gnus-set-active group
        ;; First set the active ranges based on high/low.
        (if (or completep
                (not (gnus-active group)))
            (gnus-set-active group

-                            (if high
+                            (if (and low high)

                                 (cons low high)
                               ;; No articles in this group.
                                 (cons low high)
                               ;; No articles in this group.

-                              (cons (1- uidnext) uidnext)))
-         (setcdr (gnus-active group) high))
+                              (cons uidnext (1- uidnext))))
+         (setcdr (gnus-active group) (or high (1- uidnext))))
+       (unless high
+         (setq high (1- uidnext)))

        ;; Then update the list of read articles.
        (let* ((unread
                (gnus-compress-sequence
                 (gnus-set-difference
                  (gnus-set-difference
                   existing
        ;; Then update the list of read articles.
        (let* ((unread
                (gnus-compress-sequence
                 (gnus-set-difference
                  (gnus-set-difference
                   existing

-                  (cdr (assoc "\\Seen" flags)))
-                 (cdr (assoc "\\Flagged" flags)))))
+                  (cdr (assoc '%Seen flags)))
+                 (cdr (assoc '%Flagged flags)))))

               (read (gnus-range-difference
                      (cons start-article high) unread)))
          (when (> start-article 1)
            (setq read
                  (gnus-range-nconcat
               (read (gnus-range-difference
                      (cons start-article high) unread)))
          (when (> start-article 1)
            (setq read
                  (gnus-range-nconcat

-                  (gnus-sorted-range-intersection
-                   (cons 1 start-article)
-                   (gnus-info-read info))
+                  (if (> start-article 1)
+                      (gnus-sorted-range-intersection
+                       (cons 1 (1- start-article))
+                       (gnus-info-read info))
+                    (gnus-info-read info))

                   read)))
          (gnus-info-set-read info read)
          ;; Update the marks.
                   read)))
          (gnus-info-set-read info read)
          ;; Update the marks.


@@ -638,19 +829,22 @@ not done by default on servers that doesn't support that command.")
              (push (cons 'active (gnus-active group)) marks)))
          (dolist (type (cdr nnimap-mark-alist))
            (let ((old-marks (assoc (car type) marks))
              (push (cons 'active (gnus-active group)) marks)))
          (dolist (type (cdr nnimap-mark-alist))
            (let ((old-marks (assoc (car type) marks))

-                 (new-marks (gnus-compress-sequence
-                             (cdr (assoc (cadr type) flags)))))
+                 (new-marks
+                  (gnus-compress-sequence
+                   (cdr (or (assoc (caddr type) flags)     ; %Flagged
+                            (assoc (intern (cadr type) obarray) flags)
+                            (assoc (cadr type) flags)))))) ; "\Flagged"

              (setq marks (delq old-marks marks))
              (pop old-marks)
              (when (and old-marks
                         (> start-article 1))
                (setq old-marks (gnus-range-difference
              (setq marks (delq old-marks marks))
              (pop old-marks)
              (when (and old-marks
                         (> start-article 1))
                (setq old-marks (gnus-range-difference

-                                (cons start-article high)
-                                old-marks))
+                                old-marks
+                                (cons start-article high)))

                (setq new-marks (gnus-range-nconcat old-marks new-marks)))
              (when new-marks
                (push (cons (car type) new-marks) marks)))
                (setq new-marks (gnus-range-nconcat old-marks new-marks)))
              (when new-marks
                (push (cons (car type) new-marks) marks)))

-           (gnus-info-set-marks info marks)
+           (gnus-info-set-marks info marks t)

            (nnimap-store-info info (gnus-active group))))))))
 
 (defun nnimap-store-info (info active)
            (nnimap-store-info info (gnus-active group))))))))
 
 (defun nnimap-store-info (info active)


@@ -661,12 +855,13 @@ not done by default on servers that doesn't support that command.")
       (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)
       (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)

-  (let (data group totalp uidnext articles start-article mark)
+  (let (data group totalp uidnext articles start-article mark permanent-flags)

     (dolist (elem groups)
       (setq group (car elem)
     (dolist (elem groups)
       (setq group (car elem)

-           uidnext (cadr elem)
-           start-article (caddr elem)
-           articles (cdddr elem))
+           uidnext (nth 1 elem)
+           start-article (nth 2 elem)
+           permanent-flags (nth 3 elem)
+           articles (nthcdr 4 elem))

       (let ((high (caar articles))
            marks low existing)
        (dolist (article articles)
       (let ((high (caar articles))
            marks low existing)
        (dolist (article articles)


@@ -676,36 +871,49 @@ not done by default on servers that doesn't support that command.")
            (setq mark (assoc flag marks))
            (if (not mark)
                (push (list flag (car article)) marks)
            (setq mark (assoc flag marks))
            (if (not mark)
                (push (list flag (car article)) marks)

-             (setcdr mark (cons (car article) (cdr mark)))))
-         (push (list group existing marks high low uidnext start-article)
-               data))))
+             (setcdr mark (cons (car article) (cdr mark))))))
+       (push (list group existing marks high low uidnext start-article
+                   permanent-flags)
+             data)))

     data))
 
 (defun nnimap-parse-flags (sequences)
   (goto-char (point-min))
     data))
 
 (defun nnimap-parse-flags (sequences)
   (goto-char (point-min))

-  (let (start end articles groups uidnext elems)
+  ;; Change \Delete etc to %Delete, so that the reader can read it.
+  (subst-char-in-region (point-min) (point-max)
+                       ?\\ ?% t)
+  (let (start end articles groups uidnext elems permanent-flags)

     (dolist (elem sequences)
       (destructuring-bind (group-sequence flag-sequence totalp group) elem
     (dolist (elem sequences)
       (destructuring-bind (group-sequence flag-sequence totalp group) elem

+       (setq start (point))

        ;; The EXAMINE was successful.
        (when (and (search-forward (format "\n%d OK " group-sequence) nil t)
                   (progn
                     (forward-line 1)
        ;; The EXAMINE was successful.
        (when (and (search-forward (format "\n%d OK " group-sequence) nil t)
                   (progn
                     (forward-line 1)

-                    (setq start (point))
-                    (if (re-search-backward "UIDNEXT \\([0-9]+\\)"
-                                              (or end (point-min)) t)
-                        (setq uidnext (string-to-number (match-string 1)))
-                      (setq uidnext nil))
-                    (goto-char start))
+                    (setq end (point))
+                    (goto-char start)
+                    (setq permanent-flags
+                          (and (search-forward "PERMANENTFLAGS "
+                                                (or end (point-min)) t)
+                               (read (current-buffer))))
+                    (goto-char start)
+                    (setq uidnext
+                          (and (search-forward "UIDNEXT "
+                                                (or end (point-min)) t)
+                               (read (current-buffer))))
+                    (goto-char end)
+                    (forward-line -1))

                   ;; The UID FETCH FLAGS was successful.
                   (search-forward (format "\n%d OK " flag-sequence) nil t))
                   ;; The UID FETCH FLAGS was successful.
                   (search-forward (format "\n%d OK " flag-sequence) nil t))

-         (setq end (point))
-         (goto-char start)
-         (while (re-search-forward "^\\* [0-9]+ FETCH (\\(.*\\))" end t)
-           (setq elems (nnimap-parse-line (match-string 1)))
-           (push (cons (string-to-number (cadr (member "UID" elems)))
-                       (cadr (member "FLAGS" elems)))
+         (setq start (point))
+         (goto-char end)
+         (while (search-forward " FETCH " start t)
+           (setq elems (read (current-buffer)))
+           (push (cons (cadr (memq 'UID elems))
+                       (cadr (memq 'FLAGS elems)))

                  articles))
                  articles))

-         (push (nconc (list group uidnext totalp) articles) groups)
+         (push (nconc (list group uidnext totalp permanent-flags) articles)
+               groups)

          (setq articles nil))))
     groups))
 
          (setq articles nil))))
     groups))
 


@@ -754,9 +962,12 @@ not done by default on servers that doesn't support that command.")
   (process-send-string
    (get-buffer-process (current-buffer))
    (nnimap-log-command
   (process-send-string
    (get-buffer-process (current-buffer))
    (nnimap-log-command

-    (format "%d %s\r\n"
+    (format "%d %s%s\n"

            (incf nnimap-sequence)
            (incf nnimap-sequence)

-           (apply #'format args))))
+           (apply #'format args)
+           (if (nnimap-newlinep nnimap-object)
+               ""
+             "\r"))))

   nnimap-sequence)
 
 (defun nnimap-log-command (command)
   nnimap-sequence)
 
 (defun nnimap-log-command (command)


@@ -772,23 +983,39 @@ not done by default on servers that doesn't support that command.")
     (if (equal (caar response) "OK")
        (cons t response)
       (nnheader-report 'nnimap "%s"
     (if (equal (caar response) "OK")
        (cons t response)
       (nnheader-report 'nnimap "%s"

-                      (mapconcat #'identity (car response) " "))
+                      (mapconcat (lambda (a)
+                                   (format "%s" a))
+                                 (car response) " "))

       nil)))
 
 (defun nnimap-get-response (sequence)
   (nnimap-wait-for-response sequence)
   (nnimap-parse-response))
 
       nil)))
 
 (defun nnimap-get-response (sequence)
   (nnimap-wait-for-response sequence)
   (nnimap-parse-response))
 

+(defun nnimap-wait-for-connection ()
+  (let ((process (get-buffer-process (current-buffer))))
+    (goto-char (point-min))
+    (while (and (memq (process-status process)
+                     '(open run))
+               (not (re-search-forward "^\\* .*\n" nil t)))
+      (nnheader-accept-process-output process)
+      (goto-char (point-min)))
+    (forward-line -1)
+    (and (looking-at "\\* \\([A-Z0-9]+\\)")
+        (match-string 1))))
+

 (defun nnimap-wait-for-response (sequence &optional messagep)
 (defun nnimap-wait-for-response (sequence &optional messagep)

-  (goto-char (point-max))
-  (while (or (bobp)
-            (progn
-              (forward-line -1)
-              (not (looking-at (format "^%d .*\n" sequence)))))
-    (when messagep
-      (message "Read %dKB" (/ (buffer-size) 1000)))
-    (nnheader-accept-process-output (get-buffer-process (current-buffer)))
-    (goto-char (point-max))))
+  (let ((process (get-buffer-process (current-buffer))))
+    (goto-char (point-max))
+    (while (and (memq (process-status process)
+                     '(open run))
+               (not (re-search-backward (format "^%d .*\n" sequence)
+                                        (max (point-min) (- (point) 500))
+                                        t)))
+      (when messagep
+       (message "Read %dKB" (/ (buffer-size) 1000)))
+      (nnheader-accept-process-output process)
+      (goto-char (point-max)))))

 
 (defun nnimap-parse-response ()
   (let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
 
 (defun nnimap-parse-response ()
   (let ((lines (split-string (nnimap-last-response-string) "\r\n" t))


@@ -867,7 +1094,7 @@ not done by default on servers that doesn't support that command.")
                 "BODY.PEEK[HEADER] BODY.PEEK"
               "RFC822.PEEK"))
            (if nnimap-split-download-body-default
                 "BODY.PEEK[HEADER] BODY.PEEK"
               "RFC822.PEEK"))
            (if nnimap-split-download-body-default

-               ""
+               "[]"

              "[1]")))
    t))
 
              "[1]")))
    t))
 


@@ -889,47 +1116,55 @@ not done by default on servers that doesn't support that command.")
        (nnmail-split-incoming (current-buffer)
                               #'nnimap-save-mail-spec
                               nil nil
        (nnmail-split-incoming (current-buffer)
                               #'nnimap-save-mail-spec
                               nil nil

-                              #'nnimap-dummy-active-number)
+                              #'nnimap-dummy-active-number
+                              #'nnimap-save-mail-spec)

        (when nnimap-incoming-split-list
          (let ((specs (nnimap-make-split-specs nnimap-incoming-split-list))
        (when nnimap-incoming-split-list
          (let ((specs (nnimap-make-split-specs nnimap-incoming-split-list))

-               sequences)
+               sequences junk-articles)

            ;; Create any groups that doesn't already exist on the
            ;; server first.
            (dolist (spec specs)
            ;; Create any groups that doesn't already exist on the
            ;; server first.
            (dolist (spec specs)

-             (unless (member (car spec) groups)
+             (when (and (not (member (car spec) groups))
+                        (not (eq (car spec) 'junk)))

                (nnimap-command "CREATE %S" (utf7-encode (car spec) t))))
            ;; Then copy over all the messages.
            (erase-buffer)
            (dolist (spec specs)
              (let ((group (car spec))
                    (ranges (cdr spec)))
                (nnimap-command "CREATE %S" (utf7-encode (car spec) t))))
            ;; Then copy over all the messages.
            (erase-buffer)
            (dolist (spec specs)
              (let ((group (car spec))
                    (ranges (cdr spec)))

-               (push (list (nnimap-send-command "UID COPY %s %S"
-                                                (nnimap-article-ranges ranges)
-                                                (utf7-encode group t))
-                           ranges)
-                     sequences)))
+               (if (eq group 'junk)
+                   (setq junk-articles ranges)
+                 (push (list (nnimap-send-command
+                              "UID COPY %s %S"
+                              (nnimap-article-ranges ranges)
+                              (utf7-encode group t))
+                             ranges)
+                       sequences))))

            ;; Wait for the last COPY response...
            (when sequences
              (nnimap-wait-for-response (caar sequences))
              ;; And then mark the successful copy actions as deleted,
              ;; and possibly expunge them.
              (nnimap-mark-and-expunge-incoming
            ;; Wait for the last COPY response...
            (when sequences
              (nnimap-wait-for-response (caar sequences))
              ;; And then mark the successful copy actions as deleted,
              ;; and possibly expunge them.
              (nnimap-mark-and-expunge-incoming

-              (nnimap-parse-copied-articles sequences)))))))))
+              (nnimap-parse-copied-articles sequences))
+             (nnimap-mark-and-expunge-incoming junk-articles))))))))

 
 (defun nnimap-mark-and-expunge-incoming (range)
   (when range
     (setq range (nnimap-article-ranges range))
 
 (defun nnimap-mark-and-expunge-incoming (range)
   (when range
     (setq range (nnimap-article-ranges range))

-    (nnimap-send-command
-     "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)
-    (cond
-     ;; If the server supports it, we now delete the message we have
-     ;; just copied over.
-     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s" range))
-     ;; If it doesn't support UID EXPUNGE, then we only expunge if the
-     ;; user has configured it.
-     (nnimap-expunge-inbox
-      (nnimap-send-command "EXPUNGE")))))
+    (let ((sequence
+          (nnimap-send-command
+           "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
+      (cond
+       ;; If the server supports it, we now delete the message we have
+       ;; just copied over.
+       ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+       (setq sequence (nnimap-send-command "UID EXPUNGE %s" range)))
+       ;; If it doesn't support UID EXPUNGE, then we only expunge if the
+       ;; user has configured it.
+       (nnimap-expunge
+       (setq sequence (nnimap-send-command "EXPUNGE"))))
+      (nnimap-wait-for-response sequence))))

 
 (defun nnimap-parse-copied-articles (sequences)
   (let (sequence copied range)
 
 (defun nnimap-parse-copied-articles (sequences)
   (let (sequence copied range)


@@ -944,8 +1179,8 @@ not done by default on servers that doesn't support that command.")
   (let (new)
     (dolist (elem flags)
       (when (or (null (cdr elem))
   (let (new)
     (dolist (elem flags)
       (when (or (null (cdr elem))

-               (and (not (member "\\Deleted" (cdr elem)))
-                    (not (member "\\Seen" (cdr elem)))))
+               (and (not (memq '%Deleted (cdr elem)))
+                    (not (memq '%Seen (cdr elem)))))

        (push (car elem) new)))
     (gnus-compress-sequence (nreverse new))))
 
        (push (car elem) new)))
     (gnus-compress-sequence (nreverse new))))
 


@@ -992,7 +1227,10 @@ not done by default on servers that doesn't support that command.")
     (if (not (re-search-forward "X-nnimap-article: \\([0-9]+\\)" nil t))
        (error "Invalid nnimap mail")
       (setq article (string-to-number (match-string 1))))
     (if (not (re-search-forward "X-nnimap-article: \\([0-9]+\\)" nil t))
        (error "Invalid nnimap mail")
       (setq article (string-to-number (match-string 1))))

-    (push (list article group-art)
+    (push (list article
+               (if (eq group-art 'junk)
+                   (list (cons 'junk 1))
+                 group-art))

          nnimap-incoming-split-list)))
 
 (provide 'nnimap)
          nnimap-incoming-split-list)))
 
 (provide 'nnimap)