nnimap.el (nnimap-update-info): Refactor slightly.

 (nnimap-update-info): Tell Gnus whether there are any \Recent messages.
 (nnimap-update-info): Clean up slightly.
 (nnimap-quirk): Add quirk for Gmail IMAP which bugs out on NUL characters.
 (nnimap-process-quirk): Renamed function to avoid collision.
 (nnimap-update-info): Fix macrology bug-out.

2 files changed, 71 insertions, 28 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 1ff45b69c2b..a18f145cb68 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,13 @@
+2011-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
+
+        * nnimap.el (nnimap-update-info): Refactor slightly.
+        (nnimap-update-info): Tell Gnus whether there are any \Recent messages.
+        (nnimap-update-info): Clean up slightly.
+        (nnimap-quirk): Add quirk for Gmail IMAP which bugs out on NUL
+        characters.
+        (nnimap-process-quirk): Renamed function to avoid collision.
+        (nnimap-update-info): Fix macrology bug-out.
+
 2011-02-06  Lars Ingebrigtsen  <larsi@gnus.org>
 
         * nntp.el (nntp-finish-retrieve-group-infos): Protect against the first
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index b50d656aa25..127082bc28f 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -969,30 +969,54 @@ textual parts.")
       (nnimap-add-cr)
       (setq message (buffer-substring-no-properties (point-min) (point-max)))
       (with-current-buffer (nnimap-buffer)
-        ;; If we have this group open read-only, then unselect it
-        ;; before appending to it.
-        (when (equal (nnimap-examined nnimap-object) group)
-          (nnimap-unselect-group))
-        (erase-buffer)
-        (setq sequence (nnimap-send-command
-                        "APPEND %S {%d}" (utf7-encode group t)
-                        (length message)))
-        (unless nnimap-streaming
-          (nnimap-wait-for-connection "^[+]"))
-        (process-send-string (get-buffer-process (current-buffer)) message)
-        (process-send-string (get-buffer-process (current-buffer))
-                             (if (nnimap-newlinep nnimap-object)
-                                 "\n"
-                               "\r\n"))
-        (let ((result (nnimap-get-response sequence)))
-          (if (not (nnimap-ok-p result))
-              (progn
-                (nnheader-report 'nnimap "%s" result)
-                nil)
-            (cons group
-                  (or (nnimap-find-uid-response "APPENDUID" (car result))
-                      (nnimap-find-article-by-message-id
-                       group message-id)))))))))
+        (when (setq message (nnimap-process-quirk "OK Gimap " 'append message))
+          ;; If we have this group open read-only, then unselect it
+          ;; before appending to it.
+          (when (equal (nnimap-examined nnimap-object) group)
+            (nnimap-unselect-group))
+          (erase-buffer)
+          (setq sequence (nnimap-send-command
+                          "APPEND %S {%d}" (utf7-encode group t)
+                          (length message)))
+          (unless nnimap-streaming
+            (nnimap-wait-for-connection "^[+]"))
+          (process-send-string (get-buffer-process (current-buffer)) message)
+          (process-send-string (get-buffer-process (current-buffer))
+                               (if (nnimap-newlinep nnimap-object)
+                                   "\n"
+                                 "\r\n"))
+          (let ((result (nnimap-get-response sequence)))
+            (if (not (nnimap-ok-p result))
+                (progn
+                  (nnheader-report 'nnimap "%s" result)
+                  nil)
+              (cons group
+                    (or (nnimap-find-uid-response "APPENDUID" (car result))
+                        (nnimap-find-article-by-message-id
+                         group message-id))))))))))
+
+(defun nnimap-process-quirk (greeting-match type data)
+  (when (and (nnimap-greeting nnimap-object)
+             (string-match "OK Gimap " (nnimap-greeting nnimap-object))
+             (eq type 'append)
+             (string-match "\000" data))
+    (let ((choice (gnus-multiple-choice
+                   "Message contains NUL characters.  Delete, continue, abort? "
+                   '((?d "Delete NUL characters")
+                     (?c "Try to APPEND the message as is")
+                     (?a "Abort")))))
+      (cond
+       ((eq choice ?a)
+        (nnheader-report 'nnimap "Aborted APPEND due to NUL characters"))
+       ((eq choice ?c)
+        data)
+       (t
+        (with-temp-buffer
+          (insert data)
+          (goto-char (point-min))
+          (while (search-forward "\000" nil t)
+            (replace-match "" t t))
+          (buffer-string)))))))
 
 (defun nnimap-ok-p (value)
   (and (consp value)
@@ -1249,10 +1273,9 @@ textual parts.")
                               (t
                                ;; No articles and no uidnext.
                                nil)))
-          (gnus-set-active
-           group
-           (cons (car active)
-                 (or high (1- uidnext)))))
+          (gnus-set-active group
+                           (cons (car active)
+                                 (or high (1- uidnext)))))
         ;; See whether this is a read-only group.
         (unless (eq permanent-flags 'not-scanned)
           (gnus-group-set-parameter
@@ -1316,6 +1339,16 @@ textual parts.")
                     (when new-marks
                       (push (cons (car type) new-marks) marks)))))
               (gnus-info-set-marks info marks t))))
+        ;; Tell Gnus whether there are any \Recent messages in any of
+        ;; the groups.
+        (let ((recent (cdr (assoc '%Recent flags))))
+          (when (and active recent)
+            (while recent
+              (when (> (car recent) (cdr active))
+                (push (list (cons (gnus-group-real-name group) 0))
+                      nnmail-split-history)
+                (setq recent nil))
+              (pop recent))))
         ;; Note the active level for the next run-through.
         (gnus-group-set-parameter info 'active (gnus-active group))
         (gnus-group-set-parameter info 'uidvalidity uidvalidity)