Synch with Gnus.

[elisp/gnus.git-] / lisp / mml.el

diff --git a/lisp/mml.el b/lisp/mml.el
index 64ba761..39f9dfa 100644 (file)
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -292,12 +292,16 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
          (if (and (not raw)
                   (member (car (split-string type "/")) '("text" "message")))
              (with-temp-buffer
+               (setq charset (mm-charset-to-coding-system 
+                              (cdr (assq 'charset cont))))
+               (if (eq charset 'ascii) (setq charset nil))
                (cond
                 ((cdr (assq 'buffer cont))
                  (insert-buffer-substring (cdr (assq 'buffer cont))))
                 ((and (setq filename (cdr (assq 'filename cont)))
                       (not (equal (cdr (assq 'nofile cont)) "yes")))
-                 (mm-insert-file-contents filename))
+                 (let ((coding-system-for-read charset))
+                   (mm-insert-file-contents filename)))
                 ((eq 'mml (car cont))
                  (insert (cdr (assq 'contents cont))))
                 (t
@@ -324,7 +328,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                    ;; ignore 0x1b, it is part of iso-2022-jp
                    (setq encoding (mm-body-7-or-8))))
                 (t 
-                 (setq charset (mm-encode-body))
+                 (setq charset (mm-encode-body charset))
                  (setq encoding (mm-body-encoding
                                  charset (cdr (assq 'encoding cont))))))
                (setq coded (buffer-string)))
@@ -347,7 +351,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
        (insert "Content-Type: message/external-body")
        (let ((parameters (mml-parameter-string
                           cont '(expiration size permission)))
-             (name (cdr (assq 'name cont))))
+             (name (cdr (assq 'name cont)))
+             (url (cdr (assq 'url cont))))
          (when name
            (setq name (mml-parse-file-name name))
            (if (stringp name)
@@ -365,6 +370,10 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                       (if (member (nth 0 name) '("ftp@" "anonymous@"))
                           "anon-ftp"
                         "ftp")))))      
+         (when url
+           (mml-insert-parameter
+            (mail-header-encode-parameter "url" url)
+            "access-type=url"))
          (when parameters
            (mml-insert-parameter-string
             cont '(expiration size permission))))
@@ -388,11 +397,12 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
            (let ((mml-boundary (mml-compute-boundary cont)))
              (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
                              type mml-boundary))
-             ;; Skip `multipart' and `type' elements.
-             (setq cont (cddr cont))
-             (while cont
-               (insert "\n--" mml-boundary "\n")
-               (mml-generate-mime-1 (pop cont)))
+             (let ((cont cont) part)
+               (while (setq part (pop cont))
+                 ;; Skip `multipart' and attributes.
+                 (when (and (consp part) (consp (cdr part)))
+                   (insert "\n--" mml-boundary "\n")
+                   (mml-generate-mime-1 part))))
              (insert "\n--" mml-boundary "--\n")))))
        (t
        (error "Invalid element: %S" cont)))
@@ -536,20 +546,22 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 ;;; Transforming MIME to MML
 ;;;
 
-(defun mime-to-mml ()
-  "Translate the current buffer (which should be a message) into MML."
+(defun mime-to-mml (&optional handles)
+  "Translate the current buffer (which should be a message) into MML.
+If HANDLES is non-nil, use it instead reparsing the buffer."
   ;; First decode the head.
   (save-restriction
     (message-narrow-to-head)
     (mail-decode-encoded-word-region (point-min) (point-max)))
-  (let ((handles (mm-dissect-buffer t)))
-    (goto-char (point-min))
-    (search-forward "\n\n" nil t)
-    (delete-region (point) (point-max))
-    (if (stringp (car handles))
-       (mml-insert-mime handles)
-      (mml-insert-mime handles t))
-    (mm-destroy-parts handles))
+  (unless handles
+    (setq handles (mm-dissect-buffer t)))
+  (goto-char (point-min))
+  (search-forward "\n\n" nil t)
+  (delete-region (point) (point-max))
+  (if (stringp (car handles))
+      (mml-insert-mime handles)
+    (mml-insert-mime handles t))
+  (mm-destroy-parts handles)
   (save-restriction
     (message-narrow-to-head)
     ;; Remove them, they are confusing.
@@ -590,10 +602,11 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (mapcar 'mml-insert-mime (cdr handle))
       (insert "<#/multipart>\n"))
      (textp
-      (let ((text (mm-get-part handle))
-           (charset (mail-content-type-get
+      (let ((charset (mail-content-type-get
                      (mm-handle-type handle) 'charset)))
-       (insert (mm-decode-string text charset)))
+       (if (eq charset 'gnus-decoded)
+           (mm-insert-part handle)
+         (insert (mm-decode-string (mm-get-part handle) charset))))
       (goto-char (point-max)))
      (t
       (insert "<#/part>\n")))))
@@ -608,7 +621,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (insert "<#part type=" (mm-handle-media-type handle)))
     (dolist (elem (append (cdr (mm-handle-type handle))
                          (cdr (mm-handle-disposition handle))))
-      (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))
+      (unless (symbolp (cdr elem))
+       (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
     (when (mm-handle-disposition handle)
       (insert " disposition=" (car (mm-handle-disposition handle))))
     (when buffer