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.
on successful article retrieval.
-@item (nnchoke-request-group GROUP &optional SERVER FAST)
+@item (nnchoke-request-group GROUP &optional SERVER FAST INFO)
Get data on @var{group}. This function also has the side effect of
making @var{group} the current group.
If @var{fast}, don't bother to return useful data, just make @var{group}
the current group.
+If @var{info}, it allows the backend to update the group info
+structure.
+
Here's an example of some result data and a definition of the same:
@example
2010-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * nnimap.el (nnimap-wait-for-connection): Avoid a race condition while
+ waiting for the connection string.
+
+ * gnus-html.el (gnus-html-image-fetched): Protect against the data not
+ arriving.
+
+ * gnus-start.el (gnus-ignored-newsgroups): Remove [] from the list of
+ bogus characters. This allows selecting certain Gmail groups.
+
+ * nnimap.el (nnimap-find-wanted-parts-1): New function.
+ (nnimap-fetch-partial-articles): New variable.
+ (nnimap-open-connection): When looking for credentials, also use the
+ nnimap-server-port.
+ (nnimap-request-article): Return the group/article number, so that Gnus
+ `^' works as expected.
+ (nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants
+ them.
+
+ * gnus.el (gnus-similar-server-opened): Refactor a bit and add
+ comments.
+ (gnus-methods-sloppily-equal): New function.
+ (gnus): When using the development version of Gnus, load the gnus-load
+ file.
+
+ * gnus-start.el (gnus-get-unread-articles): Make sure that we call
+ `gnus-open-server' on each method before trying to scan them etc. This
+ ensures that all the backend parameters are set correctly.
+
+ * nnimap.el (nnimap-authenticator): New variable.
+ (nnimap-open-connection): Allow anonymous login.
+ (nnimap-transform-headers): The chars header is called Chars not
+ Bytes.
+ (nnimap-wait-for-response): Don't infloop if the IMAP connection
+ drops.
+
+ * gnus-art.el (gnus-article-describe-briefly): Fix up typo in last
+ patch, found by Knut Anders Hatlen.
+
+2010-09-19 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnus-agent.el (gnus-agent-batch-confirmation)
+ (gnus-agent-expire-group, gnus-agent-expire): Pass proper format string
+ to gnus-message.
+ * gnus-art.el (gnus-article-describe-briefly): Likewise.
+ * gnus-group.el (gnus-group-list-groups, gnus-group-describe-group)
+ (gnus-group-edit-global-kill, gnus-group-describe-briefly): Likewise.
+ * gnus-int.el (gnus-open-server): Likewise.
+ * gnus-score.el (gnus-score-edit-current-scores, gnus-score-edit-file)
+ (gnus-score-check-syntax): Likewise.
+ * gnus-srvr.el (gnus-browse-describe-briefly): Likewise.
+ * gnus-start.el (gnus-read-active-file-1, gnus-read-active-file-1):
+ Likewise.
+ * gnus-sum.el (gnus-summary-describe-briefly): Likewise.
+
+2010-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-html.el (gnus-html-prefetch-images): Fix up the url-retrieve
+ calling conventions so that prefetch doesn't bug out.
+
+2010-09-19 Julien Danjou <julien@danjou.info>
+
+ * gnus-sum.el (gnus-summary-update-mark): Use `subst-char-in-string'
+ rather than `subst-char-in-region' in order to be able to replace ASCII
+ char by UTF-8 ones.
+
+ * gnus-html.el (gnus-html-prefetch-images): Use `url-retrieve' rather
+ than curl.
+ (gnus-html-image-fetched): Fix `gnus-html-put-image' call not setting
+ the right URL and ALT text on images.
+ (gnus-html-wash-tags): Fix tag case.
+ Add support for `s' and `ins' tags. Use gnus-emphasis-* faces.
+ (gnus-article-html): Add -o display_ins_del=2 option.
+ (gnus-html-wash-tags): Add better support for <ul> tags symbols.
+
+2010-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnheader.el (nnheader-insert-nov): Protect against junk appearing in
+ the extra mail headers, which sometimes seem to happen for unknown
+ reasons.
+
+ * mail-parse.el (mail-header-encode-parameter): Define as
+ rfc2045-encode-string instead of as rfc2231-encode-string, since some
+ (or most, perhaps?) mail readers don't understand the latter, but do
+ understand the former.
+
* gnus-agent.el (gnus-agent-auto-agentize-methods): Switch the default
to nil, so that no methods are automatically agentized. I think this
is probably what most users want.
the range update right.
(nnimap-request-group): Don't make `M-g' bug out on group with no
marks.
- (nnoo): Require, so that other packages can require nnimap.
+ (nnoo): Required, so that other packages can require nnimap.
(nnimap-wait-for-response): Be a bit more lax in finding the end of the
command we're looking for. This helps when the server sends more
responses after we've gotten everything we expected.
(defun gnus-agent-batch-confirmation (msg)
"Show error message and return t."
- (gnus-message 1 msg)
+ (gnus-message 1 "%s" msg)
t)
;;;###autoload
group overview (gnus-gethash-safe group orig)
articles force))))
(kill-buffer overview))))
- (gnus-message 4 (gnus-agent-expire-done-message)))))
+ (gnus-message 4 "%s" (gnus-agent-expire-done-message)))))
(defun gnus-agent-expire-group-1 (group overview active articles force)
;; Internal function - requires caller to have set
expiring-group overview active articles force))))))))
(kill-buffer overview))
(gnus-agent-expire-unagentized-dirs)
- (gnus-message 4 (gnus-agent-expire-done-message))))))
+ (gnus-message 4 "%s" (gnus-agent-expire-done-message))))))
(defun gnus-agent-expire-done-message ()
(if (and (> gnus-verbose 4)
(defun gnus-article-describe-briefly ()
"Describe article mode commands briefly."
(interactive)
- (gnus-message 6 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
+ (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
(defun gnus-article-check-buffer ()
"Beep if not in an article buffer."
(zerop number))
(zerop (buffer-size)))
;; No groups in the buffer.
- (gnus-message 5 gnus-no-groups-message))
+ (gnus-message 5 "%s" gnus-no-groups-message))
;; We have some groups displayed.
(goto-char (point-max))
(when (or (not gnus-group-goto-next-group-function)
(gnus-gethash mname gnus-description-hashtb))
(setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method))
- (gnus-message 1
+ (gnus-message 1 "%s"
(or desc (gnus-gethash group gnus-description-hashtb)
"No description available")))))
(interactive "P")
(setq gnus-current-kill-article article)
(gnus-kill-file-edit-file group)
- (gnus-message
- 6
- (substitute-command-keys
- (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
- (if group "local" "global")))))
+ (gnus-message 6 "Editing a %s kill file (Type %s to exit)"
+ (if group "local" "global")
+ (substitute-command-keys "\\[gnus-kill-file-exit]")))
(defun gnus-group-edit-local-kill (article group)
"Edit a local kill file."
(defun gnus-group-describe-briefly ()
"Give a one line description of the group mode commands."
(interactive)
- (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
+ (gnus-message 7 "%s" (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
(defun gnus-group-browse-foreign-server (method)
"Browse a foreign news server.
"-I" "UTF-8"
"-O" "UTF-8"
"-o" "ext_halfdump=1"
+ "-o" "display_ins_del=2"
"-o" "pre_conv=1"
"-t" (format "%s" tab-width)
"-cols" (format "%s" gnus-html-frame-width)
;; should be deleted.
((equal tag "IMG_ALT")
(delete-region start end))
+ ;; w3m does not normalize the case
+ ((or (equal tag "b")
+ (equal tag "B"))
+ (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-bold))
+ ((or (equal tag "u")
+ (equal tag "U"))
+ (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline))
+ ((or (equal tag "i")
+ (equal tag "I"))
+ (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-italic))
+ ((or (equal tag "s")
+ (equal tag "S"))
+ (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-strikethru))
+ ((or (equal tag "ins")
+ (equal tag "INS"))
+ (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline))
+ ;; Handle different UL types
+ ((equal tag "_SYMBOL")
+ (when (string-match "TYPE=\\(.+\\)" parameters)
+ (let ((type (string-to-number (match-string 1 parameters))))
+ (delete-region start end)
+ (cond ((= type 33) (insert " "))
+ ((= type 34) (insert " "))
+ ((= type 35) (insert " "))
+ ((= type 36) (insert " "))
+ ((= type 37) (insert " "))
+ ((= type 38) (insert " "))
+ ((= type 39) (insert " "))
+ ((= type 40) (insert " "))
+ ((= type 42) (insert " "))
+ ((= type 43) (insert " "))
+ (t (insert " "))))))
;; Whatever. Just ignore the tag.
- ((equal tag "b")
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'bold))
- ((equal tag "U")
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'underline))
- ((equal tag "i")
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'italic))
(t
))
(goto-char start))
(expand-file-name (sha1 url) gnus-html-cache-directory))
(defun gnus-html-image-fetched (status buffer image)
- (when (and (buffer-live-p buffer)
- ;; If the position of the marker is 1, then that
- ;; means that the text it was in has been deleted;
- ;; i.e., that the user has selected a different
- ;; article before the image arrived.
- (not (= (marker-position (cadr image)) (point-min))))
- (let ((file (gnus-html-image-id (car image))))
- ;; Search the start of the image data
- (search-forward "\n\n")
- ;; Write region (image) silently
+ (let ((file (gnus-html-image-id (car image))))
+ ;; Search the start of the image data
+ (when (search-forward "\n\n" nil t)
+ ;; Write region (image data) silently
(write-region (point) (point-max) file nil 1)
(kill-buffer)
- (with-current-buffer buffer
- (let ((inhibit-read-only t)
- (string (buffer-substring (cadr image) (caddr image))))
- (delete-region (cadr image) (caddr image))
- (gnus-html-put-image file (cadr image) string))))))
+ (when (and (buffer-live-p buffer)
+ ;; If the `image' has no marker, do not replace anything
+ (cadr image)
+ ;; If the position of the marker is 1, then that
+ ;; means that the text it was in has been deleted;
+ ;; i.e., that the user has selected a different
+ ;; article before the image arrived.
+ (not (= (marker-position (cadr image)) (point-min))))
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t)
+ (string (buffer-substring (cadr image) (caddr image))))
+ (delete-region (cadr image) (caddr image))
+ (gnus-html-put-image file (cadr image) (car image) string)))))))
(defun gnus-html-put-image (file point string &optional url alt-text)
(when (gnus-graphic-display-p)
;;;###autoload
(defun gnus-html-prefetch-images (summary)
- (let (blocked-images urls)
- (when (and (buffer-live-p summary)
- (executable-find "curl"))
- (with-current-buffer summary
- (setq blocked-images gnus-blocked-images))
+ (when (buffer-live-p summary)
+ (let ((blocked-images (with-current-buffer summary
+ gnus-blocked-images)))
(save-match-data
(while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
(let ((url (match-string 1)))
(unless (gnus-html-image-url-blocked-p url blocked-images)
(unless (file-exists-p (gnus-html-image-id url))
- (push (mm-url-decode-entities-string url) urls)
- (push (gnus-html-image-id url) urls)
- (push "-o" urls)))))
- (let ((process
- (apply 'start-process
- "images" nil "curl"
- "-s" "--create-dirs"
- "--location"
- "--max-time" "60"
- urls)))
- (gnus-set-process-query-on-exit-flag process nil))))))
+ (ignore-errors
+ (url-retrieve (mm-url-decode-entities-string url)
+ 'gnus-html-image-fetched
+ (list nil (list url))))))))))))
(provide 'gnus-html)
(nth 1 gnus-command-method)
(nthcdr 2 gnus-command-method))
(error
- (gnus-message 1 (format
- "Unable to open server %s due to: %s"
- server (error-message-string err)))
+ (gnus-message 1 "Unable to open server %s due to: %s"
+ server (error-message-string err))
nil)
(quit
(gnus-message 1 "Quit trying to open server %s" server)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
+ 4 "%s" (substitute-command-keys
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
(defun gnus-score-edit-all-score ()
"Edit the all.SCORE file."
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+ 4 "%s" (substitute-command-keys
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
(defun gnus-score-edit-file-at-point (&optional format)
"Edit score file at point in Score Trace buffers.
(if err
(progn
(ding)
- (gnus-message 3 err)
+ (gnus-message 3 "%s" err)
(sit-for 2)
nil)
alist)))))
(defun gnus-browse-describe-briefly ()
"Give a one line description of the group mode commands."
(interactive)
- (gnus-message 6
+ (gnus-message 6 "%s"
(substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
(defun gnus-server-regenerate-server ()
(mapconcat 'identity
'("^to\\." ; not "real" groups
"^[0-9. \t]+\\( \\|$\\)" ; all digits in name
- "^[\"][]\"[#'()]" ; bogus characters
+ "^[\"][\"#'()]" ; bogus characters
)
"\\|")
"*A regexp to match uninteresting newsgroups in the active file.
(dolist (elem type-cache)
(destructuring-bind (method method-type infos dummy) elem
(when (and method infos
- (not (gnus-method-denied-p method))
- (gnus-check-backend-function
- 'retrieve-group-data-early (car method)))
- (when (gnus-check-backend-function 'request-scan (car method))
- (dolist (info infos)
- (gnus-request-scan (gnus-info-group info) method)))
- (setcar (nthcdr 3 elem)
- (gnus-retrieve-group-data-early method infos)))))
+ (not (gnus-method-denied-p method)))
+ (unless (gnus-server-opened method)
+ (gnus-open-server method))
+ (when (gnus-check-backend-function
+ 'retrieve-group-data-early (car method))
+ (when (gnus-check-backend-function 'request-scan (car method))
+ (dolist (info infos)
+ (gnus-request-scan (gnus-info-group info) method)))
+ (setcar (nthcdr 3 elem)
+ (gnus-retrieve-group-data-early method infos))))))
;; Do the rest of the retrieval.
(dolist (elem type-cache)
(if (and where (not (zerop (length where))))
(concat " from " where) "")
(car method)))
- (gnus-message 5 mesg)
+ (gnus-message 5 "%s" mesg)
(when (gnus-check-server method)
;; Request that the backend scan its incoming messages.
(when (and (or (and gnus-agent
(unless (equal method gnus-message-archive-method)
(gnus-error 1 "Cannot read active file from %s server"
(car method)))
- (gnus-message 5 mesg)
+ (gnus-message 5 "%s" mesg)
(gnus-active-to-gnus-format method gnus-active-hashtb nil t)
;; We mark this active file as read.
(push method gnus-have-read-active-file)
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
(interactive)
- (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
;; Go to the right position on the line.
(goto-char (+ forward (point)))
;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (char-after) mark)
+ (let ((to-insert
+ (subst-char-in-string (char-after) mark
+ (buffer-substring (point) (1+ (point))))))
+ (delete-region (point) (1+ (point)))
+ (insert to-insert))
;; Optionally update the marks by some user rule.
(when (eq type 'unread)
(gnus-data-set-mark
gnus-valid-select-methods)))
(equal (nth 1 m1) (nth 1 m2)))))))
+(defun gnus-methods-sloppily-equal (m1 m2)
+ ;; Same method.
+ (or
+ (eq m1 m2)
+ ;; Type and name are equal.
+ (and
+ (eq (car m1) (car m2))
+ (equal (cadr m1) (cadr m2))
+ ;; Check parameters for sloppy equalness.
+ (let ((p1 (copy-list (cddr m1)))
+ (p2 (copy-list (cddr m2)))
+ e1 e2)
+ (block nil
+ (while (setq e1 (pop p1))
+ (unless (setq e2 (assq (car e1) p2))
+ ;; The parameter doesn't exist in p2.
+ (return nil))
+ (setq p2 (delq e2 p2))
+ (unless (equalp e1 e2)
+ (if (not (and (stringp (cadr e1))
+ (stringp (cadr e2))))
+ (return nil)
+ ;; Special-case string parameter comparison so that we
+ ;; can uniquify them.
+ (let ((s1 (cadr e1))
+ (s2 (cadr e2)))
+ (when (string-match "/$" s1)
+ (setq s1 (directory-file-name s1)))
+ (when (string-match "/$" s2)
+ (setq s2 (directory-file-name s2)))
+ (unless (equal s1 s2)
+ (return nil))))))
+ ;; If p2 now is empty, they were equal.
+ (null p2))))))
+
(defun gnus-server-equal (m1 m2)
"Say whether two methods are equal."
(let ((m1 (cond ((null m1) gnus-select-method)
gnus-valid-select-methods)))
(defun gnus-similar-server-opened (method)
- (let ((opened gnus-opened-servers))
+ "Return non-nil if we have a similar server opened.
+This is defined as a server with the same name, but different
+parameters."
+ (let ((opened gnus-opened-servers)
+ open)
(while (and method opened)
- (when (and (equal (cadr method) (cadaar opened))
- (equal (car method) (caaar opened))
- (not (equal method (caar opened))))
- (setq method nil))
- (pop opened))
+ (setq open (car (pop opened)))
+ ;; Type and name are the same...
+ (when (and (equal (car method) (car open))
+ (equal (cadr method) (cadr open))
+ ;; ... but the rest of the parameters differ.
+ (not (gnus-methods-sloppily-equal method open)))
+ (setq method nil)))
(not method)))
(defun gnus-server-extend-method (group method)
startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use."
(interactive "P")
+ ;; When using the development version of Gnus, load the gnus-load
+ ;; file.
+ (unless (string-match "^Gnus" gnus-version)
+ (load "gnus-load"))
(unless (byte-code-function-p (symbol-function 'gnus))
(message "You should byte-compile Gnus")
(sit-for 2))
(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string)
(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string)
(defalias 'mail-content-type-get 'rfc2231-get-value)
-;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
-(defalias 'mail-header-encode-parameter 'rfc2231-encode-string)
+(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments)
(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)
(let ((extra (mail-header-extra header)))
(while extra
(insert (symbol-name (caar extra))
- ": " (cdar extra) "\t")
+ ": " (if (stringp (cdar extra)) (cdar extra) "") "\t")
(pop extra))))
(insert "\n")
(backward-char 1)
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)
(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$")
(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)
(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
(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))
(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
(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))
projects / emacs.git / commitdiff