T-gnus 6.14.3.
[elisp/gnus.git-] / lisp / mml.el
index 320f6aa..334cb8d 100644 (file)
@@ -1,5 +1,5 @@
 ;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
 (eval-and-compile
   (autoload 'message-make-message-id "message"))
 
-(defvar mml-generate-multipart-alist
-  nil
+(defvar mml-generate-multipart-alist nil
   "*Alist of multipart generation functions.
-
 Each entry has the form (NAME . FUNCTION), where
-NAME: is a string containing the name of the part (without the 
+NAME is a string containing the name of the part (without the 
 leading \"/multipart/\"),
-FUNCTION: is a Lisp function which is called to generate the part.
+FUNCTION is a Lisp function which is called to generate the part.
 
 The Lisp function has to supply the appropriate MIME headers and the
 contents of this part.")
@@ -260,9 +258,19 @@ one charsets.")
                        "<#!+/?\\(part\\|multipart\\|external\\)" nil t)
                  (delete-region (+ (match-beginning 0) 2)
                                 (+ (match-beginning 0) 3))))))
+           (when (string= (car (split-string type "/")) "message")
+             ;; message/rfc822 parts have to have their heads encoded.
+             (save-restriction
+               (message-narrow-to-head)
+               (let ((rfc2047-header-encoding-alist nil))
+                 (mail-encode-encoded-word-buffer))))
            (setq charset (mm-encode-body))
-           (setq encoding (mm-body-encoding charset 
-                                            (cdr (assq 'encoding cont))))
+           (setq encoding (mm-body-encoding
+                           charset
+                           (if (string= (car (split-string type "/"))
+                                        "message")
+                               '8bit
+                             (cdr (assq 'encoding cont)))))
            (setq coded (buffer-string)))
        (mm-with-unibyte-buffer
          (cond