diff lisp/gnus/nnimap.el @ 110433:33cf78a271ef

Merge changes made in Gnus trunk. mail-parse.el (mail-header-encode-parameter): Define as rfc2045-encode-string. nnheader.el (nnheader-insert-nov): Protect against junk appearing in the extra mail headers. gnus-html.el: Prefetch and html washing additions. gnus-html.el (gnus-html-prefetch-images): Fix up the url-retrieve calling conventions so that prefetch doesn't bug out. Pass proper format strings to gnus-message. nnimap.el: Allow anonymous login. nnimap.el (nnimap-transform-headers): The chars header is called Chars not Bytes. nnimap.el (nnimap-wait-for-response): Don't infloop if the IMAP connection drops. gnus-start.el (gnus-get-unread-articles): Call `gnus-open-server' on each method before trying to scan them etc. gnus-sum.el (gnus-summary-update-mark): Replace subst-char-in-region by subst-char-in-region. gnus.el (gnus-similar-server-opened): Refactor a bit and add comments. gnus.el: Fix a speed regression based in methods that were similar weren't the same. gnus.el (gnus): When using the development version of Gnus, load the gnus-load file. nnimap.el (nnimap-open-connection): When looking for credentials, also use the nnimap-server-port. nnimap.el (nnimap-request-article): Return the group/article number, so that Gnus `^' works as expected. nnimap.el (nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants them. gnus-start.el (gnus-ignored-newsgroups): Remove [] from the list of bogus characters. gnus-html.el (gnus-html-image-fetched): Protect against the data not arriving. nnimap.el (nnimap-wait-for-connection): Avoid a race condition while waiting for the connection string. gnus.texi (Required Back End Functions): Document INFO.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Mon, 20 Sep 2010 00:36:54 +0000
parents 6060b86fc551
children 4b82113fd203
line wrap: on
line diff
--- a/lisp/gnus/nnimap.el	Mon Sep 20 02:26:22 2010 +0200
+++ b/lisp/gnus/nnimap.el	Mon Sep 20 00:36:54 2010 +0000
@@ -66,6 +66,17 @@
 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-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-connection-alist nil)
 
 (defvoo nnimap-current-infos nil)
@@ -146,7 +157,7 @@
 	(delete-region (line-beginning-position) (line-end-position))
 	(insert (format "211 %s Article retrieved." article))
 	(forward-line 1)
-	(insert (format "Bytes: %d\n" bytes))
+	(insert (format "Chars: %d\n" bytes))
 	(when lines
 	  (insert (format "Lines: %s\n" lines)))
 	(re-search-forward "^\r$")
@@ -254,7 +265,14 @@
 	(when (setq connection-result (nnimap-wait-for-connection))
 	  (unless (equal connection-result "PREAUTH")
 	    (if (not (setq credentials
-			   (nnimap-credentials nnimap-address ports)))
+			   (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)
@@ -302,7 +320,8 @@
 
 (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
@@ -310,6 +329,14 @@
 	(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))
@@ -331,7 +358,30 @@
 		(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)
   (with-current-buffer nntp-server-buffer
@@ -825,21 +875,25 @@
     (goto-char (point-min))
     (while (and (memq (process-status process)
 		      '(open run))
-		(not (re-search-forward "^\\* " nil t)))
+		(not (re-search-forward "^\\* .*\n" nil t)))
       (nnheader-accept-process-output process)
       (goto-char (point-min)))
-    (and (looking-at "[A-Z0-9]+")
-	 (match-string 0))))
+    (forward-line -1)
+    (and (looking-at "\\* \\([A-Z0-9]+\\)")
+	 (match-string 1))))
 
 (defun nnimap-wait-for-response (sequence &optional messagep)
-  (goto-char (point-max))
-  (while (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 (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))