* 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(at)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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 09a9ecb..af50b10 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,35 @@
+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
 2006-02-06  Reiner Steib  <Reiner.Steib@gmx.de>
 
        * spam-report.el (spam-report-gmane-use-article-number): Improve

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 8c72560..429a93b 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -2320,38 +2320,37 @@ If PROMPT (the prefix), prompt for a coding system to use."
                           (error))
                         gnus-newsgroup-ignored-charsets))
        ct cte ctl charset format)
                           (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."
 
 (defun article-decode-encoded-words ()
   "Remove encoded-word encoding from headers."


@@ -2443,9 +2442,7 @@ If READ-CHARSET, ask for a coding system."
            (setq type
                  (gnus-fetch-field "content-transfer-encoding"))
            (let* ((ct (gnus-fetch-field "content-type"))
            (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)
              (setq charset (and ctl
                                 (mail-content-type-get ctl 'charset)))
              (if (stringp charset)


@@ -2473,9 +2470,7 @@ If READ-CHARSET, ask for a coding system."
            (setq type
                  (gnus-fetch-field "content-transfer-encoding"))
            (let* ((ct (gnus-fetch-field "content-type"))
            (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)
              (setq charset (and ctl
                                 (mail-content-type-get ctl 'charset)))
              (if (stringp charset)


@@ -2541,9 +2536,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"))
        (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)
              (setq charset (and ctl
                                 (mail-content-type-get ctl 'charset)))
              (when (stringp charset)

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 4d030f8..28e67a9 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/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")
                  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
                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
          ;; 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


@@ -553,7 +553,7 @@ Postpone undisplaying of viewers for types in
           (list mm-dissect-default-type)
           (and cte (intern (downcase (mail-header-strip cte))))
           no-strict-mime
           (list mm-dissect-default-type)
           (and cte (intern (downcase (mail-header-strip 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)
           description)
        (setq type (split-string (car ctl) "/"))
        (setq subtype (cadr type)


@@ -586,8 +586,7 @@ Postpone undisplaying of viewers for types in
             ctl
             (and cte (intern (downcase (mail-header-strip cte))))
             no-strict-mime
             ctl
             (and cte (intern (downcase (mail-header-strip 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
             description id)
            ctl))))
        (when id


@@ -1396,9 +1395,8 @@ If RECURSIVE, search recursively."
        (save-excursion
          (save-restriction
            (narrow-to-region start (1- (point)))
        (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)))
                    (if notp
                        (not (equal (car ctl) type))
                      (equal (car ctl) type)))


@@ -1409,9 +1407,8 @@ If RECURSIVE, search recursively."
       (save-excursion
        (save-restriction
          (narrow-to-region start end)
       (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)))
                  (if notp
                      (not (equal (car ctl) type))
                    (equal (car ctl) type)))

diff --git a/lisp/mml.el b/lisp/mml.el
index ea1bc29..2f6aa55 100644 (file)
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -675,10 +675,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
         "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
       (when flowed

-       (insert "; format=flowed"))
+       (mml-insert-parameter "format=flowed"))

       (when parameters
        (mml-insert-parameter-string
         cont mml-content-type-parameters))
       (when parameters
        (mml-insert-parameter-string
         cont mml-content-type-parameters))


@@ -698,8 +698,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)))
     (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 "")
 
 (defun mml-parameter-string (cont types)
   (let ((string "")


@@ -852,14 +855,20 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
 
 (defun mml-insert-parameter (&rest parameters)
   "Insert PARAMETERS in a nice way."
 
 (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)
       (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
 
 ;;;
 ;;; Mode for inserting and editing MML forms

diff --git a/lisp/rfc1843.el b/lisp/rfc1843.el
index 55150fb..aac7575 100644 (file)
--- a/lisp/rfc1843.el
+++ b/lisp/rfc1843.el
@@ -1,7 +1,7 @@
 ;;; rfc1843.el --- HZ (rfc1843) decoding
 
 ;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004,
 ;;; rfc1843.el --- HZ (rfc1843) decoding
 
 ;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004,

-;;   2005 Free Software Foundation, Inc.
+;;   2005, 2006 Free Software Foundation, Inc.

 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: news HZ HZ+ mail i18n
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: news HZ HZ+ mail i18n


@@ -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))
          (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))
            (if (and ctl (not (string-match "/" (car ctl))))
                (setq ctl nil))
            (goto-char (point-max))

diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el
index 799fb8f..147910d 100644 (file)
--- a/lisp/rfc2231.el
+++ b/lisp/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)))
 
 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
   "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))
   (with-temp-buffer
     (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
          (stoken (ietf-drums-token-to-list ietf-drums-tspecials))


@@ -70,63 +73,68 @@ The list will be on the form
        (setq type (downcase (buffer-substring
                              (point) (progn (forward-sexp 1) (point)))))
        ;; Do the params
        (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))
                (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)
                  (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)
                           (point)
                           (progn
                             (forward-sexp)


@@ -138,25 +146,31 @@ The list will be on the form
                               (forward-char 1)
                               (forward-sexp))
                             (point)))))
                               (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)))))))
 
        (when type
          `(,type ,@(nreverse parameters)))))))


@@ -185,12 +199,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)
       (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)
   (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
        (limit (- 74 (length param)))
        spacep encodep charsetp charset broken)
     (with-temp-buffer


@@ -235,19 +252,19 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
            (forward-char 1)))
        (goto-char (point-min))
        (if (not broken)
            (forward-char 1)))
        (goto-char (point-min))
        (if (not broken)

-           (insert "\n " param "*=")
+           (insert param "*=")

          (while (not (eobp))
          (while (not (eobp))

-           (insert (if (>= num 0) " " "\n ")
+           (insert (if (>= num 0) " " "")

                    param "*" (format "%d" (incf num)) "*=")
            (forward-line 1))))
        (spacep
        (goto-char (point-min))
                    param "*" (format "%d" (incf num)) "*=")
            (forward-line 1))))
        (spacep
        (goto-char (point-min))

-       (insert "\n " param "=\"")
+       (insert param "=\"")

        (goto-char (point-max))
        (insert "\""))
        (t
        (goto-char (point-min))
        (goto-char (point-max))
        (insert "\""))
        (t
        (goto-char (point-min))

-       (insert "\n " param "=")))
+       (insert param "=")))

       (buffer-string))))
 
 (provide 'rfc2231)
       (buffer-string))))
 
 (provide 'rfc2231)

diff --git a/lisp/webmail.el b/lisp/webmail.el
index e9bc074..304a206 100644 (file)
--- a/lisp/webmail.el
+++ b/lisp/webmail.el
@@ -1,7 +1,7 @@
 ;;; webmail.el --- interface of web mail
 
 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
 ;;; webmail.el --- interface of web mail
 
 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,

-;;   2005 Free Software Foundation, Inc.
+;;   2005, 2006 Free Software Foundation, Inc.

 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: hotmail netaddress my-deja netscape
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: hotmail netaddress my-deja netscape


@@ -637,7 +637,7 @@
          (goto-char (point-min))
          (delete-blank-lines)
          (setq ct (mail-fetch-field "content-type")
          (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")
                ;;cte (mail-fetch-field "content-transfer-encoding")
                cd (mail-fetch-field "content-disposition")
                description (mail-fetch-field "content-description")