Mercurial > emacs
changeset 110433:33cf78a271ef
Merge changes made in Gnus trunk.
mail-parse.el (mail-header-encode-parameter): Define as rfc2045-encode-string.
nnheader.el (nnheader-insert-nov): Protect against junk appearing in the extra mail headers.
gnus-html.el: Prefetch and html washing additions.
gnus-html.el (gnus-html-prefetch-images): Fix up the url-retrieve calling conventions so that prefetch doesn't bug out.
Pass proper format strings to gnus-message.
nnimap.el: Allow anonymous login.
nnimap.el (nnimap-transform-headers): The chars header is called Chars not Bytes.
nnimap.el (nnimap-wait-for-response): Don't infloop if the IMAP connection drops.
gnus-start.el (gnus-get-unread-articles): Call `gnus-open-server' on each method before trying to scan them etc.
gnus-sum.el (gnus-summary-update-mark): Replace subst-char-in-region by subst-char-in-region.
gnus.el (gnus-similar-server-opened): Refactor a bit and add comments.
gnus.el: Fix a speed regression based in methods that were similar weren't the same.
gnus.el (gnus): When using the development version of Gnus, load the gnus-load file.
nnimap.el (nnimap-open-connection): When looking for credentials, also use the nnimap-server-port.
nnimap.el (nnimap-request-article): Return the group/article number, so that Gnus `^' works as expected.
nnimap.el (nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants them.
gnus-start.el (gnus-ignored-newsgroups): Remove [] from the list of bogus characters.
gnus-html.el (gnus-html-image-fetched): Protect against the data not arriving.
nnimap.el (nnimap-wait-for-connection): Avoid a race condition while waiting for the connection string.
gnus.texi (Required Back End Functions): Document INFO.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Mon, 20 Sep 2010 00:36:54 +0000 |
| parents | 6b2714f6bd1f |
| children | ec099872cdc4 |
| files | doc/misc/gnus.texi lisp/gnus/ChangeLog lisp/gnus/gnus-agent.el lisp/gnus/gnus-art.el lisp/gnus/gnus-group.el lisp/gnus/gnus-html.el lisp/gnus/gnus-int.el lisp/gnus/gnus-score.el lisp/gnus/gnus-srvr.el lisp/gnus/gnus-start.el lisp/gnus/gnus-sum.el lisp/gnus/gnus.el lisp/gnus/mail-parse.el lisp/gnus/nnheader.el lisp/gnus/nnimap.el |
| diffstat | 15 files changed, 306 insertions(+), 97 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/gnus.texi Mon Sep 20 02:26:22 2010 +0200 +++ b/doc/misc/gnus.texi Mon Sep 20 00:36:54 2010 +0000 @@ -29672,7 +29672,7 @@ 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 @@ 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
--- a/lisp/gnus/ChangeLog Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/ChangeLog Mon Sep 20 00:36:54 2010 +0000 @@ -1,5 +1,90 @@ 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.
--- a/lisp/gnus/gnus-agent.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-agent.el Mon Sep 20 00:36:54 2010 +0000 @@ -2377,7 +2377,7 @@ (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 @@ 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 @@ 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)
--- a/lisp/gnus/gnus-art.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-art.el Mon Sep 20 00:36:54 2010 +0000 @@ -6406,7 +6406,7 @@ (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."
--- a/lisp/gnus/gnus-group.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-group.el Mon Sep 20 00:36:54 2010 +0000 @@ -1273,7 +1273,7 @@ (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 @@ (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 @@ (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 @@ (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.
--- a/lisp/gnus/gnus-html.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-html.el Mon Sep 20 00:36:54 2010 +0000 @@ -114,6 +114,7 @@ "-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 @@ ;; 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 @@ (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 @@ ;;;###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)
--- a/lisp/gnus/gnus-int.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-int.el Mon Sep 20 00:36:54 2010 +0000 @@ -245,9 +245,8 @@ (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)
--- a/lisp/gnus/gnus-score.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-score.el Mon Sep 20 00:36:54 2010 +0000 @@ -1114,8 +1114,8 @@ (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 @@ (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 err (progn (ding) - (gnus-message 3 err) + (gnus-message 3 "%s" err) (sit-for 2) nil) alist)))))
--- a/lisp/gnus/gnus-srvr.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-srvr.el Mon Sep 20 00:36:54 2010 +0000 @@ -976,7 +976,7 @@ (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 ()
--- a/lisp/gnus/gnus-start.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-start.el Mon Sep 20 00:36:54 2010 +0000 @@ -268,7 +268,7 @@ (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 @@ (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 (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 @@ (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)
--- a/lisp/gnus/gnus-sum.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus-sum.el Mon Sep 20 00:36:54 2010 +0000 @@ -7330,7 +7330,7 @@ (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 @@ ;; 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
--- a/lisp/gnus/gnus.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/gnus.el Mon Sep 20 00:36:54 2010 +0000 @@ -3678,6 +3678,41 @@ 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 @@ 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 @@ 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))
--- a/lisp/gnus/mail-parse.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/mail-parse.el Mon Sep 20 00:36:54 2010 +0000 @@ -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)
--- a/lisp/gnus/nnheader.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/nnheader.el Mon Sep 20 00:36:54 2010 +0000 @@ -463,7 +463,7 @@ (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)
--- a/lisp/gnus/nnimap.el Mon Sep 20 02:26:22 2010 +0200 +++ b/lisp/gnus/nnimap.el Mon Sep 20 00:36:54 2010 +0000 @@ -66,6 +66,17 @@ This is always done if the server supports UID EXPUNGE, but it's not done by default on servers that doesn't support that command.") +(defvoo nnimap-authenticator nil + "How nnimap authenticate itself to the server. +Possible choices are nil (use default methods) or `anonymous'.") + +(defvoo nnimap-fetch-partial-articles nil + "If non-nil, nnimap will fetch partial articles. +If t, nnimap will fetch only the first part. If a string, it +will fetch all parts that have types that match that string. A +likely value would be \"text/\" to automatically fetch all +textual parts.") + (defvoo nnimap-connection-alist nil) (defvoo nnimap-current-infos nil) @@ -146,7 +157,7 @@ (delete-region (line-beginning-position) (line-end-position)) (insert (format "211 %s Article retrieved." article)) (forward-line 1) - (insert (format "Bytes: %d\n" bytes)) + (insert (format "Chars: %d\n" bytes)) (when lines (insert (format "Lines: %s\n" lines))) (re-search-forward "^\r$") @@ -254,7 +265,14 @@ (when (setq connection-result (nnimap-wait-for-connection)) (unless (equal connection-result "PREAUTH") (if (not (setq credentials - (nnimap-credentials nnimap-address ports))) + (if (eq nnimap-authenticator 'anonymous) + (list "anonymous" + (message-make-address)) + (nnimap-credentials + nnimap-address + (if nnimap-server-port + (cons (format "%s" nnimap-server-port) ports) + ports))))) (setq nnimap-object nil) (setq login-result (nnimap-command "LOGIN %S %S" (car credentials) @@ -302,7 +320,8 @@ (deffoo nnimap-request-article (article &optional group server to-buffer) (with-current-buffer nntp-server-buffer - (let ((result (nnimap-possibly-change-group group server))) + (let ((result (nnimap-possibly-change-group group server)) + parts) (when (stringp article) (setq article (nnimap-find-article-by-message-id group article))) (when (and result @@ -310,6 +329,14 @@ (erase-buffer) (with-current-buffer (nnimap-buffer) (erase-buffer) + (when nnimap-fetch-partial-articles + (if (eq nnimap-fetch-partial-articles t) + (setq parts '(1)) + (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) + (goto-char (point-min)) + (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) + (let ((structure (ignore-errors (read (current-buffer))))) + (setq parts (nnimap-find-wanted-parts structure)))))) (setq result (nnimap-command (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object)) @@ -331,7 +358,30 @@ (goto-char (+ (point) bytes)) (delete-region (point) (point-max)) (nnheader-ms-strip-cr)) - t))))))) + (cons group article)))))))) + +(defun nnimap-find-wanted-parts (structure) + (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) + +(defun nnimap-find-wanted-parts-1 (structure prefix) + (let ((num 1) + parts) + (while (consp (car structure)) + (let ((sub (pop structure))) + (if (consp (car sub)) + (push (nnimap-find-wanted-parts-1 + sub (if (string= prefix "") + (number-to-string num) + (format "%s.%s" prefix num))) + parts) + (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))) + (when (string-match nnimap-fetch-partial-articles type) + (push (if (string= prefix "") + (number-to-string num) + (format "%s.%s" prefix num)) + parts))) + (incf num)))) + (nreverse parts))) (deffoo nnimap-request-group (group &optional server dont-check info) (with-current-buffer nntp-server-buffer @@ -825,21 +875,25 @@ (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) - (not (re-search-forward "^\\* " nil t))) + (not (re-search-forward "^\\* .*\n" nil t))) (nnheader-accept-process-output process) (goto-char (point-min))) - (and (looking-at "[A-Z0-9]+") - (match-string 0)))) + (forward-line -1) + (and (looking-at "\\* \\([A-Z0-9]+\\)") + (match-string 1)))) (defun nnimap-wait-for-response (sequence &optional messagep) - (goto-char (point-max)) - (while (not (re-search-backward (format "^%d .*\n" sequence) - (max (point-min) (- (point) 500)) - t)) - (when messagep - (message "Read %dKB" (/ (buffer-size) 1000))) - (nnheader-accept-process-output (get-buffer-process (current-buffer))) - (goto-char (point-max)))) + (let ((process (get-buffer-process (current-buffer)))) + (goto-char (point-max)) + (while (and (memq (process-status process) + '(open run)) + (not (re-search-backward (format "^%d .*\n" sequence) + (max (point-min) (- (point) 500)) + t))) + (when messagep + (message "Read %dKB" (/ (buffer-size) 1000))) + (nnheader-accept-process-output process) + (goto-char (point-max))))) (defun nnimap-parse-response () (let ((lines (split-string (nnimap-last-response-string) "\r\n" t))