X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmml.el;h=d401cb041aafc0d46bc354f37b74494e280cb068;hb=5eaeb5bdf9b05c0e72d5fc4c179f8eb0b6e2e9bd;hp=150e7768394489a34f0f622eb01395dcb31b3259;hpb=d25c4dca6c60734e3fcd29b4057c7913e6360b65;p=gnus

diff --git a/lisp/mml.el b/lisp/mml.el
index 150e77683..d401cb041 100644
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -1,5 +1,5 @@
 ;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
@@ -27,20 +27,58 @@
 (require 'mm-bodies)
 (require 'mm-encode)
 (require 'mm-decode)
-(require 'gnus-ems)
 (require 'mml-sec)
 (eval-when-compile (require 'cl))
 
 (eval-and-compile
   (autoload 'message-make-message-id "message")
   (autoload 'gnus-setup-posting-charset "gnus-msg")
+  (autoload 'gnus-add-minor-mode "gnus-ems")
   (autoload 'message-fetch-field "message")
+  (autoload 'fill-flowed-encode "flow-fill")
   (autoload 'message-posting-charset "message"))
 
+(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."
+  :type '(repeat (symbol :tag "Parameter"))
+  :group 'message)
+
+(defcustom mml-content-disposition-parameters
+  '(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."
+  :type '(repeat (symbol :tag "Parameter"))
+  :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
+is a Lisp function which is called with the MML handle to tweak the
+part.  This variable is used only when no TWEAK parameter exists in
+the MML handle.")
+
+(defvar mml-tweak-function-alist nil
+  "A list of (NAME . FUNCTION) for tweaking MML parts.
+NAME is a string containing the name of the TWEAK parameter in the MML
+handle.  FUNCTION is a Lisp function which is called with the MML
+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
+is called.  FUNCTION is a Lisp function which is called with the MML
+handle to tweak the part.")
+
+(defvar mml-externalize-attachments nil
+  "*If non-nil, local-file attachments are generated as external parts.")
+
 (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.
 
@@ -78,7 +116,7 @@ one charsets.")
 
 (defvar mml-buffer-list nil)
 
-(defun mml-generate-new-buffer (name) 
+(defun mml-generate-new-buffer (name)
   (let ((buf (generate-new-buffer name)))
     (push buf mml-buffer-list)
     buf))
@@ -90,13 +128,14 @@ one charsets.")
 
 (defun mml-parse ()
   "Parse the current buffer as an MML document."
-  (goto-char (point-min))
-  (let ((table (syntax-table)))
-    (unwind-protect
-	(progn
-	  (set-syntax-table mml-syntax-table)
-	  (mml-parse-1))
-      (set-syntax-table table))))
+  (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)))))
 
 (defun mml-parse-1 ()
   "Parse the current buffer as an MML document."
@@ -104,6 +143,43 @@ one charsets.")
     (while (and (not (eobp))
 		(not (looking-at "<#/multipart")))
       (cond
+       ((looking-at "<#secure")
+	;; The secure part is essentially a meta-meta tag, which
+	;; expands to either a part tag if there are no other parts in
+	;; the document or a multipart tag if there are other parts
+	;; included in the message
+	(let* (secure-mode
+	       (taginfo (mml-read-tag))
+	       (recipients (cdr (assq 'recipients taginfo)))
+	       (sender (cdr (assq 'sender taginfo)))
+	       (location (cdr (assq 'tag-location taginfo)))
+	       (mode (cdr (assq 'mode taginfo)))
+	       (method (cdr (assq 'method taginfo)))
+	       tags)
+	  (save-excursion
+	    (if
+		(re-search-forward
+		 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
+		(setq secure-mode "multipart")
+	      (setq secure-mode "part")))
+	  (save-excursion
+	    (goto-char location)
+	    (re-search-forward "<#secure[^\n]*>\n"))
+	  (delete-region (match-beginning 0) (match-end 0))
+	  (cond ((string= mode "sign")
+		 (setq tags (list "sign" method)))
+		((string= mode "encrypt")
+		 (setq tags (list "encrypt" method)))
+		((string= mode "signencrypt")
+		 (setq tags (list "sign" method "encrypt" method))))
+	  (eval `(mml-insert-tag ,secure-mode
+				 ,@tags
+				 ,(if recipients "recipients")
+				 ,recipients
+				 ,(if sender "sender")
+				 ,sender))
+	  ;; restart the parse
+	  (goto-char location)))
        ((looking-at "<#multipart")
 	(push (nconc (mml-read-tag) (mml-parse-1)) struct))
        ((looking-at "<#external")
@@ -120,15 +196,25 @@ one charsets.")
 	(setq raw (cdr (assq 'raw tag))
 	      point (point)
 	      contents (mml-read-part (eq 'mml (car tag)))
-	      charsets (if raw nil 
-			 (mm-find-mime-charset-region point (point))))
+	      charsets (cond
+			(raw nil)
+			((assq 'charset tag)
+			 (list
+			  (intern (downcase (cdr (assq 'charset tag))))))
+			(t
+			 (mm-find-mime-charset-region point (point)
+						      mm-hack-charsets))))
 	(when (and (not raw) (memq nil charsets))
 	  (if (or (memq 'unknown-encoding mml-confirmation-set)
-		  (y-or-n-p
-		   "Message contains characters with unknown encoding.  Really send?"))
-	      (if (setq use-ascii 
+		  (message-options-get 'unknown-encoding)
+		  (and (y-or-n-p "\
+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)
-			    (y-or-n-p "Use ASCII as charset?")))
+			    (message-options-get 'use-ascii)
+			    (and (y-or-n-p "Use ASCII as charset?")
+				 (message-options-set 'use-ascii t))))
 		  (setq charsets (delq nil charsets))
 		(setq warn nil))
 	    (error "Edit your message to remove those characters")))
@@ -144,18 +230,18 @@ one charsets.")
 			  tag point (point) use-ascii)))
 	    (when (and warn
 		       (not (memq 'multipart mml-confirmation-set))
-		       (not
-			(y-or-n-p
-			 (format
-			  "Warning: Your message contains more than %d parts.  Really send? "
-			  (length nstruct)))))
+		       (not (message-options-get 'multipart))
+		       (not (and (y-or-n-p (format "\
+A message part needs to be split into %d charset parts.  Really send? "
+						   (length nstruct)))
+				 (message-options-set 'multipart t))))
 	      (error "Edit your message to use only one charset"))
 	    (setq struct (nconc nstruct struct)))))))
     (unless (eobp)
       (forward-line 1))
     (nreverse struct)))
 
-(defun mml-parse-singlepart-with-multiple-charsets 
+(defun mml-parse-singlepart-with-multiple-charsets
   (orig-tag beg end &optional use-ascii)
   (save-excursion
     (save-restriction
@@ -215,7 +301,8 @@ one charsets.")
 
 (defun mml-read-tag ()
   "Read a tag and return the contents."
-  (let (contents name elem val)
+  (let ((orig-point (point))
+	contents name elem val)
     (forward-char 2)
     (setq name (buffer-substring-no-properties
 		(point) (progn (forward-sexp 1) (point))))
@@ -233,8 +320,19 @@ one charsets.")
     (goto-char (match-end 0))
     ;; Don't skip the leading space.
     ;;(skip-chars-forward " \t\n")
+    ;; Put the tag location into the returned contents
+    (setq contents (append (list (cons 'tag-location orig-point)) contents))
     (cons (intern name) (nreverse contents))))
 
+(defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
+  (let ((str (buffer-substring-no-properties start end))
+	(bufstart start) tmp)
+    (while (setq tmp (text-property-any start end 'hard 't))
+      (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
+			   '(hard t) str)
+      (setq start (1+ tmp)))
+    str))
+
 (defun mml-read-part (&optional mml)
   "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."
@@ -248,19 +346,22 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 	    (if (re-search-forward "<#\\(/\\)?mml." nil t)
 		(setq count (+ count (if (match-beginning 1) -1 1)))
 	      (goto-char (point-max))))
-	  (buffer-substring-no-properties beg (if (> count 0) 
-						  (point)
-						(match-beginning 0))))
+	  (mml-buffer-substring-no-properties-except-hard-newlines
+	   beg (if (> count 0)
+		   (point)
+		 (match-beginning 0))))
       (if (re-search-forward
 	   "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
 	  (prog1
-	      (buffer-substring-no-properties beg (match-beginning 0))
+	      (mml-buffer-substring-no-properties-except-hard-newlines
+	       beg (match-beginning 0))
 	    (if (or (not (match-beginning 1))
 		    (equal (match-string 2) "multipart"))
 		(goto-char (match-beginning 0))
 	      (when (looking-at "[ \t]*\n")
 		(forward-line 1))))
-	(buffer-substring-no-properties beg (goto-char (point-max)))))))
+	(mml-buffer-substring-no-properties-except-hard-newlines
+	 beg (goto-char (point-max)))))))
 
 (defvar mml-boundary nil)
 (defvar mml-base-boundary "-=-=")
@@ -281,58 +382,82 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 	(buffer-string)))))
 
 (defun mml-generate-mime-1 (cont)
-  (let ((mm-use-ultra-safe-encoding 
+  (let ((mm-use-ultra-safe-encoding
 	 (or mm-use-ultra-safe-encoding (assq 'sign cont))))
     (save-restriction
       (narrow-to-region (point) (point))
+      (mml-tweak-part cont)
       (cond
        ((or (eq (car cont) 'part) (eq (car cont) 'mml))
 	(let ((raw (cdr (assq 'raw cont)))
-	      coded encoding charset filename type)
+	      coded encoding charset filename type flowed)
 	  (setq type (or (cdr (assq 'type cont)) "text/plain"))
 	  (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")))
-		  (let ((coding-system-for-read charset))
-		    (mm-insert-file-contents filename)))
-		 ((eq 'mml (car cont))
-		  (insert (cdr (assq 'contents cont))))
-		 (t
-		  (save-restriction
-		    (narrow-to-region (point) (point))
-		    (insert (cdr (assq 'contents cont)))
-		    ;; Remove quotes from quoted tags.
-		    (goto-char (point-min))
-		    (while (re-search-forward
-			    "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t)
-		      (delete-region (+ (match-beginning 0) 2)
-				     (+ (match-beginning 0) 3))))))
-		(cond 
-		 ((eq (car cont) 'mml)
-		  (let ((mml-boundary (funcall mml-boundary-function
-					       (incf mml-multipart-number)))
-			(mml-generate-default-type "text/plain"))
-		    (mml-to-mime))
-		  (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
-		    ;; ignore 0x1b, it is part of iso-2022-jp
-		    (setq encoding (mm-body-7-or-8))))
-		 ((string= (car (split-string type "/")) "message")
-		  (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
-		    ;; ignore 0x1b, it is part of iso-2022-jp
-		    (setq encoding (mm-body-7-or-8))))
-		 (t 
-		  (setq charset (mm-encode-body charset))
-		  (setq encoding (mm-body-encoding
-				  charset (cdr (assq 'encoding cont))))))
-		(setq coded (buffer-string)))
+	      (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))
+		      (mm-insert-file-contents filename)))
+		   ((eq 'mml (car cont))
+		    (insert (cdr (assq 'contents cont))))
+		   (t
+		    (save-restriction
+		      (narrow-to-region (point) (point))
+		      (insert (cdr (assq 'contents cont)))
+		      ;; Remove quotes from quoted tags.
+		      (goto-char (point-min))
+		      (while (re-search-forward
+			      "<#!+/?\\(part\\|multipart\\|external\\|mml\\)"
+			      nil t)
+			(delete-region (+ (match-beginning 0) 2)
+				       (+ (match-beginning 0) 3))))))
+		  (cond
+		   ((eq (car cont) 'mml)
+		    (let ((mml-boundary (funcall mml-boundary-function
+						 (incf mml-multipart-number)))
+			  (mml-generate-default-type "text/plain"))
+		      (mml-to-mime))
+		    (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
+		      ;; ignore 0x1b, it is part of iso-2022-jp
+		      (setq encoding (mm-body-7-or-8))))
+		   ((string= (car (split-string type "/")) "message")
+		    (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
+		      ;; ignore 0x1b, it is part of iso-2022-jp
+		      (setq encoding (mm-body-7-or-8))))
+		   (t
+		    (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")
+		(insert coded))
 	    (mm-with-unibyte-buffer
 	      (cond
 	       ((cdr (assq 'buffer cont))
@@ -344,10 +469,11 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 	       (t
 		(insert (cdr (assq 'contents cont)))))
 	      (setq encoding (mm-encode-buffer type)
-		    coded (buffer-string))))
-	  (mml-insert-mime-headers cont type charset encoding)
-	  (insert "\n")
-	  (insert coded)))
+		    coded (mm-string-as-multibyte (buffer-string))))
+	    (mml-insert-mime-headers cont type charset encoding nil)
+	    (insert "\n")
+	    (mm-with-unibyte-current-buffer
+	      (insert coded)))))
        ((eq (car cont) 'external)
 	(insert "Content-Type: message/external-body")
 	(let ((parameters (mml-parameter-string
@@ -370,7 +496,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 	       (concat "access-type="
 		       (if (member (nth 0 name) '("ftp@" "anonymous@"))
 			   "anon-ftp"
-			 "ftp")))))      
+			 "ftp")))))
 	  (when url
 	    (mml-insert-parameter
 	     (mail-header-encode-parameter "url" url)
@@ -407,22 +533,29 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 	      (insert "\n--" mml-boundary "--\n")))))
        (t
 	(error "Invalid element: %S" cont)))
-      (let ((item (assoc (cdr (assq 'sign cont)) mml-sign-alist))
+      ;; handle sign & encrypt tags in a semi-smart way.
+      (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist))
+	    (encrypt-item (assoc (cdr (assq 'encrypt cont))
+				 mml-encrypt-alist))
 	    sender recipients)
-	(when item
+	(when (or sign-item encrypt-item)
 	  (if (setq sender (cdr (assq 'sender cont)))
 	      (message-options-set 'message-sender sender))
 	  (if (setq recipients (cdr (assq 'recipients cont)))
-	      (message-options-set 'message-sender recipients))
-	  (funcall (nth 1 item) cont)))
-      (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist))
-	    sender recipients)
-	(when item
-	  (if (setq sender (cdr (assq 'sender cont)))
-	      (message-options-set 'message-sender sender))
-	  (if (setq recipients (cdr (assq 'recipients cont)))
-	      (message-options-set 'message-sender recipients))
-	  (funcall (nth 1 item) cont))))))
+	      (message-options-set 'message-recipients recipients))
+	  (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.
+	    (if (and sign-item encrypt-item (equal (first sign-item)
+						   (first encrypt-item))
+		     (equal style 'combined))
+		(funcall (nth 1 encrypt-item) cont t)
+	      ;; otherwise, revert to the old behavior.
+	      (when sign-item
+		(funcall (nth 1 sign-item) cont))
+	      (when encrypt-item
+		(funcall (nth 1 encrypt-item) cont)))))))))
 
 (defun mml-compute-boundary (cont)
   "Return a unique boundary that does not exist in CONT."
@@ -464,13 +597,14 @@ 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)
+(defun mml-insert-mime-headers (cont type charset encoding flowed)
   (let (parameters disposition description)
     (setq parameters
 	  (mml-parameter-string
-	   cont '(name access-type expiration size permission)))
+	   cont mml-content-type-parameters))
     (when (or charset
 	      parameters
+	      flowed
 	      (not (equal type mml-generate-default-type)))
       (when (consp charset)
 	(error
@@ -479,19 +613,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (when charset
 	(insert "; " (mail-header-encode-parameter
 		      "charset" (symbol-name charset))))
+      (when flowed
+	(insert "; format=flowed"))
       (when parameters
 	(mml-insert-parameter-string
-	 cont '(name access-type expiration size permission)))
+	 cont mml-content-type-parameters))
       (insert "\n"))
     (setq parameters
 	  (mml-parameter-string
-	   cont '(filename creation-date modification-date read-date)))
+	   cont mml-content-disposition-parameters))
     (when (or (setq disposition (cdr (assq 'disposition cont)))
 	      parameters)
       (insert "Content-Disposition: " (or disposition "inline"))
       (when parameters
 	(mml-insert-parameter-string
-	 cont '(filename creation-date modification-date read-date)))
+	 cont mml-content-disposition-parameters))
       (insert "\n"))
     (unless (eq encoding '7bit)
       (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
@@ -569,6 +705,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
     ;; Remove them, they are confusing.
     (message-remove-header "Content-Type")
     (message-remove-header "MIME-Version")
+    (message-remove-header "Content-Disposition")
     (message-remove-header "Content-Transfer-Encoding")))
 
 (defun mml-to-mime ()
@@ -576,6 +713,9 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
   (message-encode-message-body)
   (save-restriction
     (message-narrow-to-headers-or-head)
+    ;; Skip past any From_ headers.
+    (while (looking-at "From ")
+      (forward-line 1))
     (let ((mail-parse-charset message-default-charset))
       (mail-encode-encoded-word-buffer))))
 
@@ -587,7 +727,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
 	(save-excursion
 	  (set-buffer (setq buffer (mml-generate-new-buffer " *mml*")))
 	  (mm-insert-part handle)
-	  (if (setq mmlp (equal (mm-handle-media-type handle) 
+	  (if (setq mmlp (equal (mm-handle-media-type handle)
 				"message/rfc822"))
 	      (mime-to-mml)))))
     (if mmlp
@@ -596,7 +736,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
 		   (equal (mm-handle-media-type handle) "text/plain"))
 	(mml-insert-mml-markup handle buffer textp)))
     (cond
-     (mmlp 
+     (mmlp
       (insert-buffer buffer)
       (goto-char (point-max))
       (insert "<#/mml>\n"))
@@ -653,12 +793,23 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
 (defvar mml-mode-map
   (let ((sign (make-sparse-keymap))
 	(encrypt (make-sparse-keymap))
+	(signpart (make-sparse-keymap))
+	(encryptpart (make-sparse-keymap))
 	(map (make-sparse-keymap))
 	(main (make-sparse-keymap)))
-    (define-key sign "p" 'mml-secure-sign-pgpmime)
-    (define-key sign "s" 'mml-secure-sign-smime)
-    (define-key encrypt "p" 'mml-secure-encrypt-pgpmime)
-    (define-key encrypt "s" 'mml-secure-encrypt-smime)
+    (define-key sign "p" 'mml-secure-message-sign-pgpmime)
+    (define-key sign "o" 'mml-secure-message-sign-pgp)
+    (define-key sign "s" 'mml-secure-message-sign-smime)
+    (define-key signpart "p" 'mml-secure-sign-pgpmime)
+    (define-key signpart "o" 'mml-secure-sign-pgp)
+    (define-key signpart "s" 'mml-secure-sign-smime)
+    (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
+    (define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
+    (define-key encrypt "s" 'mml-secure-message-encrypt-smime)
+    (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime)
+    (define-key encryptpart "o" 'mml-secure-encrypt-pgp)
+    (define-key encryptpart "s" 'mml-secure-encrypt-smime)
+    (define-key map "\C-n" 'mml-unsecure-message)
     (define-key map "f" 'mml-attach-file)
     (define-key map "b" 'mml-attach-buffer)
     (define-key map "e" 'mml-attach-external)
@@ -668,7 +819,9 @@ 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" 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'.
     ;; (define-key main "\M-m" map)
@@ -676,32 +829,41 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
     main))
 
 (easy-menu-define
- mml-menu mml-mode-map ""
- '("MML"
-   ("Attach"
-    ["File" mml-attach-file t]
-    ["Buffer" mml-attach-buffer t]
-    ["External" mml-attach-external t])
-   ("Insert"
-    ["Multipart" mml-insert-multipart t]
-    ["Part" mml-insert-part t])
-   ("Security"
-    ("Sign"
-     ["PGP/MIME" mml-secure-sign-pgpmime t]
-     ["S/MIME" mml-secure-sign-smime t])
-    ("Encrypt"
-     ["PGP/MIME" mml-secure-encrypt-pgpmime t]
-     ["S/MIME" mml-secure-encrypt-smime t]))
-   ;;["Narrow" mml-narrow-to-part t]
-   ["Quote" mml-quote-region t]
-   ["Validate" mml-validate t]
-   ["Preview" mml-preview t]))
+  mml-menu mml-mode-map ""
+  `("Attachments"
+    ["Attach File..." mml-attach-file
+     ,@(if (featurep 'xemacs) '(t)
+	 '(:help "Attach a file at point"))]
+    ["Attach Buffer..." mml-attach-buffer t]
+    ["Attach External..." mml-attach-external t]
+    ["Insert Part..." mml-insert-part t]
+    ["Insert Multipart..." mml-insert-multipart t]
+    ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t]
+    ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t]
+    ["PGP Sign" mml-secure-message-sign-pgp t]
+    ["PGP Encrypt" mml-secure-message-encrypt-pgp t]
+    ["S/MIME Sign" mml-secure-message-sign-smime t]
+    ["S/MIME Encrypt" mml-secure-message-encrypt-smime t]
+    ("Secure MIME part"
+     ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t]
+     ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t]
+     ["PGP Sign Part" mml-secure-sign-pgp t]
+     ["PGP Encrypt Part" mml-secure-encrypt-pgp t]
+     ["S/MIME Sign Part" mml-secure-sign-smime 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]
+    ["Validate MML" mml-validate t]
+    ["Preview" mml-preview t]))
 
 (defvar mml-mode nil
   "Minor mode for editing MML.")
 
 (defun mml-mode (&optional arg)
   "Minor mode for editing MML.
+MML is the MIME Meta Language, a minor mode for composing MIME articles.
+See Info node `(emacs-mime)Composing'.
 
 \\{mml-mode-map}"
   (interactive "P")
@@ -849,43 +1011,96 @@ TYPE is the MIME type to use."
   "Display current buffer with Gnus, in a new buffer.
 If RAW, don't highlight the article."
   (interactive "P")
-  (let ((buf (current-buffer))
-	(message-options message-options)
-	(message-posting-charset (or (gnus-setup-posting-charset 
-				      (save-restriction
-					(message-narrow-to-headers-or-head)
-					(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)
-    (if (re-search-forward
-	 (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
-	(replace-match "\n"))
-    (mml-to-mime)
-    (if raw
-	(when (fboundp 'set-buffer-multibyte)
-	  (let ((s (buffer-string)))
-	    ;; Insert the content into unibyte buffer.
-	    (erase-buffer)
-	    (mm-disable-multibyte)
-	    (insert s)))
-      (let ((gnus-newsgroup-charset (car message-posting-charset)))
-	(run-hooks 'gnus-article-decode-hook)
-	(let ((gnus-newsgroup-name "dummy"))
-	  (gnus-article-prepare-display))))
-    (fundamental-mode)
-    (setq buffer-read-only t)
-    (goto-char (point-min))))
+  (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
+					   (message-narrow-to-headers-or-head)
+					   (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)
+      (let ((message-deletable-headers (if (message-news-p)
+					   nil
+					 message-deletable-headers)))
+	(message-generate-headers
+	 (copy-sequence (if (message-news-p)
+			    message-required-news-headers
+			  message-required-mail-headers))))
+      (if (re-search-forward
+	   (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+	  (replace-match "\n"))
+      (let ((mail-header-separator ""));; mail-header-separator is removed.
+	(mml-to-mime))
+      (if raw
+	  (when (fboundp 'set-buffer-multibyte)
+	    (let ((s (buffer-string)))
+	      ;; Insert the content into unibyte buffer.
+	      (erase-buffer)
+	      (mm-disable-multibyte)
+	      (insert s)))
+	(let ((gnus-newsgroup-charset (car message-posting-charset))
+	      gnus-article-prepare-hook gnus-original-article-buffer)
+	  (run-hooks 'gnus-article-decode-hook)
+	  (let ((gnus-newsgroup-name "dummy")
+		(gnus-newsrc-hashtb (or gnus-newsrc-hashtb
+					(gnus-make-hashtable 5))))
+	    (gnus-article-prepare-display))))
+      ;; Disable article-mode-map.
+      (use-local-map nil)
+      (setq buffer-read-only t)
+      (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
+      (goto-char (point-min)))))
 
 (defun mml-validate ()
   "Validate the current MML document."
   (interactive)
   (mml-parse))
 
+(defun mml-tweak-part (cont)
+  "Tweak a MML part."
+  (let ((tweak (cdr (assq 'tweak cont)))
+	func)
+    (cond
+     (tweak
+      (setq func
+	    (or (cdr (assoc tweak mml-tweak-function-alist))
+		(intern tweak))))
+     (mml-tweak-type-alist
+      (let ((alist mml-tweak-type-alist)
+	    (type (or (cdr (assq 'type cont)) "text/plain")))
+	(while alist
+	  (if (string-match (caar alist) type)
+	      (setq func (cdar alist)
+		    alist nil)
+	    (setq alist (cdr alist)))))))
+    (if func
+	(funcall func cont)
+      cont)
+    (let ((alist mml-tweak-sexp-alist))
+      (while alist
+	(if (eval (caar alist))
+	    (funcall (cdar alist) cont))
+	(setq alist (cdr alist)))))
+  cont)
+
+(defun mml-tweak-externalize-attachments (cont)
+  "Tweak attached files as external parts."
+  (let (filename-cons)
+    (when (and (eq (car cont) 'part)
+	       (not (cdr (assq 'buffer cont)))
+	       (and (setq filename-cons (assq 'filename cont))
+		    (not (equal (cdr (assq 'nofile cont)) "yes"))))
+      (setcar cont 'external)
+      (setcar filename-cons 'name))))
+
 (provide 'mml)
 
 ;;; mml.el ends here