X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=14c44141b6d1d8e70f09d6f15c90371c757053ff;hb=8d25169967ab8fef4e06c6674be1021311db0820;hp=66bf444845a41d48eac01602ed62382bb1e78919;hpb=876fd62b38eeb1669e626db7e2679c122e229f75;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index 66bf444..14c4414 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.")
@@ -142,20 +147,11 @@ e.g.
 	     (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 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)
@@ -269,12 +265,15 @@ e.g.
 		  wl-subject-re-prefix-regexp)))
 	(t original-subject)))
 
-(defun wl-draft-forward (original-subject summary-buf)
+(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)))
-    (setq subject (wl-draft-forward-make-subject original-subject))
+    (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"))))
@@ -290,88 +289,92 @@ e.g.
     (wl-draft (list (cons 'To "")
 		    (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"))
+  (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."
 ;;;(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.
       (set-buffer-multibyte default-enable-multibyte-characters)
       (setq decoder (mime-find-field-decoder 'Subject 'plain))
-      (setq subject (wl-draft-reply-make-subject
-		     (if (and subject decoder)
-			 (funcall decoder subject) subject)))
+      (setq subject (if (and subject decoder)
+			(funcall decoder subject) subject))
       (setq to-alist
 	    (mapcar
 	     (lambda (addr)
@@ -386,6 +389,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)))
+    (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"))
@@ -454,13 +458,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)
@@ -664,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))))
 
@@ -706,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)
@@ -770,23 +776,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 "")))
@@ -1174,7 +1164,7 @@ 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))
@@ -1281,47 +1271,32 @@ 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)
+		(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.
@@ -1339,6 +1314,9 @@ 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
@@ -1359,6 +1337,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
@@ -1443,7 +1433,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
@@ -1452,7 +1446,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)
@@ -1579,14 +1573,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)))
@@ -1627,7 +1615,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)
@@ -1639,9 +1628,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)))
@@ -1683,18 +1672,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
@@ -1730,7 +1716,8 @@ 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)
@@ -1739,8 +1726,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)
@@ -1978,8 +1967,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 +1996,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)
@@ -2236,12 +2225,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 +2348,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
@@ -2626,6 +2616,27 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
 		   wl-user-agent-headers-and-body-alist 'ignore-case)))))
     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))