# HG changeset patch # User Miles Bader # Date 1139373358 0 # Node ID d9dde5b81e71e07428b08818b2b19f313daff639 # Parent 2de3fcf6971523608043df65985fe0e224302d79 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-57 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 18-21) - Update from CVS - Merge from emacs--devo--0 diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/ChangeLog Wed Feb 08 04:35:58 2006 +0000 @@ -1,3 +1,47 @@ +2006-02-07 Katsumi Yamaoka + + * gnus-art.el (article-decode-charset): Don't use ignore-errors + when calling mail-header-parse-content-type. + (article-de-quoted-unreadable): Ditto. + (article-de-base64-unreadable): Ditto. + (article-wash-html): Ditto. + + * mm-decode.el (mm-dissect-buffer): Don't use ignore-errors when + calling mail-header-parse-content-type and + mail-header-parse-content-disposition. + (mm-find-raw-part-by-type): Don't use ignore-errors when calling + mail-header-parse-content-type. + + * mml.el (mml-insert-mime-headers): Use mml-insert-parameter to + insert charset and format parameters; encode description after + inserting it to buffer. + (mml-insert-parameter): Fold lines properly even if a parameter is + segmented into two or more lines; change the max column to 76. + + * rfc1843.el (rfc1843-decode-article-body): Don't use + ignore-errors when calling mail-header-parse-content-type. + + * rfc2231.el (rfc2231-parse-string): Return at least type if + possible; don't cause an error even if it fails in parsing of + parameters. Suggested by ARISAWA Akihiro . + (rfc2231-encode-string): Don't break lines at the beginning, leave + it to mml-insert-parameter. + + * webmail.el (webmail-yahoo-article): Don't use ignore-errors when + calling mail-header-parse-content-type. + +2006-02-06 Reiner Steib + + * spam-report.el (spam-report-gmane-use-article-number): Improve + doc string. + (spam-report-gmane-internal): Check if a suitable header was found + in the article. + +2006-02-04 Katsumi Yamaoka + + * rfc2231.el (rfc2231-parse-string): Revert 2006-02-03 change. + (rfc2231-encode-string): Make param*=value always begin with LWSP. + 2006-02-05 Romain Francoise Update copyright notices of all files in the gnus directory. diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/gnus-art.el Wed Feb 08 04:35:58 2006 +0000 @@ -2267,38 +2267,37 @@ (error)) gnus-newsgroup-ignored-charsets)) ct cte ctl charset format) - (save-excursion - (save-restriction - (article-narrow-to-head) - (setq ct (message-fetch-field "Content-Type" t) - cte (message-fetch-field "Content-Transfer-Encoding" t) - ctl (and ct (ignore-errors - (mail-header-parse-content-type ct))) - charset (cond - (prompt - (mm-read-coding-system "Charset to decode: ")) - (ctl - (mail-content-type-get ctl 'charset))) - format (and ctl (mail-content-type-get ctl 'format))) - (when cte - (setq cte (mail-header-strip cte))) - (if (and ctl (not (string-match "/" (car ctl)))) - (setq ctl nil)) - (goto-char (point-max))) - (forward-line 1) - (save-restriction - (narrow-to-region (point) (point-max)) - (when (and (eq mail-parse-charset 'gnus-decoded) - (eq (mm-body-7-or-8) '8bit)) - ;; The text code could have been decoded. - (setq charset mail-parse-charset)) - (when (and (or (not ctl) - (equal (car ctl) "text/plain")) - (not format)) ;; article with format will decode later. - (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) - (car ctl))))))) + (save-excursion + (save-restriction + (article-narrow-to-head) + (setq ct (message-fetch-field "Content-Type" t) + cte (message-fetch-field "Content-Transfer-Encoding" t) + ctl (and ct (mail-header-parse-content-type ct)) + charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ctl + (mail-content-type-get ctl 'charset))) + format (and ctl (mail-content-type-get ctl 'format))) + (when cte + (setq cte (mail-header-strip cte))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max))) + (forward-line 1) + (save-restriction + (narrow-to-region (point) (point-max)) + (when (and (eq mail-parse-charset 'gnus-decoded) + (eq (mm-body-7-or-8) '8bit)) + ;; The text code could have been decoded. + (setq charset mail-parse-charset)) + (when (and (or (not ctl) + (equal (car ctl) "text/plain")) + (not format)) ;; article with format will decode later. + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -2390,9 +2389,7 @@ (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) @@ -2420,9 +2417,7 @@ (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) @@ -2488,9 +2483,7 @@ (when (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (when (stringp charset) diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/mm-decode.el --- a/lisp/gnus/mm-decode.el Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/mm-decode.el Wed Feb 08 04:35:58 2006 +0000 @@ -534,13 +534,13 @@ loose-mime (mail-fetch-field "mime-version")) (setq ct (mail-fetch-field "content-type") - ctl (ignore-errors (mail-header-parse-content-type ct)) + ctl (and ct (mail-header-parse-content-type ct)) cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description") id (mail-fetch-field "content-id")) (unless from - (setq from (mail-fetch-field "from"))) + (setq from (mail-fetch-field "from"))) ;; FIXME: In some circumstances, this code is running within ;; an unibyte macro. mail-extract-address-components ;; creates unibyte buffers. This `if', though not a perfect @@ -557,7 +557,7 @@ (mail-header-remove-comments cte))))) no-strict-mime - (and cd (ignore-errors (mail-header-parse-content-disposition cd))) + (and cd (mail-header-parse-content-disposition cd)) description) (setq type (split-string (car ctl) "/")) (setq subtype (cadr type) @@ -592,8 +592,7 @@ (mail-header-remove-comments cte))))) no-strict-mime - (and cd (ignore-errors - (mail-header-parse-content-disposition cd))) + (and cd (mail-header-parse-content-disposition cd)) description id) ctl)))) (when id @@ -1401,9 +1400,8 @@ (save-excursion (save-restriction (narrow-to-region start (1- (point))) - (when (let ((ctl (ignore-errors - (mail-header-parse-content-type - (mail-fetch-field "content-type"))))) + (when (let* ((ct (mail-fetch-field "content-type")) + (ctl (and ct (mail-header-parse-content-type ct)))) (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) @@ -1414,9 +1412,8 @@ (save-excursion (save-restriction (narrow-to-region start end) - (when (let ((ctl (ignore-errors - (mail-header-parse-content-type - (mail-fetch-field "content-type"))))) + (when (let* ((ct (mail-fetch-field "content-type")) + (ctl (and ct (mail-header-parse-content-type ct)))) (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/mml.el --- a/lisp/gnus/mml.el Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/mml.el Wed Feb 08 04:35:58 2006 +0000 @@ -664,10 +664,10 @@ "Can't encode a part with several charsets")) (insert "Content-Type: " type) (when charset - (insert "; " (mail-header-encode-parameter - "charset" (symbol-name charset)))) + (mml-insert-parameter + (mail-header-encode-parameter "charset" (symbol-name charset)))) (when flowed - (insert "; format=flowed")) + (mml-insert-parameter "format=flowed")) (when parameters (mml-insert-parameter-string cont mml-content-type-parameters)) @@ -687,8 +687,11 @@ (unless (eq encoding '7bit) (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (when (setq description (cdr (assq 'description cont))) - (insert "Content-Description: " - (mail-encode-encoded-word-string description) "\n")))) + (insert "Content-Description: ") + (setq description (prog1 + (point) + (insert description "\n"))) + (mail-encode-encoded-word-region description (point))))) (defun mml-parameter-string (cont types) (let ((string "") @@ -841,14 +844,20 @@ (defun mml-insert-parameter (&rest parameters) "Insert PARAMETERS in a nice way." - (dolist (param parameters) - (insert ";") - (let ((point (point))) + (let (start end) + (dolist (param parameters) + (insert ";") + (setq start (point)) (insert " " param) - (when (> (current-column) 71) - (goto-char point) - (insert "\n ") - (end-of-line))))) + (setq end (point)) + (goto-char start) + (end-of-line) + (if (> (current-column) 76) + (progn + (goto-char start) + (insert "\n") + (goto-char (1+ end))) + (goto-char end))))) ;;; ;;; Mode for inserting and editing MML forms diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/rfc1843.el --- a/lisp/gnus/rfc1843.el Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/rfc1843.el Wed Feb 08 04:35:58 2006 +0000 @@ -149,8 +149,7 @@ (let* ((inhibit-point-motion-hooks t) (case-fold-search t) (ct (message-fetch-field "Content-Type" t)) - (ctl (and ct (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (if (and ctl (not (string-match "/" (car ctl)))) (setq ctl nil)) (goto-char (point-max)) diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/rfc2231.el --- a/lisp/gnus/rfc2231.el Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/rfc2231.el Wed Feb 08 04:35:58 2006 +0000 @@ -41,10 +41,13 @@ N.B. This is in violation with RFC2047, but it seem to be in common use." (rfc2231-parse-string (rfc2047-decode-string string))) -(defun rfc2231-parse-string (string) +(defun rfc2231-parse-string (string &optional signal-error) "Parse STRING and return a list. The list will be on the form - `(name (attribute . value) (attribute . value)...)" + `(name (attribute . value) (attribute . value)...)'. + +If the optional SIGNAL-ERROR is non-nil, signal an error when this +function fails in parsing of parameters." (with-temp-buffer (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token)) (stoken (ietf-drums-token-to-list ietf-drums-tspecials)) @@ -74,63 +77,68 @@ (setq type (downcase (buffer-substring (point) (progn (forward-sexp 1) (point))))) ;; Do the params - (while (not (eobp)) - (setq c (char-after)) - (unless (eq c ?\;) - (error "Invalid header: %s" string)) - (forward-char 1) - ;; If c in nil, then this is an invalid header, but - ;; since elm generates invalid headers on this form, - ;; we allow it. - (when (setq c (char-after)) - (if (and (memq c ttoken) - (not (memq c stoken))) - (setq attribute - (intern - (downcase - (buffer-substring - (point) (progn (forward-sexp 1) (point)))))) - (error "Invalid header: %s" string)) - (setq c (char-after)) - (when (eq c ?*) - (forward-char 1) - (setq c (char-after)) - (if (not (memq c ntoken)) - (setq encoded t - number nil) - (setq number - (string-to-number - (buffer-substring - (point) (progn (forward-sexp 1) (point))))) + (condition-case err + (progn + (while (not (eobp)) (setq c (char-after)) - (when (eq c ?*) - (setq encoded t) + (unless (eq c ?\;) + (error "Invalid header: %s" string)) + (forward-char 1) + ;; If c in nil, then this is an invalid header, but + ;; since elm generates invalid headers on this form, + ;; we allow it. + (when (setq c (char-after)) + (if (and (memq c ttoken) + (not (memq c stoken))) + (setq attribute + (intern + (downcase + (buffer-substring + (point) (progn (forward-sexp 1) (point)))))) + (error "Invalid header: %s" string)) + (setq c (char-after)) + (when (eq c ?*) + (forward-char 1) + (setq c (char-after)) + (if (not (memq c ntoken)) + (setq encoded t + number nil) + (setq number + (string-to-number + (buffer-substring + (point) (progn (forward-sexp 1) (point))))) + (setq c (char-after)) + (when (eq c ?*) + (setq encoded t) + (forward-char 1) + (setq c (char-after))))) + ;; See if we have any previous continuations. + (when (and prev-attribute + (not (eq prev-attribute attribute))) + (push (cons prev-attribute + (if prev-encoded + (rfc2231-decode-encoded-string prev-value) + prev-value)) + parameters) + (setq prev-attribute nil + prev-value "" + prev-encoded nil)) + (unless (eq c ?=) + (error "Invalid header: %s" string)) (forward-char 1) - (setq c (char-after))))) - ;; See if we have any previous continuations. - (when (and prev-attribute - (not (eq prev-attribute attribute))) - (push (cons prev-attribute - (if prev-encoded - (rfc2231-decode-encoded-string prev-value) - prev-value)) - parameters) - (setq prev-attribute nil - prev-value "" - prev-encoded nil)) - (unless (eq c ?=) - (error "Invalid header: %s" string)) - (forward-char 1) - (setq c (char-after)) - (cond - ((eq c ?\") - (setq value - (buffer-substring (1+ (point)) - (progn (forward-sexp 1) (1- (point)))))) - ((and (or (memq c ttoken) - (> c ?\177)) ;; EXTENSION: Support non-ascii chars. - (not (memq c stoken))) - (setq value (buffer-substring + (setq c (char-after)) + (cond + ((eq c ?\") + (setq value (buffer-substring (1+ (point)) + (progn + (forward-sexp 1) + (1- (point)))))) + ((and (or (memq c ttoken) + ;; EXTENSION: Support non-ascii chars. + (> c ?\177)) + (not (memq c stoken))) + (setq value + (buffer-substring (point) (progn (forward-sexp) @@ -142,25 +150,31 @@ (forward-char 1) (forward-sexp)) (point))))) - (t - (error "Invalid header: %s" string))) - (if number - (setq prev-attribute attribute - prev-value (concat prev-value value) - prev-encoded encoded) - (push (cons attribute - (if encoded - (rfc2231-decode-encoded-string value) - value)) - parameters)))) + (t + (error "Invalid header: %s" string))) + (if number + (setq prev-attribute attribute + prev-value (concat prev-value value) + prev-encoded encoded) + (push (cons attribute + (if encoded + (rfc2231-decode-encoded-string value) + value)) + parameters)))) - ;; Take care of any final continuations. - (when prev-attribute - (push (cons prev-attribute - (if prev-encoded - (rfc2231-decode-encoded-string prev-value) - prev-value)) - parameters)) + ;; Take care of any final continuations. + (when prev-attribute + (push (cons prev-attribute + (if prev-encoded + (rfc2231-decode-encoded-string prev-value) + prev-value)) + parameters))) + (error + (setq parameters nil) + (if signal-error + (signal (car err) (cdr err)) + ;;(message "%s" (error-message-string err)) + ))) (when type `(,type ,@(nreverse parameters))))))) @@ -189,12 +203,15 @@ (buffer-string)))) (defun rfc2231-encode-string (param value) - "Return and PARAM=VALUE string encoded according to RFC2231." + "Return and PARAM=VALUE string encoded according to RFC2231. +Use `mml-insert-parameter' or `mml-insert-parameter-string' to insert +the result of this function." (let ((control (ietf-drums-token-to-list ietf-drums-no-ws-ctl-token)) (tspecial (ietf-drums-token-to-list ietf-drums-tspecials)) (special (ietf-drums-token-to-list "*'%\n\t")) (ascii (ietf-drums-token-to-list ietf-drums-text-token)) (num -1) + ;; Don't make lines exceeding 76 column. (limit (- 74 (length param))) spacep encodep charsetp charset broken) (with-temp-buffer @@ -241,7 +258,7 @@ (if (not broken) (insert param "*=") (while (not (eobp)) - (insert (if (>= num 0) " " "\n ") + (insert (if (>= num 0) " " "") param "*" (format "%d" (incf num)) "*=") (forward-line 1)))) (spacep diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/spam-report.el --- a/lisp/gnus/spam-report.el Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/spam-report.el Wed Feb 08 04:35:58 2006 +0000 @@ -50,7 +50,11 @@ :group 'spam-report) (defcustom spam-report-gmane-use-article-number t - "Whether the article number (faster!) or the header should be used." + "Whether the article number (faster!) or the header should be used. + +You must set this to nil if you don't read Gmane groups directly +from news.gmane.org, e.g. when using local newsserver such as +leafnode." :type 'boolean :group 'spam-report) diff -r 2de3fcf69715 -r d9dde5b81e71 lisp/gnus/webmail.el --- a/lisp/gnus/webmail.el Wed Feb 08 02:41:23 2006 +0000 +++ b/lisp/gnus/webmail.el Wed Feb 08 04:35:58 2006 +0000 @@ -637,7 +637,7 @@ (goto-char (point-min)) (delete-blank-lines) (setq ct (mail-fetch-field "content-type") - ctl (ignore-errors (mail-header-parse-content-type ct)) + ctl (and ct (mail-header-parse-content-type ct)) ;;cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") description (mail-fetch-field "content-description")