X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=28b73b2dbd6a2391a916a783a0f709d5bb846802;hb=33d9128fae4ddb2529278fbf8a0bebc0ee64d2c4;hp=52c3732fc6bebc4c24efd8e02094fef9033e4a01;hpb=58fdf5c3732b40b25c96b4035fd40819b29724ee;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index 52c3732..28b73b2 100644
--- a/wl/wl-draft.el
+++ b/wl/wl-draft.el
@@ -30,12 +30,13 @@
 
 ;;; Code:
 ;;
-
+(require 'elmo)
 (require 'sendmail)
 (require 'wl-template)
 (require 'emu)
 (condition-case nil (require 'timezone) (error nil))
 (require 'std11)
+(require 'eword-encode)
 (require 'wl-vars)
 
 (defvar x-face-add-x-face-version-header)
@@ -43,6 +44,7 @@
 (defvar mail-from-style)
 
 (eval-when-compile
+  (require 'cl)
   (require 'static)
   (require 'elmo-pop3)
   (defalias-maybe 'x-face-insert 'ignore)
@@ -90,10 +92,12 @@ e.g.
          (\"From\" . \"user@domain2\"))))")
 
 (defvar wl-draft-parent-number nil)
+(defvar wl-draft-parent-flag nil)
 
-(defconst wl-draft-reply-saved-variables
+(defconst wl-draft-parent-variables
   '(wl-draft-parent-folder
-    wl-draft-parent-number))
+    wl-draft-parent-number
+    wl-draft-parent-flag))
 
 (defvar wl-draft-config-sub-func-alist
   '((body		. wl-draft-config-sub-body)
@@ -121,6 +125,7 @@ e.g.
 (make-variable-buffer-local 'wl-draft-reply-buffer)
 (make-variable-buffer-local 'wl-draft-parent-folder)
 (make-variable-buffer-local 'wl-draft-parent-number)
+(make-variable-buffer-local 'wl-draft-parent-flag)
 
 (defvar wl-draft-folder-internal nil
   "Internal variable for caching `opened' draft folder.")
@@ -130,41 +135,32 @@ e.g.
 	  user mechanism server))
 
 (defmacro wl-smtp-extension-bind (&rest body)
-  (` (let* ((smtp-sasl-mechanisms
-	     (if wl-smtp-authenticate-type
-		 (mapcar 'upcase
-			 (if (listp wl-smtp-authenticate-type)
-			     wl-smtp-authenticate-type
-			   (list wl-smtp-authenticate-type)))))
-	    (smtp-use-sasl (and smtp-sasl-mechanisms t))
-	    (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
-	    (smtp-open-connection-function
-	     (if (eq wl-smtp-connection-type 'ssl)
-		 #'open-ssl-stream
-	       smtp-open-connection-function))
-	    (smtp-end-of-line
-	     (if (eq wl-smtp-connection-type 'ssl)
-		 "\n"
-	       smtp-end-of-line))
-	    smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
-       (if (and (string= (car smtp-sasl-mechanisms) "DIGEST-MD5")
-		;; sendmail bug?
-		(string-match "^\\([^@]*\\)@\\([^@]*\\)"
-			      wl-smtp-posting-user))
-	   (setq smtp-sasl-user-name (match-string 1 wl-smtp-posting-user)
-		 smtp-sasl-properties (list 'realm
-					    (match-string 2 wl-smtp-posting-user)))
-	 (setq smtp-sasl-user-name wl-smtp-posting-user
-	       smtp-sasl-properties nil))
-       (setq sasl-read-passphrase
-	     (function
-	      (lambda (prompt)
-		(elmo-get-passwd
-		 (wl-smtp-password-key
-		  smtp-sasl-user-name
-		  (car smtp-sasl-mechanisms)
-		  smtp-server)))))
-       (,@ body))))
+  `(let* ((smtp-sasl-mechanisms
+	   (if wl-smtp-authenticate-type
+	       (mapcar 'upcase
+		       (if (listp wl-smtp-authenticate-type)
+			   wl-smtp-authenticate-type
+			 (list wl-smtp-authenticate-type)))))
+	  (smtp-use-sasl (and smtp-sasl-mechanisms t))
+	  (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
+	  (smtp-open-connection-function
+	   (if (eq wl-smtp-connection-type 'ssl)
+	       #'open-ssl-stream
+	     smtp-open-connection-function))
+	  smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
+     (setq smtp-sasl-user-name wl-smtp-posting-user
+	   smtp-sasl-properties (when wl-smtp-authenticate-realm
+				  (list 'realm
+					wl-smtp-authenticate-realm)))
+     (setq sasl-read-passphrase
+	   (function
+	    (lambda (prompt)
+	      (elmo-get-passwd
+	       (wl-smtp-password-key
+		smtp-sasl-user-name
+		(car smtp-sasl-mechanisms)
+		smtp-server)))))
+     ,@body))
 
 (defun wl-draft-insert-date-field ()
   "Insert Date field."
@@ -224,51 +220,60 @@ e.g.
 		   (list (concat wl-draft-mime-bcc-field-name  ":")))))))
 
 (defun wl-draft-make-mail-followup-to (recipients)
-  (if (elmo-list-member
-       (or wl-user-mail-address-list
-	   (list (wl-address-header-extract-address wl-from)))
-       recipients)
-      (let ((rlist (elmo-list-delete
-		    (or wl-user-mail-address-list
-			(list (wl-address-header-extract-address wl-from)))
-		    recipients
-		    (lambda (elem list)
-		      (elmo-delete-if
-		       (lambda (item) (string= (downcase elem)
-					       (downcase item)))
-		       list)))))
-	(if (elmo-list-member rlist (mapcar 'downcase
-					    wl-subscribed-mailing-list))
-	    rlist
-	  (append rlist (list (wl-address-header-extract-address
-			       wl-from)))))
-    recipients))
+  (let ((rlist (wl-address-delete-user-mail-addresses recipients)))
+    (if (elmo-list-member rlist (mapcar 'downcase
+					wl-subscribed-mailing-list))
+	rlist
+      (append rlist (list (wl-address-header-extract-address
+			   wl-from))))))
 
 (defun wl-draft-delete-myself-from-cc (to cc)
-  (let ((myself (or wl-user-mail-address-list
-		    (list (wl-address-header-extract-address wl-from)))))
-    (cond (wl-draft-always-delete-myself ; always-delete option
-	   (elmo-list-delete myself cc
-			     (lambda (elem list)
-			       (elmo-delete-if
-				(lambda (item) (string= (downcase elem)
-							(downcase item)))
-				list))))
-	  ((elmo-list-member (append to cc) ; subscribed mailing-list
-			     (mapcar 'downcase wl-subscribed-mailing-list))
-	   (elmo-list-delete myself cc
-			     (lambda (elem list)
-			       (elmo-delete-if
-				(lambda (item) (string= (downcase elem)
-							(downcase item)))
-				list))))
-	  (t cc))))
-
-(defun wl-draft-forward (original-subject summary-buf)
-  (let (references parent-folder)
+  (cond (wl-draft-always-delete-myself ; always-delete option
+	 (wl-address-delete-user-mail-addresses cc))
+	((elmo-list-member (append to cc) ; subscribed mailing-list
+			   (mapcar 'downcase wl-subscribed-mailing-list))
+	 (wl-address-delete-user-mail-addresses cc))
+	(t cc)))
+
+(defsubst wl-draft-strip-subject-regexp (subject regexp)
+  "Remove REGEXP from SUBJECT string."
+  (if (string-match regexp subject)
+      (substring subject (match-end 0))
+    subject))
+
+(defun wl-draft-forward-make-subject (original-subject)
+  "Generate subject string for forwarding."
+  (cond ((functionp wl-forward-subject-prefix)
+	 (concat (funcall wl-forward-subject-prefix)
+		 original-subject))
+	((stringp wl-forward-subject-prefix)
+	 (concat wl-forward-subject-prefix
+		 (wl-draft-strip-subject-regexp
+		  (or original-subject "")
+		  wl-subject-forward-prefix-regexp)))
+	(t original-subject)))
+
+(defun wl-draft-reply-make-subject (original-subject)
+  "Generate subject string for replying."
+  (cond ((functionp wl-reply-subject-prefix)
+	 (concat (funcall wl-reply-subject-prefix)
+		 original-subject))
+	((stringp wl-reply-subject-prefix)
+	 (concat wl-reply-subject-prefix
+		 (wl-draft-strip-subject-regexp
+		  (or original-subject "")
+		  wl-subject-re-prefix-regexp)))
+	(t original-subject)))
+
+(defun wl-draft-forward (original-subject summary-buf &optional number)
+  (let (references parent-folder subject)
     (with-current-buffer summary-buf
       (setq parent-folder (wl-summary-buffer-folder-name)))
+    (let ((decoder (mime-find-field-decoder 'Subject 'plain)))
+      (setq subject (if (and original-subject decoder)
+			(funcall decoder original-subject) original-subject)))
     (with-current-buffer (wl-message-get-original-buffer)
+      (setq subject (wl-draft-forward-make-subject subject))
       (setq references (nconc
 			(std11-field-bodies '("References" "In-Reply-To"))
 			(list (std11-field-body "Message-Id"))))
@@ -282,93 +287,92 @@ e.g.
 	 (get-buffer-window summary-buf)
 	 (select-window (get-buffer-window summary-buf)))
     (wl-draft (list (cons 'To "")
-		    (cons 'Subject
-			  (concat wl-forward-subject-prefix original-subject))
+		    (cons 'Subject subject)
 		    (cons 'References references))
-	      nil nil nil nil parent-folder))
+	      nil nil nil nil parent-folder number))
   (goto-char (point-max))
   (wl-draft-insert-message)
-  (mail-position-on-field "To"))
-
-(defun wl-draft-strip-subject-re (subject)
-  "Remove \"Re:\" from SUBJECT string. Shamelessly copied from Gnus."
-  (if (string-match wl-subject-prefix-regexp subject)
-      (substring subject (match-end 0))
-    subject))
+  (mail-position-on-field "To")
+  (setq wl-draft-config-variables
+	(append wl-draft-parent-variables
+		wl-draft-config-variables))
+  (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
+  (run-hooks 'wl-draft-forward-hook))
 
 (defun wl-draft-self-reply-p ()
   "Return t when From address in the current message is user's self one or not."
   (wl-address-user-mail-address-p (or (elmo-field-body "From") "")))
 
+(defun wl-draft-find-reply-headers (rule-symbol)
+  (let ((rule-list (symbol-value rule-symbol))
+	condition-match-p result)
+    (setq condition-match-p
+	  (lambda (condition)
+	    (cond ((stringp condition)
+		   (std11-field-body condition))
+		  ((functionp condition)
+		   (funcall condition))
+		  ((consp condition)
+		   (and (funcall condition-match-p (car condition))
+			(funcall condition-match-p (cdr condition))))
+		  ((null condition))
+		  (t
+		   (error "Unkown condition in `%s'" rule-symbol)))))
+    (while (and (null result) rule-list)
+      (let ((rule (car rule-list)))
+	(when (funcall condition-match-p (car rule))
+	  (setq result (cdr rule)))
+	(setq rule-list (cdr rule-list))))
+    result))
+
 (defun wl-draft-reply (buf with-arg summary-buf &optional number)
-  "Reply to BUF buffer message.
-Reply to author if WITH-ARG is non-nil."
+  "Create draft for replying to the message in buffer BUF.
+Recipients are prepared along `wl-draft-reply-without-argument-list',
+or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
 ;;;(save-excursion
-  (let (r-list
+  (let ((rule-list (if with-arg
+		       'wl-draft-reply-with-argument-list
+		     'wl-draft-reply-without-argument-list))
+	reply-headers
 	to mail-followup-to cc subject in-reply-to references newsgroups
 	to-alist cc-alist decoder parent-folder)
     (when (buffer-live-p summary-buf)
       (with-current-buffer summary-buf
 	(setq parent-folder (wl-summary-buffer-folder-name))))
     (set-buffer (or buf mime-mother-buffer))
-    (setq r-list (if with-arg wl-draft-reply-with-argument-list
-		   wl-draft-reply-without-argument-list))
-    (catch 'done
-      (while r-list
-	(when (let ((condition (car (car r-list))))
-		(cond ((stringp condition)
-		       (std11-field-body condition))
-		      ((listp condition)
-		       (catch 'done
-			 (while condition
-			   (cond
-			    ((stringp (car condition))
-			     (or (std11-field-body (car condition))
-				 (throw 'done nil)))
-			    ((symbolp (car condition))
-			     (or (funcall (car condition))
-				 (throw 'done nil)))
-			    (t
-			     (debug)))
-			   (setq condition (cdr condition)))
-			 t))
-		      ((symbolp condition)
-		       (funcall condition))))
-	  (let ((r-to-list (nth 0 (cdr (car r-list))))
-		(r-cc-list (nth 1 (cdr (car r-list))))
-		(r-ng-list (nth 2 (cdr (car r-list)))))
-	    (when (and (member "Followup-To" r-ng-list)
-		       (string= (std11-field-body "Followup-To") "poster"))
-	      (setq r-to-list (cons "From" r-to-list))
-	      (setq r-ng-list (delete "Followup-To"
-				      (copy-sequence r-ng-list))))
-	    (if (and r-to-list (symbolp r-to-list))
-		(setq to (wl-concat-list (funcall r-to-list) ","))
-	      (setq to (wl-concat-list (cons to
-					     (elmo-multiple-fields-body-list
-					      r-to-list))
-				       ",")))
-	    (if (and r-cc-list (symbolp r-cc-list))
-		(setq cc (wl-concat-list (funcall r-cc-list) ","))
-	      (setq cc (wl-concat-list (cons cc
-					     (elmo-multiple-fields-body-list
-					      r-cc-list))
-				       ",")))
-	    (if (and r-ng-list (symbolp r-ng-list))
-		(setq newsgroups (wl-concat-list (funcall r-ng-list) ","))
-	      (setq newsgroups (wl-concat-list (cons newsgroups
-						     (std11-field-bodies
-						      r-ng-list))
-					       ","))))
-	  (throw 'done nil))
-	(setq r-list (cdr r-list)))
-      (error "No match field: check your `wl-draft-reply-%s-argument-list'"
-	     (if with-arg "with" "without")))
+    (setq reply-headers
+	  (or (wl-draft-find-reply-headers rule-list)
+	      (error "No match field: check your `%s'" rule-list)))
+    (let ((r-to-list (nth 0 reply-headers))
+	  (r-cc-list (nth 1 reply-headers))
+	  (r-ng-list (nth 2 reply-headers)))
+      (setq to (wl-concat-list
+		(nconc
+		 (if (functionp r-to-list)
+		     (funcall r-to-list)
+		   (elmo-multiple-fields-body-list r-to-list))
+		 (and (member "Followup-To" r-ng-list)
+		      (string= (std11-field-body "Followup-To") "poster")
+		      (progn
+			(setq r-ng-list (delete "Followup-To"
+						(copy-sequence r-ng-list)))
+			(elmo-multiple-fields-body-list '("From")))))
+		","))
+      (setq cc (wl-concat-list
+		(if (functionp r-cc-list)
+		    (funcall r-cc-list)
+		  (elmo-multiple-fields-body-list r-cc-list))
+		","))
+      (setq newsgroups (wl-concat-list
+			(if (functionp r-ng-list)
+			    (funcall r-ng-list)
+			  (std11-field-bodies r-ng-list))
+			",")))
     (setq subject (std11-field-body "Subject"))
     (setq to (wl-parse-addresses to)
 	  cc (wl-parse-addresses cc))
     (with-temp-buffer			; to keep raw buffer unibyte.
-      (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+      (set-buffer-multibyte default-enable-multibyte-characters)
       (setq decoder (mime-find-field-decoder 'Subject 'plain))
       (setq subject (if (and subject decoder)
 			(funcall decoder subject) subject))
@@ -386,10 +390,7 @@ Reply to author if WITH-ARG is non-nil."
 	       (cons (nth 1 (std11-extract-address-components addr))
 		     (if decoder (funcall decoder addr) addr)))
 	     cc)))
-    (and wl-reply-subject-prefix
-	 (setq subject (concat wl-reply-subject-prefix
-			       (wl-draft-strip-subject-re
-				(or subject "")))))
+    (setq subject (wl-draft-reply-make-subject subject))
     (setq in-reply-to (std11-field-body "Message-Id"))
     (setq references (nconc
 		      (std11-field-bodies '("References" "In-Reply-To"))
@@ -405,8 +406,8 @@ Reply to author if WITH-ARG is non-nil."
 	    (wl-draft-make-mail-followup-to (append to cc)))
       (setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
     (with-temp-buffer			; to keep raw buffer unibyte.
-      (elmo-set-buffer-multibyte default-enable-multibyte-characters)
-      (setq newsgroups (wl-parse newsgroups
+      (set-buffer-multibyte default-enable-multibyte-characters)
+      (setq newsgroups (elmo-parse newsgroups
 				 "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
 	    newsgroups (wl-delete-duplicates newsgroups)
 	    newsgroups
@@ -422,24 +423,24 @@ Reply to author if WITH-ARG is non-nil."
 		      to (copy-sequence to))
 	      t t))
     (and to (setq to (mapconcat
-		      '(lambda (addr)
-			 (if wl-draft-reply-use-address-with-full-name
-			     (or (cdr (assoc addr to-alist)) addr)
-			   addr))
+		      (lambda (addr)
+			(if wl-draft-reply-use-address-with-full-name
+			    (or (cdr (assoc addr to-alist)) addr)
+			  addr))
 		      to ",\n\t")))
     (and cc (setq cc (mapconcat
-		      '(lambda (addr)
-			 (if wl-draft-reply-use-address-with-full-name
-			     (or (cdr (assoc addr cc-alist)) addr)
-			   addr))
+		      (lambda (addr)
+			(if wl-draft-reply-use-address-with-full-name
+			    (or (cdr (assoc addr cc-alist)) addr)
+			  addr))
 		      cc ",\n\t")))
     (and mail-followup-to
 	 (setq mail-followup-to
 	       (mapconcat
-		'(lambda (addr)
-		   (if wl-draft-reply-use-address-with-full-name
-		       (or (cdr (assoc addr (append to-alist cc-alist))) addr)
-		     addr))
+		(lambda (addr)
+		  (if wl-draft-reply-use-address-with-full-name
+		      (or (cdr (assoc addr (append to-alist cc-alist))) addr)
+		    addr))
 		mail-followup-to ",\n\t")))
     (and (null to) (setq to cc cc nil))
     (setq references (delq nil references)
@@ -458,13 +459,13 @@ Reply to author if WITH-ARG is non-nil."
 		    (cons 'In-Reply-To in-reply-to)
 		    (cons 'References references)
 		    (cons 'Mail-Followup-To mail-followup-to))
-	      nil nil nil nil parent-folder)
-    (setq wl-draft-parent-number number)
+	      nil nil nil nil parent-folder number)
     (setq wl-draft-reply-buffer buf)
     (setq wl-draft-config-variables
-	  (append wl-draft-reply-saved-variables
-		  wl-draft-config-variables)))
-  (run-hooks 'wl-reply-hook))
+	  (append wl-draft-parent-variables
+		  wl-draft-config-variables))
+    (wl-draft-config-info-operation wl-draft-buffer-message-number 'save))
+  (run-hooks 'wl-draft-reply-hook))
 
 (defun wl-draft-reply-position (position)
   (cond ((eq position 'body)
@@ -486,8 +487,7 @@ Reply to author if WITH-ARG is non-nil."
   (wl-draft-add-in-reply-to "References"))
 
 (defun wl-draft-add-in-reply-to (&optional alt-field)
-  (let* ((mes-id (save-excursion
-		   (set-buffer mail-reply-buffer)
+  (let* ((mes-id (with-current-buffer mail-reply-buffer
 		   (std11-field-body "message-id")))
 	 (field (or alt-field "In-Reply-To"))
 	 (ref (std11-field-body field))
@@ -516,12 +516,13 @@ Reply to author if WITH-ARG is non-nil."
   (save-restriction
     (narrow-to-region (point)(point))
     (insert
-     (with-current-buffer mail-reply-buffer
-       (when decode-it
-	 (decode-mime-charset-region (point-min) (point-max)
-				     wl-mime-charset))
-       (buffer-substring-no-properties
-	(point-min) (point-max))))
+     (string-as-multibyte
+      (with-current-buffer mail-reply-buffer
+	(when decode-it
+	  (decode-mime-charset-region (point-min) (point-max)
+				      wl-mime-charset))
+	(buffer-substring-no-properties
+	 (point-min) (point-max)))))
     (when ignored-fields
       (goto-char (point-min))
       (wl-draft-delete-fields ignored-fields))
@@ -608,10 +609,7 @@ Reply to author if WITH-ARG is non-nil."
 	(set-buffer
 	 (wl-draft (list
 		    (cons 'From
-			  (if (member
-			       (nth 1 (std11-extract-address-components from))
-			       wl-user-mail-address-list)
-			      from))
+			  (if (wl-address-user-mail-address-p from) from))
 		    (cons 'To to)
 		    (cons 'Cc cc)
 		    (cons 'Subject subject)
@@ -636,17 +634,22 @@ Reply to author if WITH-ARG is non-nil."
 	mail-citation-hook mail-yank-hooks
 	wl-draft-add-references wl-draft-add-in-reply-to
 	wl-draft-cite-function)
-    (with-current-buffer wl-draft-buffer-cur-summary-buffer
-      (with-current-buffer wl-message-buffer
-	(setq original-buffer (wl-message-get-original-buffer))
-	(if (zerop
-	     (with-current-buffer original-buffer
-	       (buffer-size)))
-	    (error "No current message"))))
-    (setq mail-reply-buffer original-buffer)
-    (wl-draft-yank-from-mail-reply-buffer
-     nil
-     wl-ignored-forwarded-headers)))
+    (if (and wl-draft-buffer-cur-summary-buffer
+	     (with-current-buffer wl-draft-buffer-cur-summary-buffer
+	       (and wl-message-buffer
+		    (with-current-buffer wl-message-buffer
+		      (setq original-buffer (wl-message-get-original-buffer))
+		      (not (zerop (with-current-buffer original-buffer
+				    (buffer-size))))))))
+	(progn
+	  (setq mail-reply-buffer original-buffer)
+	  (wl-draft-yank-from-mail-reply-buffer
+	   nil
+	   wl-ignored-forwarded-headers))
+      (when (string= (mime-make-tag "message" "rfc822")
+		     (buffer-substring-no-properties (point-at-bol 0)(point-at-eol 0)))
+	(delete-region (point-at-bol 0) (1+ (point-at-eol 0))))
+      (error "No current message"))))
 
 (defun wl-draft-insert-get-message (dummy)
   (let ((fld (completing-read
@@ -665,11 +668,12 @@ Reply to author if WITH-ARG is non-nil."
 	wl-draft-cite-function)
     (unwind-protect
 	(progn
-	  (elmo-message-fetch (wl-folder-get-elmo-folder fld)
-			      number
-			      ;; No cache.
-			      (elmo-make-fetch-strategy 'entire)
-			      nil mail-reply-buffer)
+	  (with-current-buffer mail-reply-buffer
+	    (erase-buffer)
+	    (elmo-message-fetch (wl-folder-get-elmo-folder fld)
+				number
+				;; No cache.
+				(elmo-make-fetch-strategy 'entire)))
 	  (wl-draft-yank-from-mail-reply-buffer nil))
       (kill-buffer mail-reply-buffer))))
 
@@ -707,13 +711,14 @@ Reply to author if WITH-ARG is non-nil."
   "Yank original message."
   (interactive "P")
   (if arg
-      (let (buf mail-reply-buffer)
-	(elmo-set-work-buf
-	 (insert "\n")
-	 (yank)
-	 (setq buf (current-buffer)))
-	(setq mail-reply-buffer buf)
-	(wl-draft-yank-from-mail-reply-buffer nil))
+      (let ((draft-buffer (current-buffer))
+	    mail-reply-buffer)
+	(with-temp-buffer
+	  (insert "\n")
+	  (yank)
+	  (setq mail-reply-buffer (current-buffer))
+	  (with-current-buffer draft-buffer
+	    (wl-draft-yank-from-mail-reply-buffer nil))))
     (wl-draft-yank-current-message-entity)))
 
 (defun wl-draft-hide (editing-buffer)
@@ -750,9 +755,8 @@ Reply to author if WITH-ARG is non-nil."
 
 (defun wl-draft-delete (editing-buffer)
   "Kill the editing draft buffer and delete the file corresponds to it."
-  (save-excursion
-    (when editing-buffer
-      (set-buffer editing-buffer)
+  (when editing-buffer
+    (with-current-buffer editing-buffer
       (when wl-draft-buffer-message-number
 	(elmo-folder-delete-messages (wl-draft-get-folder)
 				     (list
@@ -771,23 +775,7 @@ Reply to author if WITH-ARG is non-nil."
 	       (or force-kill
 		   (yes-or-no-p "Kill Current Draft? ")))
       (let ((cur-buf (current-buffer)))
-	(when (and wl-draft-parent-number
-		   (not (string= wl-draft-parent-folder "")))
-	  (let* ((number wl-draft-parent-number)
-		 (folder-name wl-draft-parent-folder)
-		 (folder (wl-folder-get-elmo-folder folder-name))
-		 buffer)
-	    (if (and (setq buffer (wl-summary-get-buffer folder-name))
-		     (with-current-buffer buffer
-		       (string= (wl-summary-buffer-folder-name)
-				folder-name)))
-		(with-current-buffer buffer
-		  (elmo-folder-unset-flag folder (list number) 'answered)
-		  (when (wl-summary-jump-to-msg number)
-		    (wl-summary-update-persistent-mark)))
-	      (elmo-folder-open folder 'load-msgdb)
-	      (elmo-folder-unset-flag folder (list number) 'answered)
-	      (elmo-folder-close folder))))
+	(run-hooks 'wl-draft-kill-pre-hook)
 	(wl-draft-hide cur-buf)
 	(wl-draft-delete cur-buf)))
     (message "")))
@@ -838,16 +826,16 @@ text was killed."
 ;; function for wl-sent-message-via
 
 (defmacro wl-draft-sent-message-p (type)
-  (` (eq (nth 1 (assq (, type) wl-sent-message-via)) 'sent)))
+  `(eq (nth 1 (assq ,type wl-sent-message-via)) 'sent))
 
 (defmacro wl-draft-set-sent-message (type result &optional server-port)
-  (` (let ((element (assq (, type) wl-sent-message-via)))
-       (if element
-	   (unless (eq (nth 1 element) (, result))
-	     (setcdr element (list (, result) (, server-port)))
-	     (setq wl-sent-message-modified t))
-	 (push (list (, type) (, result) (, server-port)) wl-sent-message-via)
-	 (setq wl-sent-message-modified t)))))
+  `(let ((element (assq ,type wl-sent-message-via)))
+     (if element
+	 (unless (eq (nth 1 element) ,result)
+	   (setcdr element (list ,result ,server-port))
+	   (setq wl-sent-message-modified t))
+       (push (list ,type ,result ,server-port) wl-sent-message-via)
+       (setq wl-sent-message-modified t))))
 
 (defun wl-draft-sent-message-results ()
   (let ((results wl-sent-message-via)
@@ -877,7 +865,7 @@ text was killed."
 			  (concat " to="
 				  (mapconcat
 				   'identity
-				   (mapcar '(lambda(x) (format "<%s>" x)) to)
+				   (mapcar (lambda (x) (format "<%s>" x)) to)
 				   ","))))
 		   ""))
 	     (id (if id (concat " id=" id) ""))
@@ -1080,8 +1068,7 @@ non-nil."
 		(newline))
 	    (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
 	    (if mail-interactive
-		(save-excursion
-		  (set-buffer errbuf)
+		(with-current-buffer errbuf
 		  (erase-buffer)))
 	    (wl-draft-delete-field "bcc" delimline)
 	    (wl-draft-delete-field "resent-bcc" delimline)
@@ -1175,12 +1162,12 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
 		  (re-search-forward "\n[ \t]*\n\n*" nil t))
       (replace-match "\n"))
     (goto-char (point-min))
-    (while (re-search-forward 
+    (while (re-search-forward
 	    "^[^ \t\n:]+:[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n"
 	    nil t)
       (when (string= "" (match-string 1))
 	(replace-match ""))))
-;;;  (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
+;;;  (run-hooks 'wl-mail-send-pre-hook) ; X-PGP-Sig, Cancel-Lock
   (wl-draft-dispatch-message)
   (when kill-when-done
     ;; hide editing-buffer.
@@ -1282,55 +1269,41 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
     result))
 
 (defcustom wl-draft-send-confirm-with-preview t
-  "Non-nil to invoke preview through confirmation of sending.
+  "*Non-nil to invoke preview through confirmation of sending.
 This variable is valid when `wl-interactive-send' has non-nil value."
   :type 'boolean
   :group 'wl-draft)
 
 (defun wl-draft-send-confirm ()
-  (let (answer)
-    (unwind-protect
-	(condition-case quit
-	    (progn
-	      (when wl-draft-send-confirm-with-preview
-		(wl-draft-preview-message))
-	      (save-excursion
-		(goto-char (point-min)) ; to show recipients in header
-		(catch 'done
-		  (while t
-		    (discard-input)
-		    (message "Send current draft? <y/n/j(down)/k(up)> ")
-		    (setq answer (let ((cursor-in-echo-area t)) (read-char)))
-		    (cond
-		     ((or (eq answer ?y)
-			  (eq answer ?Y)
-			  (eq answer ? ))
-		  (throw 'done t))
-		     ((or (eq answer ?v)
-			  (eq answer ?j)
-			  (eq answer ?J))
-		      (condition-case err
-			  (scroll-up)
-			(error nil)))
-		     ((or (eq answer ?^)
-			  (eq answer ?k)
-			  (eq answer ?K))
-		      (condition-case err
-			  (scroll-down)
-			(error nil)))
-		     (t
-		      (throw 'done nil)))))))
-	  (quit nil))
-      (when wl-draft-send-confirm-with-preview
-	(mime-preview-quit)))))
+  (unwind-protect
+      (condition-case nil
+	  (progn
+	    (when wl-draft-send-confirm-with-preview
+	      (let (wl-draft-send-hook
+		    (pgg-decrypt-automatically nil))
+		(wl-draft-preview-message)))
+	    (save-excursion
+	      (goto-char (point-min)) ; to show recipients in header
+	      (funcall
+	       (if (functionp wl-draft-send-confirm-type)
+		   wl-draft-send-confirm-type
+		 (lambda (prompt)
+		   (wl-y-or-n-p-with-scroll
+		    prompt
+		    (eq wl-draft-send-confirm-type 'scroll-by-SPC/BS))))
+	       "Send current draft? ")))
+	(quit nil))
+    (when (and wl-draft-send-confirm-with-preview
+	       (eq major-mode 'mime-view-mode))
+      (wl-mime-quit-preview))))
 
 (defun wl-draft-send (&optional kill-when-done mes-string)
   "Send current draft message.
 If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
   (interactive)
-  ;; Don't call this explicitly.
-  ;; Added to 'wl-draft-send-hook (by teranisi)
-  ;; (wl-draft-config-exec)
+;;; Don't call this explicitly.
+;;; Added to 'wl-draft-send-hook (by teranisi)
+;;;  (wl-draft-config-exec)
   (run-hooks 'wl-draft-send-hook)
   (when (or (not wl-interactive-send)
 	    (wl-draft-send-confirm))
@@ -1340,11 +1313,13 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 			   " *wl-draft-sending-buffer*"
 			   (append wl-draft-config-variables
 				   (wl-draft-clone-local-variables))))
+	  (parent-flag wl-draft-parent-flag)
+	  (parent-number wl-draft-parent-number)
+	  (parent-folder wl-draft-parent-folder)
 	  (wl-draft-verbose-msg nil)
 	  err)
       (unwind-protect
-	  (save-excursion
-	    (set-buffer sending-buffer)
+	  (with-current-buffer sending-buffer
 	    (if (and (not (wl-message-mail-p))
 		     (not (wl-message-news-p)))
 		(error "No recipient is specified"))
@@ -1360,6 +1335,18 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	    ;;
 	    (if wl-draft-verbose-send
 		(message "%s" (or mes-string "Sending...")))
+	    ;; Set flag before send-function because
+	    ;; there's no need to change current mailbox at this time.
+	    ;; If flag is set after send-function, the current mailbox
+	    ;; might changed by Fcc.
+	    ;; It causes a huge loss in the IMAP folder.
+	    (when (and parent-flag parent-number
+		       (not (eq (length parent-folder) 0)))
+	      (condition-case nil
+		  (wl-folder-set-persistent-mark
+		   parent-folder parent-number parent-flag)
+		(error
+		 (message "Set mark (%s) failed" (symbol-name parent-flag)))))
 	    (funcall wl-draft-send-function editing-buffer kill-when-done)
 	    ;; Now perform actions on successful sending.
 	    (while mail-send-actions
@@ -1412,7 +1399,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 			"This is a blind carbon copy.")
 		    "\n")
 	    (mime-edit-insert-tag "message" "rfc822")
-	    (insert-buffer draft-buffer)
+	    (insert-buffer-substring draft-buffer)
 	    (let (wl-interactive-send)
 	      (wl-draft-send 'kill-when-done))))))))
 
@@ -1444,7 +1431,11 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		(insert (if (eq (char-before) ?\n) "" "\n")
 			mail-header-separator "\n")))
 	    (let ((mime-header-encode-method-alist
-		   '((eword-encode-unstructured-field-body))))
+		   (append
+		    '((eword-encode-unstructured-field-body
+		       .  (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From)))
+		    (if (boundp 'mime-header-encode-method-alist)
+			(symbol-value 'mime-header-encode-method-alist)))))
 	      (mime-edit-translate-buffer))
 	    (wl-draft-get-header-delimiter t)
 	    (setq next-number
@@ -1453,7 +1444,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	  (elmo-folder-check (wl-draft-get-folder))
 	  (elmo-folder-commit (wl-draft-get-folder))
 	  (setq wl-draft-buffer-message-number next-number)
-	  (rename-buffer (format "%s/%d" wl-draft-folder next-number))
+	  (rename-buffer (format "%s/%d" wl-draft-folder next-number) t)
 	  (setq buffer-file-name (buffer-name))
 	  (set-buffer-modified-p nil)
 	  (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
@@ -1564,15 +1555,12 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 
 (defun wl-draft-do-fcc (header-end &optional fcc-list)
   (let ((send-mail-buffer (current-buffer))
-	(tembuf (generate-new-buffer " fcc output"))
 	(case-fold-search t)
 	beg end)
     (or (markerp header-end) (error "HEADER-END must be a marker"))
-    (save-excursion
-      (unless fcc-list
-	(setq fcc-list (wl-draft-get-fcc-list header-end)))
-      (set-buffer tembuf)
-      (erase-buffer)
+    (unless fcc-list
+      (setq fcc-list (wl-draft-get-fcc-list header-end)))
+    (with-temp-buffer
       ;; insert just the headers to avoid moving the gap more than
       ;; necessary (the message body could be arbitrarily huge.)
       (insert-buffer-substring send-mail-buffer 1 header-end)
@@ -1580,14 +1568,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
       (goto-char (point-max))
       (insert-buffer-substring send-mail-buffer header-end)
       (let ((id (std11-field-body "Message-ID"))
-	    (elmo-enable-disconnected-operation t)
-	    cache-saved)
+	    (elmo-enable-disconnected-operation t))
 	(while fcc-list
-	  (unless (or cache-saved
-		      (elmo-folder-plugged-p
-		       (wl-folder-get-elmo-folder (car fcc-list))))
-	    (elmo-file-cache-save id nil) ;; for disconnected operation
-	    (setq cache-saved t))
 	  (if (elmo-folder-append-buffer
 	       (wl-folder-get-elmo-folder
 		(eword-decode-string (car fcc-list)))
@@ -1599,8 +1581,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	      (or (equal (car fcc-list) (car wl-read-folder-history))
 		  (setq wl-read-folder-history
 			(append (list (car fcc-list)) wl-read-folder-history))))
-	  (setq fcc-list (cdr fcc-list)))))
-    (kill-buffer tembuf)))
+	  (setq fcc-list (cdr fcc-list)))))))
 
 (defun wl-draft-on-field-p ()
   (if (< (point)
@@ -1628,7 +1609,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 (defun wl-draft (&optional header-alist
 			   content-type content-transfer-encoding
 			   body edit-again
-			   parent-folder)
+			   parent-folder
+			   parent-number)
   "Write and send mail/news message with Wanderlust."
   (interactive)
   (require 'wl)
@@ -1640,9 +1622,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
   (let (wl-demo)
     (wl-init)) ; returns immediately if already initialized.
 
-
+  (wl-start-save-drafts)
   (let (buffer header-alist-internal)
-    (setq buffer (wl-draft-create-buffer parent-folder))
+    (setq buffer (wl-draft-create-buffer parent-folder parent-number))
     (unless (cdr (assq 'From header-alist))
       (setq header-alist
 	    (append (list (cons 'From wl-from)) header-alist)))
@@ -1684,18 +1666,15 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	   (goto-char (point-max))))
     buffer))
 
-(defun wl-draft-create-buffer (&optional parent-folder)
+(defun wl-draft-create-buffer (&optional parent-folder parent-number)
   (let* ((draft-folder (wl-draft-get-folder))
-	 (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
-	 (summary-buf (wl-summary-get-buffer parent-folder))
 	 (reply-or-forward
 	  (or (eq this-command 'wl-summary-reply)
 	      (eq this-command 'wl-summary-reply-with-citation)
 	      (eq this-command 'wl-summary-forward)
 	      (eq this-command 'wl-summary-target-mark-forward)
 	      (eq this-command 'wl-summary-target-mark-reply-with-citation)))
-	 (buffer (generate-new-buffer "*draft*")) ; Just for initial name.
-	 change-major-mode-hook)
+	 (buffer (generate-new-buffer "*draft*"))) ; Just for initial name.
     (set-buffer buffer)
     ;; switch-buffer according to draft buffer style.
     (if wl-draft-use-frame
@@ -1731,7 +1710,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		 (funcall wl-draft-buffer-style buffer)
 	       (error "Invalid value for wl-draft-buffer-style"))))))
     (auto-save-mode -1)
-    (wl-draft-mode)
+    (let (change-major-mode-hook)
+      (wl-draft-mode))
+    (set-buffer-multibyte t)		; draft buffer is always multibyte.
     (make-local-variable 'truncate-partial-width-windows)
     (setq truncate-partial-width-windows nil)
     (setq truncate-lines wl-draft-truncate-lines)
@@ -1739,8 +1720,10 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (setq wl-sent-message-queued nil)
     (setq wl-draft-config-exec-flag t)
     (setq wl-draft-parent-folder (or parent-folder ""))
+    (setq wl-draft-parent-number parent-number)
     (or (eq this-command 'wl-folder-write-current-folder)
-	(setq wl-draft-buffer-cur-summary-buffer summary-buf))
+	(setq wl-draft-buffer-cur-summary-buffer
+	      (wl-summary-get-buffer parent-folder)))
     buffer))
 
 (defun wl-draft-create-contents (header-alist)
@@ -1866,7 +1849,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	field
       nil)))
 
-(defsubst wl-draft-default-headers ()
+(defun wl-draft-default-headers ()
   (list
    (cons 'Mail-Reply-To (and wl-insert-mail-reply-to
 			     (wl-address-header-extract-address
@@ -1895,7 +1878,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	(goto-char delimline)
       (goto-char (point-min))
       (if (search-forward "\n\n" nil t)
-	  (delete-backward-char 1)
+	  (delete-char -1)
 	(goto-char (point-max))))
     (wl-draft-check-new-line)
     (put-text-property (point)
@@ -1945,18 +1928,16 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 (defun wl-draft-generate-clone-buffer (name &optional local-variables)
   "Generate clone of current buffer named NAME."
   (let ((editing-buffer (current-buffer)))
-    (save-excursion
-      (set-buffer (generate-new-buffer name))
+    (with-current-buffer (generate-new-buffer name)
       (erase-buffer)
       (wl-draft-mode)
       (wl-draft-editor-mode)
-      (insert-buffer editing-buffer)
+      (insert-buffer-substring editing-buffer)
       (message "")
       (while local-variables
 	(make-local-variable (car local-variables))
 	(set (car local-variables)
-	     (save-excursion
-	       (set-buffer editing-buffer)
+	     (with-current-buffer editing-buffer
 	       (symbol-value (car local-variables))))
 	(setq local-variables (cdr local-variables)))
       (current-buffer))))
@@ -1978,8 +1959,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	(switch-to-buffer-other-frame buffer)
       (switch-to-buffer buffer))
     (set-buffer buffer)
-    (elmo-message-fetch draft-folder number (elmo-make-fetch-strategy 'entire)
-			nil (current-buffer))
+    (elmo-message-fetch draft-folder number (elmo-make-fetch-strategy 'entire))
     (elmo-delete-cr-buffer)
     (let ((mime-edit-again-ignored-field-regexp
 	   "^\\(Content-.*\\|Mime-Version\\):"))
@@ -2008,8 +1988,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 				"\\1"))
 		  auto-save-file-name-transforms)))
     (setq buffer-file-name (buffer-name)
-	  wl-draft-parent-folder ""
 	  wl-draft-buffer-message-number number)
+    (unless wl-draft-parent-folder
+      (setq wl-draft-parent-folder ""))
     (when wl-draft-write-file-function
       (add-hook 'local-write-file-hooks wl-draft-write-file-function))
     (wl-highlight-headers 'for-draft)
@@ -2018,22 +1999,20 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (goto-char (point-max))
     buffer))
 
-(defmacro wl-draft-body-goto-top ()
-  (` (progn
-       (goto-char (point-min))
-       (if (re-search-forward mail-header-separator nil t)
-	   (forward-char 1)
-	 (goto-char (point-max))))))
+(defun wl-draft-body-goto-top ()
+  (goto-char (point-min))
+  (if (re-search-forward mail-header-separator nil t)
+      (forward-char 1)
+    (goto-char (point-max))))
 
-(defmacro wl-draft-body-goto-bottom ()
-  (` (goto-char (point-max))))
+(defun wl-draft-body-goto-bottom ()
+  (goto-char (point-max)))
 
-(defmacro wl-draft-config-body-goto-header ()
-  (` (progn
-       (goto-char (point-min))
-       (if (re-search-forward mail-header-separator nil t)
-	   (beginning-of-line)
-	 (goto-char (point-max))))))
+(defun wl-draft-config-body-goto-header ()
+  (goto-char (point-min))
+  (if (re-search-forward mail-header-separator nil t)
+      (beginning-of-line)
+    (goto-char (point-max))))
 
 (defsubst wl-draft-config-sub-eval-insert (content &optional newline)
   (let (content-value)
@@ -2175,8 +2154,7 @@ Automatically applied in draft sending time."
 	     ((eq key 'reply)
 	      (when (and
 		     reply-buf
-		     (save-excursion
-		       (set-buffer reply-buf)
+		     (with-current-buffer reply-buf
 		       (save-restriction
 			 (std11-narrow-to-header)
 			 (goto-char (point-min))
@@ -2197,14 +2175,14 @@ Automatically applied in draft sending time."
 	      (setq found t)))
 	    (if (and found wl-draft-config-matchone)
 		(throw 'done t))
-	    (setq alist (cdr alist))))
-	(if found
-	    (setq wl-draft-config-exec-flag nil))
-	(run-hooks 'wl-draft-config-exec-hook)
-	(put-text-property (point-min)(point-max) 'face nil)
-	(wl-highlight-message (point-min)(point-max) t)
-	(setq wl-draft-config-variables
-	      (elmo-uniq-list local-variables))))))
+	    (setq alist (cdr alist)))))
+      (if found
+	  (setq wl-draft-config-exec-flag nil))
+      (run-hooks 'wl-draft-config-exec-hook)
+      (put-text-property (point-min)(point-max) 'face nil)
+      (wl-highlight-message (point-min)(point-max) t)
+      (setq wl-draft-config-variables
+	    (elmo-uniq-list local-variables)))))
 
 (defun wl-draft-replace-field (field content &optional add)
   (save-excursion
@@ -2236,12 +2214,14 @@ Automatically applied in draft sending time."
 	    (goto-char (point-max))
 	    (insert (concat field ": " content "\n"))))))))
 
+(defsubst wl-draft-config-info-filename (number msgdb-dir)
+  (expand-file-name
+   (format "%s-%d" wl-draft-config-save-filename number)
+   msgdb-dir))
+
 (defun wl-draft-config-info-operation (msg operation)
   (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-draft-get-folder)))
-	 (filename
-	  (expand-file-name
-	   (format "%s-%d" wl-draft-config-save-filename msg)
-	   msgdb-dir))
+	 (filename (wl-draft-config-info-filename msg msgdb-dir))
 	 element alist variable)
     (cond
      ((eq operation 'save)
@@ -2357,8 +2337,7 @@ Automatically applied in draft sending time."
 		(wl-draft-queue-info-operation (car msgs) 'load)
 		(elmo-message-fetch queue-folder
 				    (car msgs)
-				    (elmo-make-fetch-strategy 'entire)
-				    nil (current-buffer))
+				    (elmo-make-fetch-strategy 'entire))
 		(condition-case err
 		    (setq failure (funcall
 				   wl-draft-queue-flush-send-function
@@ -2416,7 +2395,7 @@ Automatically applied in draft sending time."
 	(message "No draft message exist.")
       (if (string-match (concat "^" wl-draft-folder "/") mybuf)
 	  (setq msg (cadr (memq
-			   (string-to-int (substring mybuf (match-end 0)))
+			   (string-to-number (substring mybuf (match-end 0)))
 			   msgs))))
       (or msg (setq msg (car msgs)))
       (if (setq buf (get-buffer (format "%s/%d" wl-draft-folder msg)))
@@ -2460,8 +2439,8 @@ Automatically applied in draft sending time."
 		  ((looking-at wl-folder-complete-header-regexp)
 		   (and (boundp 'wl-read-folder-history)
 			(setq history wl-read-folder-history)))
-		  ;; ((looking-at wl-address-complete-header-regexp)
-		  ;;  (setq history .....))
+;;;		  ((looking-at wl-address-complete-header-regexp)
+;;;		   (setq history .....))
 		  (t
 		   nil)))
 	       (eolp))
@@ -2548,7 +2527,8 @@ Automatically applied in draft sending time."
   (goto-char (point-min))
   (search-forward mail-header-separator)
   (forward-line 1)
-  (insert body-text))
+  (insert body-text)
+  (or (bolp) (insert "\n")))
 
 ;;;###autoload
 (defun wl-user-agent-compose (&optional to subject other-headers continue
@@ -2567,26 +2547,23 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
   ;; to be necessary to protect the values used w/in
   (let ((wl-user-agent-headers-and-body-alist other-headers)
 	(wl-draft-use-frame (eq switch-function 'switch-to-buffer-other-frame))
-	(wl-draft-buffer-style switch-function))
+	(wl-draft-buffer-style switch-function)
+	tem)
     (if to
-	(if (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
-				   'ignore-case)
-	    (setcdr
-	     (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
-				    'ignore-case)
-	     to)
+	(if (setq tem (wl-string-match-assoc
+		       "\\`to\\'"
+		       wl-user-agent-headers-and-body-alist
+		       'ignore-case))
+	    (setcdr tem to)
 	  (setq wl-user-agent-headers-and-body-alist
 		(cons (cons "to" to)
 		      wl-user-agent-headers-and-body-alist))))
     (if subject
-	(if (wl-string-match-assoc "subject"
-				   wl-user-agent-headers-and-body-alist
-				   'ignore-case)
-	    (setcdr
-	     (wl-string-match-assoc "subject"
-				    wl-user-agent-headers-and-body-alist
-				    'ignore-case)
-	     subject)
+	(if (setq tem (wl-string-match-assoc
+		       "\\`subject\\'"
+		       wl-user-agent-headers-and-body-alist
+		       'ignore-case))
+	    (setcdr tem subject)
 	  (setq wl-user-agent-headers-and-body-alist
 		(cons (cons "subject" subject)
 		      wl-user-agent-headers-and-body-alist))))
@@ -2618,14 +2595,34 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
 	;; highlight headers (from wl-draft in wl-draft.el)
 	(wl-highlight-headers 'for-draft)
 	;; insert body
-	(if (wl-string-match-assoc "body" wl-user-agent-headers-and-body-alist
-				   'ignore-case)
-	    (wl-user-agent-insert-body
-	     (cdr (wl-string-match-assoc
-		   "body"
-		   wl-user-agent-headers-and-body-alist 'ignore-case)))))
+	(let ((body (wl-string-match-assoc "\\`body\\'"
+					   wl-user-agent-headers-and-body-alist
+					   'ignore-case)))
+	  (if body
+	      (wl-user-agent-insert-body (cdr body)))))
     t))
 
+(defun wl-draft-setup-parent-flag (flag)
+  "Setup a FLAG for parent message."
+  (when (and (> (length wl-draft-parent-folder) 0)
+	     wl-draft-parent-number)
+    (setq wl-draft-parent-flag flag)
+    (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)))
+
+(defun wl-draft-buffer-change-number (old-number new-number)
+  (when (eq wl-draft-buffer-message-number old-number)
+    (setq wl-draft-buffer-message-number new-number)
+    (rename-buffer (format "%s/%d" wl-draft-folder new-number) t)
+    (setq buffer-file-name (buffer-name))
+    (set-buffer-modified-p nil)))
+
+(defun wl-draft-rename-saved-config (old-number new-number)
+  (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-draft-get-folder)))
+	 (old-name (wl-draft-config-info-filename old-number msgdb-dir))
+	 (new-name (wl-draft-config-info-filename new-number msgdb-dir)))
+    (when (file-exists-p old-name)
+      (rename-file old-name new-name 'ok-if-already-exists))))
+
 (require 'product)
 (product-provide (provide 'wl-draft) (require 'wl-version))