From: yamaoka <yamaoka>
Date: Fri, 28 Apr 2000 01:12:17 +0000 (+0000)
Subject: Sync.
X-Git-Tag: t-gnus-6_14-quimby-before-AC-changed-~94
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=995b234d91d4757069f6bb1a63d87e41930ebc90;p=elisp%2Fgnus.git-

Sync.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6d2f8c1..c727d00 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2000-04-27 20:32:06  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+	* gnus-msg.el (gnus-summary-mail-forward): Use ARG.
+	(gnus-summary-post-forward): Ditto.
+	* message.el (message-forward-show-mml): New variable.
+	(message-forward): Use it.
+	* mml.el (mml-parse-1): Add tag mml.
+	(mml-read-part): Ditto.
+	(mml-generate-mime): Support reentance.
+	(mml-generate-mime-1): Support mml tag.
+
 2000-04-27  Dave Love  <fx@gnu.org>
 
 	* gnus-art.el: Don't bother to require custom, browse-url.
diff --git a/lisp/message.el b/lisp/message.el
index 319baf3..59145cb 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -406,6 +406,11 @@ The provided functions are:
   :group 'message-forwarding
   :type 'boolean)
 
+(defcustom message-forward-show-mml t
+  "*If non-nil, forward messages are shown as mml.  Otherwise, forward messages are unchanged."
+  :group 'message-forwarding
+  :type 'boolean)
+
 (defcustom message-forward-before-signature t
   "*If non-nil, put forwarded message before signature, else after."
   :group 'message-forwarding
diff --git a/lisp/mml.el b/lisp/mml.el
index 6cee33d..17b84b9 100644
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -94,12 +94,12 @@ one charsets.")
 	(push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
 	      struct))
        (t
-	(if (looking-at "<#part")
+	(if (or (looking-at "<#part") (looking-at "<#mml"))
 	    (setq tag (mml-read-tag))
 	  (setq tag (list 'part '(type . "text/plain"))
 		warn t))
 	(setq point (point)
-	      contents (mml-read-part)
+	      contents (mml-read-part (eq 'mml (car tag)))
 	      charsets (mm-find-mime-charset-region point (point)))
 	(when (memq nil charsets)
 	  (if (or (memq 'unknown-encoding mml-confirmation-set)
@@ -204,14 +204,17 @@ one charsets.")
     (skip-chars-forward " \t\n")
     (cons (intern name) (nreverse contents))))
 
-(defun mml-read-part ()
-  "Return the buffer up till the next part, multipart or closing part or multipart."
+(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 colsing message."
   (let ((beg (point)))
     ;; 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 (re-search-forward
-	 "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t)
+	 (if mml
+	     "<#\\(/\\)\\(mml\\)."
+	   "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\).") nil t)
 	(prog1
 	    (buffer-substring-no-properties beg (match-beginning 0))
 	  (if (or (not (match-beginning 1))
@@ -228,7 +231,7 @@ one charsets.")
 (defun mml-generate-mime ()
   "Generate a MIME message based on the current MML document."
   (let ((cont (mml-parse))
-	(mml-multipart-number 0))
+	(mml-multipart-number mml-multipart-number))
     (if (not cont)
 	nil
       (with-temp-buffer
@@ -241,7 +244,7 @@ one charsets.")
 
 (defun mml-generate-mime-1 (cont)
   (cond
-   ((eq (car cont) 'part)
+   ((or (eq (car cont) 'part) (eq (car cont) 'mml))
     (let (coded encoding charset filename type)
       (setq type (or (cdr (assq 'type cont)) "text/plain"))
       (if (member (car (split-string type "/")) '("text" "message"))
@@ -252,6 +255,8 @@ one charsets.")
 	     ((and (setq filename (cdr (assq 'filename cont)))
 		   (not (equal (cdr (assq 'nofile cont)) "yes")))
 	      (mm-insert-file-contents filename))
+	     ((eq 'mml (car cont))
+	      (insert (cdr (assq 'contents cont))))
 	     (t
 	      (save-restriction
 		(narrow-to-region (point) (point))
@@ -259,22 +264,21 @@ one charsets.")
 		;; Remove quotes from quoted tags.
 		(goto-char (point-min))
 		(while (re-search-forward
-			"<#!+/?\\(part\\|multipart\\|external\\)" nil t)
+			"<#!+/?\\(part\\|multipart\\|external\\|mml\\)" 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
-			    (if (string= (car (split-string type "/"))
-					 "message")
-				'8bit
-			      (cdr (assq 'encoding cont)))))
+	    (cond 
+	     ((eq (car cont) 'mml)
+	      (let ((mml-boundary (funcall mml-boundary-function
+					   (incf mml-multipart-number))))
+		(mml-to-mime))
+	      (setq encoding (mm-body-7-or-8)))
+	     ((string= (car (split-string type "/")) "message")
+	      (setq encoding (mm-body-7-or-8)))
+	     (t 
+	      (setq charset (mm-encode-body))
+	      (setq encoding (mm-body-encoding
+			      charset (cdr (assq 'encoding cont))))))
 	    (setq coded (buffer-string)))
 	(mm-with-unibyte-buffer
 	  (cond
@@ -666,7 +670,7 @@ one charsets.")
       (goto-char (point-min))
       ;; Quote parts.
       (while (re-search-forward
-	      "<#/?!*\\(multipart\\|part\\|external\\)" nil t)
+	      "<#/?!*\\(multipart\\|part\\|external\\|mml\\)" nil t)
 	;; Insert ! after the #.
 	(goto-char (+ (match-beginning 0) 2))
 	(insert "!")))))