1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 02:31:03 -08:00

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.
This commit is contained in:
Lars Magne Ingebrigtsen 2010-09-20 00:36:54 +00:00 committed by Katsumi Yamaoka
parent 596880ea94
commit bdaa75c74d
15 changed files with 306 additions and 97 deletions

View file

@ -29672,7 +29672,7 @@ group and article numbers are when fetching articles by
on successful article retrieval. 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 Get data on @var{group}. This function also has the side effect of
making @var{group} the current group. 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} If @var{fast}, don't bother to return useful data, just make @var{group}
the current 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: Here's an example of some result data and a definition of the same:
@example @example

View file

@ -1,5 +1,90 @@
2010-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org> 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 * gnus-agent.el (gnus-agent-auto-agentize-methods): Switch the default
to nil, so that no methods are automatically agentized. I think this to nil, so that no methods are automatically agentized. I think this
is probably what most users want. is probably what most users want.
@ -41,7 +126,7 @@
the range update right. the range update right.
(nnimap-request-group): Don't make `M-g' bug out on group with no (nnimap-request-group): Don't make `M-g' bug out on group with no
marks. 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 (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 command we're looking for. This helps when the server sends more
responses after we've gotten everything we expected. responses after we've gotten everything we expected.

View file

@ -2377,7 +2377,7 @@ modified) original contents, they are first saved to their own file."
(defun gnus-agent-batch-confirmation (msg) (defun gnus-agent-batch-confirmation (msg)
"Show error message and return t." "Show error message and return t."
(gnus-message 1 msg) (gnus-message 1 "%s" msg)
t) t)
;;;###autoload ;;;###autoload
@ -3123,7 +3123,7 @@ FORCE is equivalent to setting the expiration predicates to true."
group overview (gnus-gethash-safe group orig) group overview (gnus-gethash-safe group orig)
articles force)))) articles force))))
(kill-buffer overview)))) (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) (defun gnus-agent-expire-group-1 (group overview active articles force)
;; Internal function - requires caller to have set ;; Internal function - requires caller to have set
@ -3548,7 +3548,7 @@ articles in every agentized group? "))
expiring-group overview active articles force)))))))) expiring-group overview active articles force))))))))
(kill-buffer overview)) (kill-buffer overview))
(gnus-agent-expire-unagentized-dirs) (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 () (defun gnus-agent-expire-done-message ()
(if (and (> gnus-verbose 4) (if (and (> gnus-verbose 4)

View file

@ -6406,7 +6406,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-describe-briefly () (defun gnus-article-describe-briefly ()
"Describe article mode commands briefly." "Describe article mode commands briefly."
(interactive) (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 () (defun gnus-article-check-buffer ()
"Beep if not in an article buffer." "Beep if not in an article buffer."

View file

@ -1273,7 +1273,7 @@ Also see the `gnus-group-use-permanent-levels' variable."
(zerop number)) (zerop number))
(zerop (buffer-size))) (zerop (buffer-size)))
;; No groups in the buffer. ;; 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. ;; We have some groups displayed.
(goto-char (point-max)) (goto-char (point-max))
(when (or (not gnus-group-goto-next-group-function) (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)) (gnus-gethash mname gnus-description-hashtb))
(setq desc (gnus-group-get-description group)) (setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method)) (gnus-read-descriptions-file method))
(gnus-message 1 (gnus-message 1 "%s"
(or desc (gnus-gethash group gnus-description-hashtb) (or desc (gnus-gethash group gnus-description-hashtb)
"No description available"))))) "No description available")))))
@ -4297,11 +4297,9 @@ If GROUP, edit that local kill file instead."
(interactive "P") (interactive "P")
(setq gnus-current-kill-article article) (setq gnus-current-kill-article article)
(gnus-kill-file-edit-file group) (gnus-kill-file-edit-file group)
(gnus-message (gnus-message 6 "Editing a %s kill file (Type %s to exit)"
6 (if group "local" "global")
(substitute-command-keys (substitute-command-keys "\\[gnus-kill-file-exit]")))
(format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
(if group "local" "global")))))
(defun gnus-group-edit-local-kill (article group) (defun gnus-group-edit-local-kill (article group)
"Edit a local kill file." "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 () (defun gnus-group-describe-briefly ()
"Give a one line description of the group mode commands." "Give a one line description of the group mode commands."
(interactive) (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) (defun gnus-group-browse-foreign-server (method)
"Browse a foreign news server. "Browse a foreign news server.

View file

@ -114,6 +114,7 @@ fit these criteria."
"-I" "UTF-8" "-I" "UTF-8"
"-O" "UTF-8" "-O" "UTF-8"
"-o" "ext_halfdump=1" "-o" "ext_halfdump=1"
"-o" "display_ins_del=2"
"-o" "pre_conv=1" "-o" "pre_conv=1"
"-t" (format "%s" tab-width) "-t" (format "%s" tab-width)
"-cols" (format "%s" gnus-html-frame-width) "-cols" (format "%s" gnus-html-frame-width)
@ -253,13 +254,39 @@ fit these criteria."
;; should be deleted. ;; should be deleted.
((equal tag "IMG_ALT") ((equal tag "IMG_ALT")
(delete-region start end)) (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. ;; 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 (t
)) ))
(goto-char start)) (goto-char start))
@ -307,23 +334,25 @@ fit these criteria."
(expand-file-name (sha1 url) gnus-html-cache-directory)) (expand-file-name (sha1 url) gnus-html-cache-directory))
(defun gnus-html-image-fetched (status buffer image) (defun gnus-html-image-fetched (status buffer image)
(when (and (buffer-live-p buffer) (let ((file (gnus-html-image-id (car image))))
;; If the position of the marker is 1, then that ;; Search the start of the image data
;; means that the text it was in has been deleted; (when (search-forward "\n\n" nil t)
;; i.e., that the user has selected a different ;; Write region (image data) silently
;; 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
(write-region (point) (point-max) file nil 1) (write-region (point) (point-max) file nil 1)
(kill-buffer) (kill-buffer)
(with-current-buffer buffer (when (and (buffer-live-p buffer)
(let ((inhibit-read-only t) ;; If the `image' has no marker, do not replace anything
(string (buffer-substring (cadr image) (caddr image)))) (cadr image)
(delete-region (cadr image) (caddr image)) ;; If the position of the marker is 1, then that
(gnus-html-put-image file (cadr image) string)))))) ;; 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) (defun gnus-html-put-image (file point string &optional url alt-text)
(when (gnus-graphic-display-p) (when (gnus-graphic-display-p)
@ -441,27 +470,18 @@ This only works if the article in question is HTML."
;;;###autoload ;;;###autoload
(defun gnus-html-prefetch-images (summary) (defun gnus-html-prefetch-images (summary)
(let (blocked-images urls) (when (buffer-live-p summary)
(when (and (buffer-live-p summary) (let ((blocked-images (with-current-buffer summary
(executable-find "curl")) gnus-blocked-images)))
(with-current-buffer summary
(setq blocked-images gnus-blocked-images))
(save-match-data (save-match-data
(while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
(let ((url (match-string 1))) (let ((url (match-string 1)))
(unless (gnus-html-image-url-blocked-p url blocked-images) (unless (gnus-html-image-url-blocked-p url blocked-images)
(unless (file-exists-p (gnus-html-image-id url)) (unless (file-exists-p (gnus-html-image-id url))
(push (mm-url-decode-entities-string url) urls) (ignore-errors
(push (gnus-html-image-id url) urls) (url-retrieve (mm-url-decode-entities-string url)
(push "-o" urls))))) 'gnus-html-image-fetched
(let ((process (list nil (list url))))))))))))
(apply 'start-process
"images" nil "curl"
"-s" "--create-dirs"
"--location"
"--max-time" "60"
urls)))
(gnus-set-process-query-on-exit-flag process nil))))))
(provide 'gnus-html) (provide 'gnus-html)

View file

@ -245,9 +245,8 @@ If it is down, start it up (again)."
(nth 1 gnus-command-method) (nth 1 gnus-command-method)
(nthcdr 2 gnus-command-method)) (nthcdr 2 gnus-command-method))
(error (error
(gnus-message 1 (format (gnus-message 1 "Unable to open server %s due to: %s"
"Unable to open server %s due to: %s" server (error-message-string err))
server (error-message-string err)))
nil) nil)
(quit (quit
(gnus-message 1 "Quit trying to open server %s" server) (gnus-message 1 "Quit trying to open server %s" server)

View file

@ -1114,8 +1114,8 @@ EXTRA is the possible non-standard header."
(make-local-variable 'gnus-prev-winconf) (make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)) (setq gnus-prev-winconf winconf))
(gnus-message (gnus-message
4 (substitute-command-keys 4 "%s" (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))) "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
(defun gnus-score-edit-all-score () (defun gnus-score-edit-all-score ()
"Edit the all.SCORE file." "Edit the all.SCORE file."
@ -1142,8 +1142,8 @@ EXTRA is the possible non-standard header."
(make-local-variable 'gnus-prev-winconf) (make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)) (setq gnus-prev-winconf winconf))
(gnus-message (gnus-message
4 (substitute-command-keys 4 "%s" (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))) "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
(defun gnus-score-edit-file-at-point (&optional format) (defun gnus-score-edit-file-at-point (&optional format)
"Edit score file at point in Score Trace buffers. "Edit score file at point in Score Trace buffers.
@ -1391,7 +1391,7 @@ If FORMAT, also format the current score file."
(if err (if err
(progn (progn
(ding) (ding)
(gnus-message 3 err) (gnus-message 3 "%s" err)
(sit-for 2) (sit-for 2)
nil) nil)
alist))))) alist)))))

View file

@ -976,7 +976,7 @@ If NUMBER, fetch this number of articles."
(defun gnus-browse-describe-briefly () (defun gnus-browse-describe-briefly ()
"Give a one line description of the group mode commands." "Give a one line description of the group mode commands."
(interactive) (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"))) (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 () (defun gnus-server-regenerate-server ()

View file

@ -268,7 +268,7 @@ not match this regexp will be removed before saving the list."
(mapconcat 'identity (mapconcat 'identity
'("^to\\." ; not "real" groups '("^to\\." ; not "real" groups
"^[0-9. \t]+\\( \\|$\\)" ; all digits in name "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
"^[\"][]\"[#'()]" ; bogus characters "^[\"][\"#'()]" ; bogus characters
) )
"\\|") "\\|")
"*A regexp to match uninteresting newsgroups in the active file. "*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) (dolist (elem type-cache)
(destructuring-bind (method method-type infos dummy) elem (destructuring-bind (method method-type infos dummy) elem
(when (and method infos (when (and method infos
(not (gnus-method-denied-p method)) (not (gnus-method-denied-p method)))
(gnus-check-backend-function (unless (gnus-server-opened method)
'retrieve-group-data-early (car method))) (gnus-open-server method))
(when (gnus-check-backend-function 'request-scan (car method)) (when (gnus-check-backend-function
(dolist (info infos) 'retrieve-group-data-early (car method))
(gnus-request-scan (gnus-info-group info) method))) (when (gnus-check-backend-function 'request-scan (car method))
(setcar (nthcdr 3 elem) (dolist (info infos)
(gnus-retrieve-group-data-early method 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. ;; Do the rest of the retrieval.
(dolist (elem type-cache) (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)))) (if (and where (not (zerop (length where))))
(concat " from " where) "") (concat " from " where) "")
(car method))) (car method)))
(gnus-message 5 mesg) (gnus-message 5 "%s" mesg)
(when (gnus-check-server method) (when (gnus-check-server method)
;; Request that the backend scan its incoming messages. ;; Request that the backend scan its incoming messages.
(when (and (or (and gnus-agent (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) (unless (equal method gnus-message-archive-method)
(gnus-error 1 "Cannot read active file from %s server" (gnus-error 1 "Cannot read active file from %s server"
(car method))) (car method)))
(gnus-message 5 mesg) (gnus-message 5 "%s" mesg)
(gnus-active-to-gnus-format method gnus-active-hashtb nil t) (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
;; We mark this active file as read. ;; We mark this active file as read.
(push method gnus-have-read-active-file) (push method gnus-have-read-active-file)

View file

@ -7330,7 +7330,7 @@ in."
(defun gnus-summary-describe-briefly () (defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly." "Describe summary mode commands briefly."
(interactive) (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. ;; 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. ;; Go to the right position on the line.
(goto-char (+ forward (point))) (goto-char (+ forward (point)))
;; Replace the old mark with the new mark. ;; 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. ;; Optionally update the marks by some user rule.
(when (eq type 'unread) (when (eq type 'unread)
(gnus-data-set-mark (gnus-data-set-mark

View file

@ -3678,6 +3678,41 @@ that that variable is buffer-local to the summary buffers."
gnus-valid-select-methods))) gnus-valid-select-methods)))
(equal (nth 1 m1) (nth 1 m2))))))) (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) (defun gnus-server-equal (m1 m2)
"Say whether two methods are equal." "Say whether two methods are equal."
(let ((m1 (cond ((null m1) gnus-select-method) (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))) gnus-valid-select-methods)))
(defun gnus-similar-server-opened (method) (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) (while (and method opened)
(when (and (equal (cadr method) (cadaar opened)) (setq open (car (pop opened)))
(equal (car method) (caaar opened)) ;; Type and name are the same...
(not (equal method (caar opened)))) (when (and (equal (car method) (car open))
(setq method nil)) (equal (cadr method) (cadr open))
(pop opened)) ;; ... but the rest of the parameters differ.
(not (gnus-methods-sloppily-equal method open)))
(setq method nil)))
(not method))) (not method)))
(defun gnus-server-extend-method (group 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 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." prompt the user for the name of an NNTP server to use."
(interactive "P") (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)) (unless (byte-code-function-p (symbol-function 'gnus))
(message "You should byte-compile Gnus") (message "You should byte-compile Gnus")
(sit-for 2)) (sit-for 2))

View file

@ -45,8 +45,7 @@
(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string) (defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string)
(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string) (defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string)
(defalias 'mail-content-type-get 'rfc2231-get-value) (defalias 'mail-content-type-get 'rfc2231-get-value)
;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string) (defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
(defalias 'mail-header-encode-parameter 'rfc2231-encode-string)
(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) (defalias 'mail-header-remove-comments 'ietf-drums-remove-comments)
(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) (defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)

View file

@ -463,7 +463,7 @@ on your system, you could say something like:
(let ((extra (mail-header-extra header))) (let ((extra (mail-header-extra header)))
(while extra (while extra
(insert (symbol-name (caar extra)) (insert (symbol-name (caar extra))
": " (cdar extra) "\t") ": " (if (stringp (cdar extra)) (cdar extra) "") "\t")
(pop extra)))) (pop extra))))
(insert "\n") (insert "\n")
(backward-char 1) (backward-char 1)

View file

@ -66,6 +66,17 @@ Values are `ssl' and `network'.")
This is always done if the server supports UID EXPUNGE, but it's 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.") 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-connection-alist nil)
(defvoo nnimap-current-infos 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)) (delete-region (line-beginning-position) (line-end-position))
(insert (format "211 %s Article retrieved." article)) (insert (format "211 %s Article retrieved." article))
(forward-line 1) (forward-line 1)
(insert (format "Bytes: %d\n" bytes)) (insert (format "Chars: %d\n" bytes))
(when lines (when lines
(insert (format "Lines: %s\n" lines))) (insert (format "Lines: %s\n" lines)))
(re-search-forward "^\r$") (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)) (when (setq connection-result (nnimap-wait-for-connection))
(unless (equal connection-result "PREAUTH") (unless (equal connection-result "PREAUTH")
(if (not (setq credentials (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 nnimap-object nil)
(setq login-result (nnimap-command "LOGIN %S %S" (setq login-result (nnimap-command "LOGIN %S %S"
(car credentials) (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) (deffoo nnimap-request-article (article &optional group server to-buffer)
(with-current-buffer nntp-server-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) (when (stringp article)
(setq article (nnimap-find-article-by-message-id group article))) (setq article (nnimap-find-article-by-message-id group article)))
(when (and result (when (and result
@ -310,6 +329,14 @@ not done by default on servers that doesn't support that command.")
(erase-buffer) (erase-buffer)
(with-current-buffer (nnimap-buffer) (with-current-buffer (nnimap-buffer)
(erase-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 (setq result
(nnimap-command (nnimap-command
(if (member "IMAP4REV1" (nnimap-capabilities nnimap-object)) (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)) (goto-char (+ (point) bytes))
(delete-region (point) (point-max)) (delete-region (point) (point-max))
(nnheader-ms-strip-cr)) (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) (deffoo nnimap-request-group (group &optional server dont-check info)
(with-current-buffer nntp-server-buffer (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)) (goto-char (point-min))
(while (and (memq (process-status process) (while (and (memq (process-status process)
'(open run)) '(open run))
(not (re-search-forward "^\\* " nil t))) (not (re-search-forward "^\\* .*\n" nil t)))
(nnheader-accept-process-output process) (nnheader-accept-process-output process)
(goto-char (point-min))) (goto-char (point-min)))
(and (looking-at "[A-Z0-9]+") (forward-line -1)
(match-string 0)))) (and (looking-at "\\* \\([A-Z0-9]+\\)")
(match-string 1))))
(defun nnimap-wait-for-response (sequence &optional messagep) (defun nnimap-wait-for-response (sequence &optional messagep)
(goto-char (point-max)) (let ((process (get-buffer-process (current-buffer))))
(while (not (re-search-backward (format "^%d .*\n" sequence) (goto-char (point-max))
(max (point-min) (- (point) 500)) (while (and (memq (process-status process)
t)) '(open run))
(when messagep (not (re-search-backward (format "^%d .*\n" sequence)
(message "Read %dKB" (/ (buffer-size) 1000))) (max (point-min) (- (point) 500))
(nnheader-accept-process-output (get-buffer-process (current-buffer))) t)))
(goto-char (point-max)))) (when messagep
(message "Read %dKB" (/ (buffer-size) 1000)))
(nnheader-accept-process-output process)
(goto-char (point-max)))))
(defun nnimap-parse-response () (defun nnimap-parse-response ()
(let ((lines (split-string (nnimap-last-response-string) "\r\n" t)) (let ((lines (split-string (nnimap-last-response-string) "\r\n" t))