X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmml.el;h=1b43f68f7d46807c4e3430ddf17532557b93b07b;hb=e405b22c6b46721607c5e6c712a4705c23dee751;hp=f2b7304bfcfa651db00422d5354b420541b68a72;hpb=f5af53126303b14391899af3524307635d0c7c31;p=gnus

diff --git a/lisp/mml.el b/lisp/mml.el
index f2b7304bf..1b43f68f7 100644
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -1,5 +1,6 @@
 ;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
@@ -33,15 +34,18 @@
 (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 'message-mark-active-p "message")
   (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."
+  :version "22.1"
   :type '(repeat (symbol :tag "Parameter"))
   :group 'message)
 
@@ -49,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."
+  :version "22.1"
   :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
@@ -68,7 +80,7 @@ handle to tweak the part.")
 (defvar mml-tweak-sexp-alist
   '((mml-externalize-attachments . mml-tweak-externalize-attachments))
   "A list of (SEXP . FUNCTION) for tweaking MML parts.
-SEXP is a s-expression. If the evaluation of SEXP is non-nil, FUNCTION
+SEXP is an s-expression.  If the evaluation of SEXP is non-nil, FUNCTION
 is called.  FUNCTION is a Lisp function which is called with the MML
 handle to tweak the part.")
 
@@ -123,19 +135,15 @@ one charsets.")
 
 (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))
-    (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."
@@ -157,9 +165,8 @@ one charsets.")
 	       (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
@@ -208,12 +215,12 @@ one charsets.")
 	  (if (or (memq 'unknown-encoding mml-confirmation-set)
 		  (message-options-get 'unknown-encoding)
 		  (and (y-or-n-p "\
-Message contains characters with unknown encoding.  Really send?")
+Message contains characters with unknown encoding.  Really send? ")
 		       (message-options-set 'unknown-encoding t)))
 	      (if (setq use-ascii
 			(or (memq 'use-ascii mml-confirmation-set)
 			    (message-options-get 'use-ascii)
-			    (and (y-or-n-p "Use ASCII as charset?")
+			    (and (y-or-n-p "Use ASCII as charset? ")
 				 (message-options-set 'use-ascii t))))
 		  (setq charsets (delq nil charsets))
 		(setq warn nil))
@@ -337,7 +344,7 @@ A message part needs to be split into %d charset parts.  Really send? "
   "Return the buffer up till the next part, multipart or closing part or multipart.
 If MML is non-nil, return the buffer up till the correspondent mml tag."
   (let ((beg (point)) (count 1))
-   ;; If the tag ended at the end of the line, we go to the next line.
+    ;; If the tag ended at the end of the line, we go to the next line.
     (when (looking-at "[ \t]*\n")
       (forward-line 1))
     (if mml
@@ -390,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)))
-	      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
-		  (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")))
-		    (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))))
@@ -422,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)
-		    (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")))
@@ -434,26 +443,27 @@ 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
+		    ;; Only perform format=flowed filling on text/plain
+		    ;; parts where there either isn't a format parameter
+		    ;; in the mml tag or it says "flowed" and there
+		    ;; 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"))
+				 (setq use-hard-newlines
+				       (text-property-any
+					(point-min) (point-max) 'hard 't)))
+			(fill-flowed-encode)
+			;; Indicate that `mml-insert-mime-headers' should
+			;; insert a "; format=flowed" string unless the
+			;; user has already specified it.
+			(setq flowed (null (assq 'format cont)))))
 		    (setq charset (mm-encode-body charset))
 		    (setq encoding (mm-body-encoding
 				    charset (cdr (assq 'encoding cont))))))
-		  ;; Only perform format=flowed filling on text/plain
-		  ;; parts where there either isn't a format parameter
-		  ;; in the mml tag or it says "flowed" and there
-		  ;; actually are hard newlines in the text.
-		  (let (use-hard-newlines)
-		    (when (and (string= type "text/plain")
-			       (or (null (assq 'format cont))
-				   (string= (cdr (assq 'format cont))
-					    "flowed"))
-			       (setq use-hard-newlines
-				     (text-property-any
-				      (point-min) (point-max) 'hard 't)))
-		      (fill-flowed-encode)
-		      ;; Indicate that `mml-insert-mime-headers' should
-		      ;; insert a "; format=flowed" string unless the
-		      ;; user has already specified it.
-		      (setq flowed (null (assq 'format cont)))))
 		  (setq coded (buffer-string)))
 		(mml-insert-mime-headers cont type charset encoding flowed)
 		(insert "\n")
@@ -461,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))
-		(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))
-		  (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)
@@ -522,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)))
-	      (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.
@@ -539,11 +558,13 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 				 mml-encrypt-alist))
 	    sender recipients)
 	(when (or sign-item encrypt-item)
-	  (if (setq sender (cdr (assq 'sender cont)))
-	      (message-options-set 'message-sender sender))
+	  (when (setq sender (cdr (assq 'sender cont)))
+	    (message-options-set 'mml-sender sender)
+	    (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.
@@ -577,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")))
-	  (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))
@@ -587,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)
-      (mapcar 'mml-compute-boundary-1 (cddr cont))))
+      (mapc 'mml-compute-boundary-1 (cddr cont))))
     t))
 
 (defun mml-make-boundary (number)
@@ -598,17 +619,18 @@ 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)
-  (let (parameters disposition description)
+  (let (parameters id disposition description)
     (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."))
+	 "Can't encode a part with several charsets"))
       (insert "Content-Type: " type)
       (when charset
 	(insert "; " (mail-header-encode-parameter
@@ -619,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"))
+    (when (setq id (cdr (assq 'id cont)))
+      (insert "Content-ID: " id "\n"))
     (setq parameters
 	  (mml-parameter-string
 	   cont mml-content-disposition-parameters))
@@ -737,7 +761,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
 	(mml-insert-mml-markup handle buffer textp)))
     (cond
      (mmlp
-      (insert-buffer buffer)
+      (insert-buffer-substring buffer)
       (goto-char (point-max))
       (insert "<#/mml>\n"))
      ((stringp (car handle))
@@ -745,10 +769,12 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
       (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)
-	  (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")))))
@@ -756,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))
-      (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)))
@@ -765,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) "\"")))
+    (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
@@ -783,7 +815,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
       (insert " " param)
       (when (> (current-column) 71)
 	(goto-char point)
-	(insert "\n ")
+	(insert "\n")
 	(end-of-line)))))
 
 ;;;
@@ -819,8 +851,8 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
     (define-key map "v" 'mml-validate)
     (define-key map "P" 'mml-preview)
     (define-key map "s" sign)
-    (define-key map "S" sign)
-    (define-key map "c" encryptpart)
+    (define-key map "S" signpart)
+    (define-key map "c" encrypt)
     (define-key map "C" encryptpart)
     ;;(define-key map "n" 'mml-narrow-to-part)
     ;; `M-m' conflicts with `back-to-indentation'.
@@ -853,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]
-    ["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]))
 
@@ -870,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)))
-    (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)
+    (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)))
 
 ;;;
@@ -880,8 +920,9 @@ See Info node `(emacs-mime)Composing'.
 ;;;
 
 (defun mml-minibuffer-read-file (prompt)
-  (let ((file (read-file-name prompt nil nil t)))
-   ;; Prevent some common errors.  This is inspired by similar code in
+  (let* ((completion-ignored-extensions nil)
+	 (file (read-file-name prompt nil nil t)))
+    ;; Prevent some common errors.  This is inspired by similar code in
     ;; VM.
     (when (file-directory-p file)
       (error "%s is a directory, cannot attach" file))
@@ -912,6 +953,18 @@ See Info node `(emacs-mime)Composing'.
       (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")
@@ -939,7 +992,9 @@ See Info node `(emacs-mime)Composing'.
       (when value
 	;; Quote VALUE if it contains suspicious characters.
 	(when (string-match "[\"'\\~/*;() \t\n]" value)
-	  (setq value (prin1-to-string value)))
+	  (setq value (with-output-to-string
+			(let (print-escape-nonascii)
+			  (prin1 value)))))
 	(insert (format " %s=%s" key value)))))
   (insert ">\n"))
 
@@ -952,7 +1007,7 @@ See Info node `(emacs-mime)Composing'.
 
 ;;; 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]'.
@@ -963,10 +1018,23 @@ description of the attachment."
   (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.
@@ -1007,13 +1075,29 @@ TYPE is the MIME type to use."
   (mml-insert-tag 'part 'type type 'disposition "inline")
   (forward-line -1))
 
+(defun mml-preview-insert-mail-followup-to ()
+  "Insert a Mail-Followup-To header before previewing an article.
+Should be adopted if code in `message-send-mail' is changed."
+  (when (and (message-mail-p)
+	     (message-subscribed-p)
+	     (not (mail-fetch-field "mail-followup-to"))
+	     (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")
+  (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)
+	   (message-this-is-mail (message-mail-p))
 	   (message-this-is-news (message-news-p))
 	   (message-posting-charset (or (gnus-setup-posting-charset
 					 (save-restriction
@@ -1021,11 +1105,14 @@ If RAW, don't highlight the article."
 					   (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 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
 					 message-deletable-headers)))
@@ -1037,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.
+	(message-sort-headers)
 	(mml-to-mime))
       (if raw
 	  (when (fboundp 'set-buffer-multibyte)
@@ -1054,9 +1142,26 @@ If RAW, don't highlight the article."
 	    (gnus-article-prepare-display))))
       ;; Disable article-mode-map.
       (use-local-map nil)
+      (gnus-make-local-hook 'kill-buffer-hook)
+      (add-hook 'kill-buffer-hook
+		(lambda ()
+		  (mm-destroy-parts gnus-article-mime-handles)) nil t)
       (setq buffer-read-only t)
       (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
-      (goto-char (point-min)))))
+      (local-set-key "=" (lambda () (interactive) (delete-other-windows)))
+      (local-set-key "\r"
+		     (lambda ()
+		       (interactive)
+		       (widget-button-press (point))))
+      (local-set-key gnus-mouse-2
+		     (lambda (event)
+		       (interactive "@e")
+		       (widget-button-press (widget-event-point event) event)))
+      (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."
@@ -1102,4 +1207,5 @@ If RAW, don't highlight the article."
 
 (provide 'mml)
 
+;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
 ;;; mml.el ends here