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

8 files changed, 208 insertions, 145 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 620e017b38e..168280e8e24 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,47 @@
+2006-02-07  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * 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 <ari@mbf.ocn.ne.jp>.
+        (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  <Reiner.Steib@gmx.de>
+
+        * 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  <yamaoka@jpl.org>
+
+        * 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  <romain@orebokech.com>
 
         Update copyright notices of all files in the gnus directory.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b51ceff29a9..c15151729a0 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2267,38 +2267,37 @@ If PROMPT (the prefix), prompt for a coding system to use."
                            (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 @@ If READ-CHARSET, ask for a coding system."
             (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 @@ If READ-CHARSET, ask for a coding system."
             (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 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
         (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 --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index b275807c051..996c934191c 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -534,13 +534,13 @@ Postpone undisplaying of viewers for types in
                   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 @@ Postpone undisplaying of viewers for types in
                                        (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 @@ Postpone undisplaying of viewers for types in
                                          (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 @@ If RECURSIVE, search recursively."
         (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 @@ If RECURSIVE, search recursively."
       (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 --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index f8c34b370d6..0ceda113f49 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -664,10 +664,10 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
          "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 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
     (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 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
 
 (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 --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el
index 8de64ce7c99..aac75758c05 100644
--- a/lisp/gnus/rfc1843.el
+++ b/lisp/gnus/rfc1843.el
@@ -149,8 +149,7 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
           (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 --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index fb2d070328e..31c9f1ade94 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -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 @@ The list will be on the form
         (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 @@ The list will be on the form
                                (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 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
       (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 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
         (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 --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 04ef6b60f5f..a5f46bb79f4 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -50,7 +50,11 @@ instead."
   :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 --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el
index a7e53702fef..304a206a97f 100644
--- a/lisp/gnus/webmail.el
+++ b/lisp/gnus/webmail.el
@@ -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")