Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-37
[gnus] / lisp / mml.el
index de52030..1b43f68 100644 (file)
@@ -1,5 +1,5 @@
 ;;; mml.el --- A package for parsing and validating MML documents
 ;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 (eval-and-compile
   (autoload 'message-make-message-id "message")
   (autoload 'gnus-setup-posting-charset "gnus-msg")
 (eval-and-compile
   (autoload 'message-make-message-id "message")
   (autoload 'gnus-setup-posting-charset "gnus-msg")
-  (autoload 'gnus-add-minor-mode "gnus-ems")
   (autoload 'gnus-make-local-hook "gnus-util")
   (autoload 'message-fetch-field "message")
   (autoload 'gnus-make-local-hook "gnus-util")
   (autoload 'message-fetch-field "message")
+  (autoload 'message-mark-active-p "message")
   (autoload 'fill-flowed-encode "flow-fill")
   (autoload 'fill-flowed-encode "flow-fill")
-  (autoload 'message-posting-charset "message"))
+  (autoload 'message-posting-charset "message")
+  (autoload 'x-dnd-get-local-file-name "x-dnd"))
 
 (defcustom mml-content-type-parameters
   '(name access-type expiration size permission format)
   "*A list of acceptable parameters in MML tag.
 These parameters are generated in Content-Type header if exists."
 
 (defcustom mml-content-type-parameters
   '(name access-type expiration size permission format)
   "*A list of acceptable parameters in MML tag.
 These parameters are generated in Content-Type header if exists."
+  :version "22.1"
   :type '(repeat (symbol :tag "Parameter"))
   :group 'message)
 
   :type '(repeat (symbol :tag "Parameter"))
   :group 'message)
 
@@ -51,9 +53,17 @@ These parameters are generated in Content-Type header if exists."
   '(filename creation-date modification-date read-date)
   "*A list of acceptable parameters in MML tag.
 These parameters are generated in Content-Disposition header if exists."
   '(filename creation-date modification-date read-date)
   "*A list of acceptable parameters in MML tag.
 These parameters are generated in Content-Disposition header if exists."
+  :version "22.1"
   :type '(repeat (symbol :tag "Parameter"))
   :group 'message)
 
   :type '(repeat (symbol :tag "Parameter"))
   :group 'message)
 
+(defcustom mml-insert-mime-headers-always nil
+  "If non-nil, always put Content-Type: text/plain at top of empty parts.
+It is necessary to work against a bug in certain clients."
+  :version "22.1"
+  :type 'boolean
+  :group 'message)
+
 (defvar mml-tweak-type-alist nil
   "A list of (TYPE . FUNCTION) for tweaking MML parts.
 TYPE is a string containing a regexp to match the MIME type.  FUNCTION
 (defvar mml-tweak-type-alist nil
   "A list of (TYPE . FUNCTION) for tweaking MML parts.
 TYPE is a string containing a regexp to match the MIME type.  FUNCTION
@@ -125,19 +135,15 @@ one charsets.")
 
 (defun mml-destroy-buffers ()
   (let (kill-buffer-hook)
 
 (defun mml-destroy-buffers ()
   (let (kill-buffer-hook)
-    (mapcar 'kill-buffer mml-buffer-list)
+    (mapc 'kill-buffer mml-buffer-list)
     (setq mml-buffer-list nil)))
 
 (defun mml-parse ()
   "Parse the current buffer as an MML document."
   (save-excursion
     (goto-char (point-min))
     (setq mml-buffer-list nil)))
 
 (defun mml-parse ()
   "Parse the current buffer as an MML document."
   (save-excursion
     (goto-char (point-min))
-    (let ((table (syntax-table)))
-      (unwind-protect
-         (progn
-           (set-syntax-table mml-syntax-table)
-           (mml-parse-1))
-       (set-syntax-table table)))))
+    (with-syntax-table mml-syntax-table
+      (mml-parse-1))))
 
 (defun mml-parse-1 ()
   "Parse the current buffer as an MML document."
 
 (defun mml-parse-1 ()
   "Parse the current buffer as an MML document."
@@ -159,9 +165,8 @@ one charsets.")
               (method (cdr (assq 'method taginfo)))
               tags)
          (save-excursion
               (method (cdr (assq 'method taginfo)))
               tags)
          (save-excursion
-           (if
-               (re-search-forward
-                "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
+           (if (re-search-forward
+                "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t)
                (setq secure-mode "multipart")
              (setq secure-mode "part")))
          (save-excursion
                (setq secure-mode "multipart")
              (setq secure-mode "part")))
          (save-excursion
@@ -392,22 +397,25 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (cond
        ((or (eq (car cont) 'part) (eq (car cont) 'mml))
        (let ((raw (cdr (assq 'raw cont)))
       (cond
        ((or (eq (car cont) 'part) (eq (car cont) 'mml))
        (let ((raw (cdr (assq 'raw cont)))
-             coded encoding charset filename type flowed)
-         (setq type (or (cdr (assq 'type cont)) "text/plain"))
+             type charset coding filename encoding flowed coded)
+         (setq type (or (cdr (assq 'type cont)) "text/plain")
+               charset (cdr (assq 'charset cont))
+               coding (mm-charset-to-coding-system charset))
+         (cond ((eq coding 'ascii)
+                (setq charset nil
+                      coding nil))
+               (charset
+                (setq charset (intern (downcase charset)))))
          (if (and (not raw)
                   (member (car (split-string type "/")) '("text" "message")))
              (progn
                (with-temp-buffer
          (if (and (not raw)
                   (member (car (split-string type "/")) '("text" "message")))
              (progn
                (with-temp-buffer
-                 (setq charset (mm-charset-to-coding-system
-                                (cdr (assq 'charset cont))))
-                 (when (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")))
                  (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")))
-                   (let ((coding-system-for-read charset))
+                   (let ((coding-system-for-read coding))
                      (mm-insert-file-contents filename)))
                   ((eq 'mml (car cont))
                    (insert (cdr (assq 'contents cont))))
                      (mm-insert-file-contents filename)))
                   ((eq 'mml (car cont))
                    (insert (cdr (assq 'contents cont))))
@@ -424,8 +432,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                                       (+ (match-beginning 0) 3))))))
                  (cond
                   ((eq (car cont) 'mml)
                                       (+ (match-beginning 0) 3))))))
                  (cond
                   ((eq (car cont) 'mml)
-                   (let ((mml-boundary (funcall mml-boundary-function
-                                                (incf mml-multipart-number)))
+                   (let ((mml-boundary (mml-compute-boundary cont))
                          (mml-generate-default-type "text/plain"))
                      (mml-to-mime))
                    (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
                          (mml-generate-default-type "text/plain"))
                      (mml-to-mime))
                    (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
@@ -442,6 +449,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                    ;; actually are hard newlines in the text.
                    (let (use-hard-newlines)
                      (when (and (string= type "text/plain")
                    ;; actually are hard newlines in the text.
                    (let (use-hard-newlines)
                      (when (and (string= type "text/plain")
+                                (not (string= (cdr (assq 'sign cont)) "pgp"))
                                 (or (null (assq 'format cont))
                                     (string= (cdr (assq 'format cont))
                                              "flowed"))
                                 (or (null (assq 'format cont))
                                     (string= (cdr (assq 'format cont))
                                              "flowed"))
@@ -463,11 +471,17 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
            (mm-with-unibyte-buffer
              (cond
               ((cdr (assq 'buffer cont))
            (mm-with-unibyte-buffer
              (cond
               ((cdr (assq 'buffer cont))
-               (insert-buffer-substring (cdr (assq 'buffer cont))))
+               (insert (with-current-buffer (cdr (assq 'buffer cont))
+                         (mm-with-unibyte-current-buffer
+                           (buffer-string)))))
               ((and (setq filename (cdr (assq 'filename cont)))
                     (not (equal (cdr (assq 'nofile cont)) "yes")))
                (let ((coding-system-for-read mm-binary-coding-system))
               ((and (setq filename (cdr (assq 'filename cont)))
                     (not (equal (cdr (assq 'nofile cont)) "yes")))
                (let ((coding-system-for-read mm-binary-coding-system))
-                 (mm-insert-file-contents filename nil nil nil nil t)))
+                 (mm-insert-file-contents filename nil nil nil nil t))
+               (unless charset
+                 (setq charset (mm-coding-system-to-mime-charset
+                                (mm-find-buffer-file-coding-system
+                                 filename)))))
               (t
                (insert (cdr (assq 'contents cont)))))
              (setq encoding (mm-encode-buffer type)
               (t
                (insert (cdr (assq 'contents cont)))))
              (setq encoding (mm-encode-buffer type)
@@ -524,8 +538,11 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
              (funcall (cdr handler) cont)
            ;; No specific handler.  Use default one.
            (let ((mml-boundary (mml-compute-boundary cont)))
              (funcall (cdr handler) cont)
            ;; No specific handler.  Use default one.
            (let ((mml-boundary (mml-compute-boundary cont)))
-             (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
-                             type mml-boundary))
+             (insert (format "Content-Type: multipart/%s; boundary=\"%s\""
+                             type mml-boundary)
+                     (if (cdr (assq 'start cont))
+                         (format "; start=\"%s\"\n" (cdr (assq 'start cont)))
+                       "\n"))
              (let ((cont cont) part)
                (while (setq part (pop cont))
                  ;; Skip `multipart' and attributes.
              (let ((cont cont) part)
                (while (setq part (pop cont))
                  ;; Skip `multipart' and attributes.
@@ -546,7 +563,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
            (message-options-set 'message-sender sender))
          (if (setq recipients (cdr (assq 'recipients cont)))
              (message-options-set 'message-recipients recipients))
            (message-options-set 'message-sender sender))
          (if (setq recipients (cdr (assq 'recipients cont)))
              (message-options-set 'message-recipients recipients))
-         (let ((style (mml-signencrypt-style (first (or sign-item encrypt-item)))))
+         (let ((style (mml-signencrypt-style
+                       (first (or sign-item encrypt-item)))))
            ;; check if: we're both signing & encrypting, both methods
            ;; are the same (why would they be different?!), and that
            ;; the signencrypt style allows for combined operation.
            ;; check if: we're both signing & encrypting, both methods
            ;; are the same (why would they be different?!), and that
            ;; the signencrypt style allows for combined operation.
@@ -580,7 +598,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
          (insert-buffer-substring (cdr (assq 'buffer cont))))
         ((and (setq filename (cdr (assq 'filename cont)))
               (not (equal (cdr (assq 'nofile cont)) "yes")))
          (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))
+         (mm-insert-file-contents filename nil nil nil nil t))
         (t
          (insert (cdr (assq 'contents cont)))))
        (goto-char (point-min))
         (t
          (insert (cdr (assq 'contents cont)))))
        (goto-char (point-min))
@@ -590,7 +608,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
                                      (incf mml-multipart-number)))
          (throw 'not-unique nil))))
      ((eq (car cont) 'multipart)
                                      (incf mml-multipart-number)))
          (throw 'not-unique nil))))
      ((eq (car cont) 'multipart)
-      (mapcar 'mml-compute-boundary-1 (cddr cont))))
+      (mapc 'mml-compute-boundary-1 (cddr cont))))
     t))
 
 (defun mml-make-boundary (number)
     t))
 
 (defun mml-make-boundary (number)
@@ -601,14 +619,15 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
          mml-base-boundary))
 
 (defun mml-insert-mime-headers (cont type charset encoding flowed)
          mml-base-boundary))
 
 (defun mml-insert-mime-headers (cont type charset encoding flowed)
-  (let (parameters disposition description)
+  (let (parameters id disposition description)
     (setq parameters
          (mml-parameter-string
           cont mml-content-type-parameters))
     (when (or charset
              parameters
              flowed
     (setq parameters
          (mml-parameter-string
           cont mml-content-type-parameters))
     (when (or charset
              parameters
              flowed
-             (not (equal type mml-generate-default-type)))
+             (not (equal type mml-generate-default-type))
+             mml-insert-mime-headers-always)
       (when (consp charset)
        (error
         "Can't encode a part with several charsets"))
       (when (consp charset)
        (error
         "Can't encode a part with several charsets"))
@@ -622,6 +641,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
        (mml-insert-parameter-string
         cont mml-content-type-parameters))
       (insert "\n"))
        (mml-insert-parameter-string
         cont mml-content-type-parameters))
       (insert "\n"))
+    (when (setq id (cdr (assq 'id cont)))
+      (insert "Content-ID: " id "\n"))
     (setq parameters
          (mml-parameter-string
           cont mml-content-disposition-parameters))
     (setq parameters
          (mml-parameter-string
           cont mml-content-disposition-parameters))
@@ -748,10 +769,12 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
       (insert "<#/multipart>\n"))
      (textp
       (let ((charset (mail-content-type-get
       (insert "<#/multipart>\n"))
      (textp
       (let ((charset (mail-content-type-get
-                     (mm-handle-type handle) 'charset)))
+                     (mm-handle-type handle) 'charset))
+           (start (point)))
        (if (eq charset 'gnus-decoded)
            (mm-insert-part handle)
        (if (eq charset 'gnus-decoded)
            (mm-insert-part handle)
-         (insert (mm-decode-string (mm-get-part handle) charset))))
+         (insert (mm-decode-string (mm-get-part handle) charset)))
+       (mml-quote-region start (point)))
       (goto-char (point-max)))
      (t
       (insert "<#/part>\n")))))
       (goto-char (point-max)))
      (t
       (insert "<#/part>\n")))))
@@ -759,8 +782,12 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
 (defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
   "Take a MIME handle and insert an MML tag."
   (if (stringp (car handle))
 (defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
   "Take a MIME handle and insert an MML tag."
   (if (stringp (car handle))
-      (insert "<#multipart type=" (mm-handle-media-subtype handle)
-             ">\n")
+      (progn
+       (insert "<#multipart type=" (mm-handle-media-subtype handle))
+       (let ((start (mm-handle-multipart-ctl-parameter handle 'start)))
+         (when start
+           (insert " start=\"" start "\"")))
+       (insert ">\n"))
     (if mmlp
        (insert "<#mml type=" (mm-handle-media-type handle))
       (insert "<#part type=" (mm-handle-media-type handle)))
     (if mmlp
        (insert "<#mml type=" (mm-handle-media-type handle))
       (insert "<#part type=" (mm-handle-media-type handle)))
@@ -768,6 +795,8 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
                          (cdr (mm-handle-disposition handle))))
       (unless (symbolp (cdr elem))
        (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
                          (cdr (mm-handle-disposition handle))))
       (unless (symbolp (cdr elem))
        (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
+    (when (mm-handle-id handle)
+      (insert " id=\"" (mm-handle-id handle) "\""))
     (when (mm-handle-disposition handle)
       (insert " disposition=" (car (mm-handle-disposition handle))))
     (when buffer
     (when (mm-handle-disposition handle)
       (insert " disposition=" (car (mm-handle-disposition handle))))
     (when buffer
@@ -786,7 +815,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
       (insert " " param)
       (when (> (current-column) 71)
        (goto-char point)
       (insert " " param)
       (when (> (current-column) 71)
        (goto-char point)
-       (insert "\n ")
+       (insert "\n")
        (end-of-line)))))
 
 ;;;
        (end-of-line)))))
 
 ;;;
@@ -856,7 +885,10 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
      ["S/MIME Encrypt Part" mml-secure-encrypt-smime t])
     ["Encrypt/Sign off" mml-unsecure-message t]
     ;;["Narrow" mml-narrow-to-part t]
      ["S/MIME Encrypt Part" mml-secure-encrypt-smime t])
     ["Encrypt/Sign off" mml-unsecure-message t]
     ;;["Narrow" mml-narrow-to-part t]
-    ["Quote MML" mml-quote-region t]
+    ["Quote MML" mml-quote-region
+     :active (message-mark-active-p)
+     ,@(if (featurep 'xemacs) nil
+        '(:help "Quote MML tags in region"))]
     ["Validate MML" mml-validate t]
     ["Preview" mml-preview t]))
 
     ["Validate MML" mml-validate t]
     ["Preview" mml-preview t]))
 
@@ -873,8 +905,13 @@ See Info node `(emacs-mime)Composing'.
   (when (set (make-local-variable 'mml-mode)
             (if (null arg) (not mml-mode)
               (> (prefix-numeric-value arg) 0)))
   (when (set (make-local-variable 'mml-mode)
             (if (null arg) (not mml-mode)
               (> (prefix-numeric-value arg) 0)))
-    (gnus-add-minor-mode 'mml-mode " MML" mml-mode-map)
+    (add-minor-mode 'mml-mode " MML" mml-mode-map)
     (easy-menu-add mml-menu mml-mode-map)
     (easy-menu-add mml-menu mml-mode-map)
+    (when (boundp 'x-dnd-protocol-alist)
+      (set (make-local-variable 'x-dnd-protocol-alist)
+          '(("^file:///" . mml-x-dnd-attach-file)
+            ("^file://"  . x-dnd-open-file)
+            ("^file:"    . mml-x-dnd-attach-file))))
     (run-hooks 'mml-mode-hook)))
 
 ;;;
     (run-hooks 'mml-mode-hook)))
 
 ;;;
@@ -916,6 +953,18 @@ See Info node `(emacs-mime)Composing'.
       (setq description nil))
     description))
 
       (setq description nil))
     description))
 
+(defun mml-minibuffer-read-disposition (type &optional default)
+  (let* ((default (or default
+                     (if (string-match "^text/.*" type)
+                         "inline"
+                       "attachment")))
+        (disposition (completing-read "Disposition: "
+                                      '(("attachment") ("inline") (""))
+                                      nil t)))
+    (if (not (equal disposition ""))
+       disposition
+      default)))
+
 (defun mml-quote-region (beg end)
   "Quote the MML tags in the region."
   (interactive "r")
 (defun mml-quote-region (beg end)
   "Quote the MML tags in the region."
   (interactive "r")
@@ -958,7 +1007,7 @@ See Info node `(emacs-mime)Composing'.
 
 ;;; Attachment functions.
 
 
 ;;; Attachment functions.
 
-(defun mml-attach-file (file &optional type description)
+(defun mml-attach-file (file &optional type description disposition)
   "Attach a file to the outgoing MIME message.
 The file is not inserted or encoded until you send the message with
 `\\[message-send-and-exit]' or `\\[message-send]'.
   "Attach a file to the outgoing MIME message.
 The file is not inserted or encoded until you send the message with
 `\\[message-send-and-exit]' or `\\[message-send]'.
@@ -969,10 +1018,23 @@ description of the attachment."
   (interactive
    (let* ((file (mml-minibuffer-read-file "Attach file: "))
          (type (mml-minibuffer-read-type file))
   (interactive
    (let* ((file (mml-minibuffer-read-file "Attach file: "))
          (type (mml-minibuffer-read-type file))
-         (description (mml-minibuffer-read-description)))
-     (list file type description)))
-  (mml-insert-empty-tag 'part 'type type 'filename file
-                       'disposition "attachment" 'description description))
+         (description (mml-minibuffer-read-description))
+         (disposition (mml-minibuffer-read-disposition type)))
+     (list file type description disposition)))
+  (mml-insert-empty-tag 'part
+                       'type type
+                       'filename file
+                       'disposition (or disposition "attachment")
+                       'description description))
+
+(defun mml-x-dnd-attach-file (uri action)
+  "Attach a drag and drop file."
+  (let ((file (x-dnd-get-local-file-name uri t)))
+    (when (and file (file-regular-p file))
+      (let* ((type (mml-minibuffer-read-type file))
+           (description (mml-minibuffer-read-description))
+           (disposition (mml-minibuffer-read-disposition type)))
+       (mml-attach-file file type description disposition)))))
 
 (defun mml-attach-buffer (buffer &optional type description)
   "Attach a buffer to the outgoing MIME message.
 
 (defun mml-attach-buffer (buffer &optional type description)
   "Attach a buffer to the outgoing MIME message.
@@ -1023,10 +1085,15 @@ Should be adopted if code in `message-send-mail' is changed."
     (message-position-on-field "Mail-Followup-To" "X-Draft-From")
     (insert (message-make-mail-followup-to))))
 
     (message-position-on-field "Mail-Followup-To" "X-Draft-From")
     (insert (message-make-mail-followup-to))))
 
+(defvar mml-preview-buffer nil)
+
 (defun mml-preview (&optional raw)
   "Display current buffer with Gnus, in a new buffer.
 If RAW, don't highlight the article."
   (interactive "P")
 (defun mml-preview (&optional raw)
   "Display current buffer with Gnus, in a new buffer.
 If RAW, don't highlight the article."
   (interactive "P")
+  (setq mml-preview-buffer (generate-new-buffer
+                           (concat (if raw "*Raw MIME preview of "
+                                     "*MIME preview of ") (buffer-name))))
   (save-excursion
     (let* ((buf (current-buffer))
           (message-options message-options)
   (save-excursion
     (let* ((buf (current-buffer))
           (message-options message-options)
@@ -1038,11 +1105,13 @@ If RAW, don't highlight the article."
                                           (message-fetch-field "Newsgroups")))
                                        message-posting-charset)))
       (message-options-set-recipient)
                                           (message-fetch-field "Newsgroups")))
                                        message-posting-charset)))
       (message-options-set-recipient)
-      (switch-to-buffer (generate-new-buffer
-                        (concat (if raw "*Raw MIME preview of "
-                                  "*MIME preview of ") (buffer-name))))
-      (erase-buffer)
-      (insert-buffer-substring buf)
+      (when (boundp 'gnus-buffers)
+       (push mml-preview-buffer gnus-buffers))
+      (save-restriction
+       (widen)
+       (set-buffer mml-preview-buffer)
+       (erase-buffer)
+       (insert-buffer-substring buf))
       (mml-preview-insert-mail-followup-to)
       (let ((message-deletable-headers (if (message-news-p)
                                           nil
       (mml-preview-insert-mail-followup-to)
       (let ((message-deletable-headers (if (message-news-p)
                                           nil
@@ -1055,6 +1124,7 @@ If RAW, don't highlight the article."
           (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
          (replace-match "\n"))
       (let ((mail-header-separator ""));; mail-header-separator is removed.
           (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
          (replace-match "\n"))
       (let ((mail-header-separator ""));; mail-header-separator is removed.
+       (message-sort-headers)
        (mml-to-mime))
       (if raw
          (when (fboundp 'set-buffer-multibyte)
        (mml-to-mime))
       (if raw
          (when (fboundp 'set-buffer-multibyte)
@@ -1087,7 +1157,11 @@ If RAW, don't highlight the article."
                     (lambda (event)
                       (interactive "@e")
                       (widget-button-press (widget-event-point event) event)))
                     (lambda (event)
                       (interactive "@e")
                       (widget-button-press (widget-event-point event) event)))
-      (goto-char (point-min)))))
+      (goto-char (point-min))))
+  (if (and (boundp 'gnus-buffer-configuration)
+          (assq 'mml-preview gnus-buffer-configuration))
+      (gnus-configure-windows 'mml-preview)
+    (pop-to-buffer mml-preview-buffer)))
 
 (defun mml-validate ()
   "Validate the current MML document."
 
 (defun mml-validate ()
   "Validate the current MML document."
@@ -1133,4 +1207,5 @@ If RAW, don't highlight the article."
 
 (provide 'mml)
 
 
 (provide 'mml)
 
+;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
 ;;; mml.el ends here
 ;;; mml.el ends here