summaryrefslogtreecommitdiff
path: root/lisp/gnus/nnimap.el
diff options
context:
space:
mode:
authorLars Magne Ingebrigtsen <larsi@gnus.org>2010-09-20 00:36:54 +0000
committerKatsumi Yamaoka <yamaoka@jpl.org>2010-09-20 00:36:54 +0000
commitbdaa75c74db6a3193515985146eaee5e9caa7ed0 (patch)
tree4db0906c689fbedefc34a72148056ffb2e4364f5 /lisp/gnus/nnimap.el
parent596880ea94f64b783cb3f97be611281924b7028b (diff)
downloademacs-bdaa75c74db6a3193515985146eaee5e9caa7ed0.tar.gz
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.
Diffstat (limited to 'lisp/gnus/nnimap.el')
-rw-r--r--lisp/gnus/nnimap.el84
1 files changed, 69 insertions, 15 deletions
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c27b3ec776b..b3a9e5bcdc4 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -66,6 +66,17 @@ Values are `ssl' and `network'.")
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 @@ 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)
- (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 @@ not done by default on servers that doesn't support that command.")
(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 @@ 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
- (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 @@ not done by default on servers that doesn't support that command.")
(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 @@ 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))
- 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 @@ not done by default on servers that doesn't support that command.")
(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))