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

[gnus] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index a8902b2..f927a86 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -51,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)


@@ -139,15 +139,22 @@ 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 size)
+  (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)
        (setq size
              lines nil)
        (beginning-of-line)
        (setq size


@@ -157,7 +164,8 @@ not done by default on servers that doesn't support that command.")
                   (match-string 1)))
        (beginning-of-line)
        (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
                   (match-string 1)))
        (beginning-of-line)
        (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)))


@@ -419,13 +427,11 @@ not done by default on servers that doesn't support that command.")
              (when info
                (nnimap-update-infos marks (list info)))
              (goto-char (point-max))
              (when info
                (nnimap-update-infos marks (list info)))
              (goto-char (point-max))

-             (cond
-              (marks
-               (setq high (nth 3 (car marks))
-                     low (nth 4 (car marks))))
-              ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
-               (setq high (1- (string-to-number (match-string 1)))
-                     low 1)))))
+             (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)
          (insert
           (format
          (erase-buffer)
          (insert
           (format


@@ -502,7 +508,8 @@ not done by default on servers that doesn't support that command.")
     nil)
    (t
     (let ((deletable-articles
     nil)
    (t
     (let ((deletable-articles

-          (if force
+          (if (or force
+                  (eq nnmail-expiry-wait 'immediate))

               articles
             (gnus-sorted-intersection
              articles
               articles
             (gnus-sorted-intersection
              articles


@@ -780,15 +787,19 @@ not done by default on servers that doesn't support that command.")
       (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
        ;; Then update the list of read articles.
        (let* ((unread
                (gnus-compress-sequence


@@ -821,6 +832,7 @@ not done by default on servers that doesn't support that command.")
                  (new-marks
                   (gnus-compress-sequence
                    (cdr (or (assoc (caddr type) flags)     ; %Flagged
                  (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)
                             (assoc (cadr type) flags)))))) ; "\Flagged"
              (setq marks (delq old-marks marks))
              (pop old-marks)


@@ -859,10 +871,10 @@ 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
-                     permanent-flags)
-               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)
     data))
 
 (defun nnimap-parse-flags (sequences)


@@ -884,11 +896,13 @@ not done by default on servers that doesn't support that command.")
                           (and (search-forward "PERMANENTFLAGS "
                                                 (or end (point-min)) t)
                                (read (current-buffer))))
                           (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))))
                     (setq uidnext
                           (and (search-forward "UIDNEXT "
                                                 (or end (point-min)) t)
                                (read (current-buffer))))

-                    (goto-char end))
+                    (goto-char end)
+                    (forward-line -1))

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