From bdaa75c74db6a3193515985146eaee5e9caa7ed0 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Mon, 20 Sep 2010 00:36:54 +0000 Subject: [PATCH] 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. --- doc/misc/gnus.texi | 5 ++- lisp/gnus/ChangeLog | 87 +++++++++++++++++++++++++++++++++++++- lisp/gnus/gnus-agent.el | 6 +-- lisp/gnus/gnus-art.el | 2 +- lisp/gnus/gnus-group.el | 14 +++--- lisp/gnus/gnus-html.el | 94 +++++++++++++++++++++++++---------------- lisp/gnus/gnus-int.el | 5 +-- lisp/gnus/gnus-score.el | 10 ++--- lisp/gnus/gnus-srvr.el | 2 +- lisp/gnus/gnus-start.el | 24 ++++++----- lisp/gnus/gnus-sum.el | 8 +++- lisp/gnus/gnus.el | 57 ++++++++++++++++++++++--- lisp/gnus/mail-parse.el | 3 +- lisp/gnus/nnheader.el | 2 +- lisp/gnus/nnimap.el | 84 +++++++++++++++++++++++++++++------- 15 files changed, 306 insertions(+), 97 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 7248897f05b..c4bccdc30a1 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -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 diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index e652d5462a2..4117a85ad8d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,5 +1,90 @@ 2010-09-19 Lars Magne Ingebrigtsen + * 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 + + * 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 + + * 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 + + * 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
    tags symbols. + +2010-09-19 Lars Magne Ingebrigtsen + + * 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. diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 781ea3b1a53..2a586e627c6 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -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) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index bfdb9bd6b63..7e51abb564e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -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-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-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." diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 5cc4ef68bd9..fa6ae51886c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -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-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-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. diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index d3e8c48f440..819a6d6f31a 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -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 "\\[gnus-score-edit-exit] to save edits")))) + 4 "%s" (substitute-command-keys + "\\\\[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-edit-exit] to save edits"))) + 4 "%s" (substitute-command-keys + "\\\\[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))))) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index dd5e51885c2..2966212de69 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -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-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 () diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 18553071bf0..f4745c184e5 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -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) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 3c3a0590536..c35cb2584c5 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7330,7 +7330,7 @@ in." (defun gnus-summary-describe-briefly () "Describe summary mode commands briefly." (interactive) - (gnus-message 6 (substitute-command-keys "\\\\[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-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 diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 2173d713d11..68f7f5f5e1a 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -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)) diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el index e6977705f21..169b70a266e 100644 --- a/lisp/gnus/mail-parse.el +++ b/lisp/gnus/mail-parse.el @@ -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) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 1bfdbeab9c4..03014e540c6 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -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) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index c27b3ec776b..b3a9e5bcdc4 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -66,6 +66,17 @@ Values are `ssl' and `network'.") This is always done if the server supports UID EXPUNGE, but it's not done by default on servers that doesn't support that command.") +(defvoo nnimap-authenticator nil + "How nnimap authenticate itself to the server. +Possible choices are nil (use default methods) or `anonymous'.") + +(defvoo nnimap-fetch-partial-articles nil + "If non-nil, nnimap will fetch partial articles. +If t, nnimap will fetch only the first part. If a string, it +will fetch all parts that have types that match that string. A +likely value would be \"text/\" to automatically fetch all +textual parts.") + (defvoo nnimap-connection-alist nil) (defvoo nnimap-current-infos nil) @@ -146,7 +157,7 @@ not done by default on servers that doesn't support that command.") (delete-region (line-beginning-position) (line-end-position)) (insert (format "211 %s Article retrieved." article)) (forward-line 1) - (insert (format "Bytes: %d\n" bytes)) + (insert (format "Chars: %d\n" bytes)) (when lines (insert (format "Lines: %s\n" lines))) (re-search-forward "^\r$") @@ -254,7 +265,14 @@ not done by default on servers that doesn't support that command.") (when (setq connection-result (nnimap-wait-for-connection)) (unless (equal connection-result "PREAUTH") (if (not (setq credentials - (nnimap-credentials nnimap-address ports))) + (if (eq nnimap-authenticator 'anonymous) + (list "anonymous" + (message-make-address)) + (nnimap-credentials + nnimap-address + (if nnimap-server-port + (cons (format "%s" nnimap-server-port) ports) + ports))))) (setq nnimap-object nil) (setq login-result (nnimap-command "LOGIN %S %S" (car credentials) @@ -302,7 +320,8 @@ not done by default on servers that doesn't support that command.") (deffoo nnimap-request-article (article &optional group server to-buffer) (with-current-buffer nntp-server-buffer - (let ((result (nnimap-possibly-change-group group server))) + (let ((result (nnimap-possibly-change-group group server)) + parts) (when (stringp article) (setq article (nnimap-find-article-by-message-id group article))) (when (and result @@ -310,6 +329,14 @@ not done by default on servers that doesn't support that command.") (erase-buffer) (with-current-buffer (nnimap-buffer) (erase-buffer) + (when nnimap-fetch-partial-articles + (if (eq nnimap-fetch-partial-articles t) + (setq parts '(1)) + (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) + (goto-char (point-min)) + (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) + (let ((structure (ignore-errors (read (current-buffer))))) + (setq parts (nnimap-find-wanted-parts structure)))))) (setq result (nnimap-command (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object)) @@ -331,7 +358,30 @@ not done by default on servers that doesn't support that command.") (goto-char (+ (point) bytes)) (delete-region (point) (point-max)) (nnheader-ms-strip-cr)) - t))))))) + (cons group article)))))))) + +(defun nnimap-find-wanted-parts (structure) + (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) + +(defun nnimap-find-wanted-parts-1 (structure prefix) + (let ((num 1) + parts) + (while (consp (car structure)) + (let ((sub (pop structure))) + (if (consp (car sub)) + (push (nnimap-find-wanted-parts-1 + sub (if (string= prefix "") + (number-to-string num) + (format "%s.%s" prefix num))) + parts) + (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))) + (when (string-match nnimap-fetch-partial-articles type) + (push (if (string= prefix "") + (number-to-string num) + (format "%s.%s" prefix num)) + parts))) + (incf num)))) + (nreverse parts))) (deffoo nnimap-request-group (group &optional server dont-check info) (with-current-buffer nntp-server-buffer @@ -825,21 +875,25 @@ not done by default on servers that doesn't support that command.") (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) - (not (re-search-forward "^\\* " nil t))) + (not (re-search-forward "^\\* .*\n" nil t))) (nnheader-accept-process-output process) (goto-char (point-min))) - (and (looking-at "[A-Z0-9]+") - (match-string 0)))) + (forward-line -1) + (and (looking-at "\\* \\([A-Z0-9]+\\)") + (match-string 1)))) (defun nnimap-wait-for-response (sequence &optional messagep) - (goto-char (point-max)) - (while (not (re-search-backward (format "^%d .*\n" sequence) - (max (point-min) (- (point) 500)) - t)) - (when messagep - (message "Read %dKB" (/ (buffer-size) 1000))) - (nnheader-accept-process-output (get-buffer-process (current-buffer))) - (goto-char (point-max)))) + (let ((process (get-buffer-process (current-buffer)))) + (goto-char (point-max)) + (while (and (memq (process-status process) + '(open run)) + (not (re-search-backward (format "^%d .*\n" sequence) + (max (point-min) (- (point) 500)) + t))) + (when messagep + (message "Read %dKB" (/ (buffer-size) 1000))) + (nnheader-accept-process-output process) + (goto-char (point-max))))) (defun nnimap-parse-response () (let ((lines (split-string (nnimap-last-response-string) "\r\n" t)) -- 2.39.2