Commit bdaa75c7 authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen Committed by Katsumi Yamaoka
Browse files

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.
parent 596880ea
......@@ -29672,7 +29672,7 @@ group and article numbers are when fetching articles by
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.
......@@ -29680,6 +29680,9 @@ 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.
......@@ -41,7 +126,7 @@
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.
......
......@@ -2377,7 +2377,7 @@ modified) original contents, they are first saved to their own file."
(defun gnus-agent-batch-confirmation (msg)
"Show error message and return t."
(gnus-message 1 msg)
(gnus-message 1 "%s" msg)
t)
;;;###autoload
......@@ -3123,7 +3123,7 @@ FORCE is equivalent to setting the expiration predicates to true."
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
......@@ -3548,7 +3548,7 @@ articles in every agentized group? "))
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)
......
......@@ -6406,7 +6406,7 @@ not have a face in `gnus-article-boring-faces'."
(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."
......
......@@ -1273,7 +1273,7 @@ Also see the `gnus-group-use-permanent-levels' variable."
(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)
......@@ -4136,7 +4136,7 @@ If given a prefix argument, prompt for a group."
(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")))))
......@@ -4297,11 +4297,9 @@ If GROUP, edit that local kill file instead."
(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."
......@@ -4392,7 +4390,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
(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.
......
......@@ -114,6 +114,7 @@ fit these criteria."
"-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)
......@@ -253,13 +254,39 @@ fit these criteria."
;; 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))
......@@ -307,23 +334,25 @@ fit these criteria."
(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)
......@@ -441,27 +470,18 @@ This only works if the article in question is HTML."
;;;###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)
......
......@@ -245,9 +245,8 @@ If it is down, start it up (again)."
(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)
......
......@@ -1114,8 +1114,8 @@ EXTRA is the possible non-standard header."
(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."
......@@ -1142,8 +1142,8 @@ EXTRA is the possible non-standard header."
(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.
......@@ -1391,7 +1391,7 @@ If FORMAT, also format the current score file."
(if err
(progn
(ding)
(gnus-message 3 err)
(gnus-message 3 "%s" err)
(sit-for 2)
nil)
alist)))))
......
......@@ -976,7 +976,7 @@ If NUMBER, fetch this number of articles."
(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 ()
......
......@@ -268,7 +268,7 @@ not match this regexp will be removed before saving the list."
(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.
......@@ -1759,14 +1759,16 @@ If SCAN, request a scan of that group as well."
(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)
......@@ -2054,7 +2056,7 @@ If SCAN, request a scan of that group as well."
(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
......@@ -2089,7 +2091,7 @@ If SCAN, request a scan of that group as well."
(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)
......
......@@ -7330,7 +7330,7 @@ in."
(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.
......@@ -10768,7 +10768,11 @@ If NO-EXPIRE, auto-expiry will be inhibited."
;; 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
......
......@@ -3678,6 +3678,41 @@ that that variable is buffer-local to the summary buffers."
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)
......@@ -4142,13 +4177,19 @@ If NEWSGROUP is nil, return the global kill file name instead."
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)
......@@ -4397,6 +4438,10 @@ If ARG is non-nil and a positive number, Gnus will use that as the
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))
......
......@@ -45,8 +45,7 @@
(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)
......
......@@ -463,7 +463,7 @@ on your system, you could say something like:
(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)
......
......@@ -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))