From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 7 Feb 2011 13:03:22 +0000 (+0000)
Subject: nnimap.el (nnimap-update-info): Refactor slightly.
X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~975
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=41d579ce4a2a86428f200788df4b15b936aa5076;p=emacs.git

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.
---

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)