X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=bcb09bdfa5e6f80b2bf36af44c8fbb39dd63a25c;hb=000345eadd81debeb1527fb65e46109c96fc35e0;hp=d6d28d7c4da6f9a4d3252f058e6127cb5876e830;hpb=9e39553b80115a949a7f04ddced4459a7797f8bd;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index d6d28d7..bcb09bd 100644
--- a/wl/wl-draft.el
+++ b/wl/wl-draft.el
@@ -53,7 +53,6 @@
   (autoload 'wl-addrmgr "wl-addrmgr"))
 
 (defvar wl-draft-buf-name "Draft")
-(defvar wl-draft-cite-function 'wl-default-draft-cite)
 (defvar wl-draft-buffer-file-name nil)
 (defvar wl-draft-field-completion-list nil)
 (defvar wl-draft-verbose-send t)
@@ -69,11 +68,24 @@
 (defvar wl-draft-queue-flush-send-function 'wl-draft-dispatch-message)
 (defvar wl-sent-message-via nil)
 (defvar wl-sent-message-modified nil)
+(defvar wl-sent-message-queued nil)
 (defvar wl-draft-fcc-list nil)
 (defvar wl-draft-reedit nil)
 (defvar wl-draft-reply-buffer nil)
 (defvar wl-draft-forward nil)
-(defvar wl-draft-parent-folder nil)
+(defvar wl-draft-doing-mime-bcc nil)
+
+(defvar wl-draft-parent-folder nil
+  "Folder name of the summary in which current draft is invoked.
+This variable is local in each draft buffer.
+You can refer its value in `wl-draft-config-alist'.
+
+e.g.
+\(setq wl-draft-config-alist
+      '(((string-match \".*@domain1$\" wl-draft-parent-folder)
+         (\"From\" . \"user@domain1\"))
+        ((string-match \".*@domain2$\" wl-draft-parent-folder)
+         (\"From\" . \"user@domain2\"))))")
 
 (defvar wl-draft-config-sub-func-alist
   '((body		. wl-draft-config-sub-body)
@@ -96,10 +108,15 @@
 (make-variable-buffer-local 'wl-draft-config-variables)
 (make-variable-buffer-local 'wl-draft-config-exec-flag)
 (make-variable-buffer-local 'wl-sent-message-via)
+(make-variable-buffer-local 'wl-sent-message-queued)
 (make-variable-buffer-local 'wl-draft-fcc-list)
 (make-variable-buffer-local 'wl-draft-reply-buffer)
 (make-variable-buffer-local 'wl-draft-parent-folder)
 
+(defsubst wl-smtp-password-key (user mechanism server)
+  (format "SMTP:%s/%s@%s"
+	  user mechanism server))
+
 (defmacro wl-smtp-extension-bind (&rest body)
   (` (let* ((smtp-sasl-mechanisms
 	     (if wl-smtp-authenticate-type
@@ -123,9 +140,10 @@
 	     (function
 	      (lambda (prompt)
 		(elmo-get-passwd
-		 (format "%s@%s"
-			 smtp-sasl-user-name
-			 smtp-server)))))
+		 (wl-smtp-password-key
+		  smtp-sasl-user-name
+		  (car smtp-sasl-mechanisms)
+		  smtp-server)))))
        (,@ body))))
 
 (defun wl-draft-insert-date-field ()
@@ -184,7 +202,7 @@
   (interactive)
   (if (not (file-exists-p wl-x-face-file))
       (error "File %s does not exist" wl-x-face-file)
-    (beginning-of-buffer)
+    (goto-char (point-min))
     (search-forward mail-header-separator nil t)
     (beginning-of-line)
     (wl-draft-insert-x-face-field-here)
@@ -193,7 +211,7 @@
 (defun wl-draft-insert-x-face-field-here ()
   "Insert X-Face field at point."
   (let ((x-face-string (elmo-get-file-string wl-x-face-file)))
-    (when (string-match "^[ \t]*" x-face-string)
+    (when (string-match "^\\(X-Face:\\)?[ \t\n]*" x-face-string)
       (setq x-face-string (substring x-face-string (match-end 0))))
     (insert "X-Face: " x-face-string))
   (when (not (= (preceding-char) ?\n))	; for chomped (choped) x-face-string
@@ -206,13 +224,21 @@
 
 (defun wl-draft-setup ()
   (let ((field wl-draft-fields)
-	ret-val)
+	cl)
     (while field
-      (setq ret-val (append ret-val
-			    (list (cons (concat (car field) " ")
-					(concat (car field) " ")))))
+      (setq cl (append cl
+		       (list (cons (concat (car field) " ")
+				   (concat (car field) " ")))))
       (setq field (cdr field)))
-    (setq wl-draft-field-completion-list ret-val)))
+    (setq cl
+	  (cons (cons (concat wl-draft-mime-bcc-field-name  ": ")
+		      (concat wl-draft-mime-bcc-field-name  ": "))
+		cl))
+    (setq wl-draft-field-completion-list cl)
+    (setq wl-address-complete-header-regexp
+	  (wl-regexp-opt
+	   (append wl-address-complete-header-list
+		   (list (concat wl-draft-mime-bcc-field-name  ":")))))))
 
 (defun wl-draft-make-mail-followup-to (recipients)
   (if (elmo-list-member
@@ -222,7 +248,12 @@
       (let ((rlist (elmo-list-delete
 		    (or wl-user-mail-address-list
 			(list (wl-address-header-extract-address wl-from)))
-		    (copy-sequence recipients))))
+		    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
@@ -234,14 +265,26 @@
   (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))
+	   (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))
+	   (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)
+  (let (references parent-folder)
+    (with-current-buffer summary-buf
+      (setq parent-folder (wl-summary-buffer-folder-name)))
     (with-current-buffer (wl-message-get-original-buffer)
       (setq references (nconc
 			(std11-field-bodies '("References" "In-Reply-To"))
@@ -252,8 +295,14 @@
 	    references (wl-delete-duplicates references)
 	    references (when references
 			 (mapconcat 'identity references "\n\t"))))
-    (wl-draft "" (concat "Forward: " original-subject)
-	      nil nil references nil nil nil nil nil nil summary-buf))
+    (and wl-draft-use-frame
+	 (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 'References references))
+	      nil nil nil nil parent-folder))
   (goto-char (point-max))
   (wl-draft-insert-message)
   (mail-position-on-field "To"))
@@ -264,10 +313,14 @@
       (substring subject (match-end 0))
     subject))
 
+(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-reply-list-symbol (with-arg)
   "Return symbol `wl-draft-reply-*-argument-list' match condition.
 Check WITH-ARG and From: field."
-  (if (wl-address-user-mail-address-p (or (elmo-field-body "From") ""))
+  (if (wl-draft-self-reply-p)
       (if with-arg
 	  'wl-draft-reply-myself-with-argument-list
 	'wl-draft-reply-myself-without-argument-list)
@@ -281,10 +334,11 @@ Reply to author if WITH-ARG is non-nil."
 ;;;(save-excursion
   (let (r-list
 	to mail-followup-to cc subject in-reply-to references newsgroups
-	from to-alist cc-alist decoder parent-folder)
-    (set-buffer summary-buf)
-    (setq parent-folder (wl-summary-buffer-folder-name))
-    (set-buffer buf)
+	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 (symbol-value (wl-draft-reply-list-symbol with-arg)))
     (catch 'done
       (while r-list
@@ -306,19 +360,26 @@ Reply to author if WITH-ARG is non-nil."
 	    (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))))
-	    (setq to (wl-concat-list (cons to
-					   (elmo-multiple-fields-body-list
-					    r-to-list))
-				     ","))
-	    (setq cc (wl-concat-list (cons cc
-					   (elmo-multiple-fields-body-list
-					    r-cc-list))
-				     ","))
-	    (setq newsgroups (wl-concat-list (cons newsgroups
-						   (std11-field-bodies
-						    r-ng-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-to-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 `%s'"
@@ -407,9 +468,17 @@ Reply to author if WITH-ARG is non-nil."
 	  references (wl-delete-duplicates references)
 	  references (if references
 			 (mapconcat 'identity references "\n\t")))
-    (wl-draft
-     to subject in-reply-to cc references newsgroups mail-followup-to
-     nil nil nil nil summary-buf nil parent-folder)
+    (and wl-draft-use-frame
+	 (get-buffer-window summary-buf)
+	 (select-window (get-buffer-window summary-buf)))
+    (wl-draft (list (cons 'To to)
+		    (cons 'Cc cc)
+		    (cons 'Newsgroups newsgroups)
+		    (cons 'Subject subject)
+		    (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-reply-buffer buf))
   (run-hooks 'wl-reply-hook))
 
@@ -472,15 +541,6 @@ Reply to author if WITH-ARG is non-nil."
     (when wl-highlight-body-too
       (wl-highlight-body-region beg (point-max)))))
 
-(defun wl-draft-confirm ()
-  "Confirm send message."
-  (interactive)
-  (y-or-n-p (format "Send current draft as %s? "
-		    (cond ((and (wl-message-mail-p) (wl-message-news-p))
-			   "Mail and News")
-			  ((wl-message-mail-p) "Mail")
-			  ((wl-message-news-p) "News")))))
-
 (defun wl-message-news-p ()
   "If exist valid Newsgroups field, return non-nil."
   (std11-field-body "Newsgroups"))
@@ -497,26 +557,17 @@ Reply to author if WITH-ARG is non-nil."
       (wl-message-field-exists-p "Resent-to")
       (wl-message-field-exists-p "Cc")
       (wl-message-field-exists-p "Bcc")
+      (wl-message-field-exists-p wl-draft-mime-bcc-field-name)
 ;;; This may be needed..
 ;;;   (wl-message-field-exists-p "Fcc")
       ))
 
-(defun wl-draft-open-file (&optional file)
-  "Open FILE for edit."
-  (interactive)
-;;;(interactive "*fFile to edit: ")
-  (wl-draft-edit-string (elmo-get-file-string
-			 (or file
-			     (read-file-name "File to edit: "
-					     (or wl-temporary-file-directory
-						 "~/"))))))
-
 (defun wl-draft-edit-string (string)
   (let ((cur-buf (current-buffer))
 	(tmp-buf (get-buffer-create " *wl-draft-edit-string*"))
 	to subject in-reply-to cc references newsgroups mail-followup-to
 	content-type content-transfer-encoding from
-	body-beg buffer-read-only)
+	body-beg)
     (set-buffer tmp-buf)
     (erase-buffer)
     (insert string)
@@ -555,18 +606,25 @@ Reply to author if WITH-ARG is non-nil."
 	(search-forward (concat mail-header-separator "\n") nil t))
     (unwind-protect
 	(set-buffer
-	 (wl-draft to subject in-reply-to cc references newsgroups
-		   mail-followup-to
+	 (wl-draft (list
+		    (cons 'From
+			  (if (member
+			       (nth 1 (std11-extract-address-components from))
+			       wl-user-mail-address-list)
+			      from))
+		    (cons 'To to)
+		    (cons 'Cc cc)
+		    (cons 'Subject subject)
+		    (cons 'Newsgroups newsgroups)
+		    (cons 'Mail-Followup-To mail-followup-to)
+		    (cons 'In-Reply-To in-reply-to)
+		    (cons 'References references))
 		   content-type content-transfer-encoding
 		   (buffer-substring (point) (point-max))
-		   'edit-again nil
-		   (if (member (nth 1 (std11-extract-address-components from))
-			       wl-user-mail-address-list)
-		       from)))
+		   'edit-again))
       (and to (mail-position-on-field "To"))
       (delete-other-windows)
       (kill-buffer tmp-buf)))
-  (setq buffer-read-only nil) ;;??
   (run-hooks 'wl-draft-reedit-hook))
 
 (defun wl-draft-insert-current-message (dummy)
@@ -628,17 +686,20 @@ Reply to author if WITH-ARG is non-nil."
 	     (buffer-live-p message-buf))
 	(progn
 	  (with-current-buffer summary-buf
-	    (setq num (save-excursion
-			(set-buffer message-buf)
-			wl-message-buffer-cur-number))
-	    (setq entity (elmo-msgdb-overview-get-entity
-			  num (wl-summary-buffer-msgdb)))
-	    (setq date (elmo-msgdb-overview-entity-get-date entity))
-	    (setq from (elmo-msgdb-overview-entity-get-from entity)))
+	    (let ((elmo-mime-charset wl-summary-buffer-mime-charset))
+	      (setq num (save-excursion
+			  (set-buffer message-buf)
+			  wl-message-buffer-cur-number))
+	      (setq entity (elmo-msgdb-overview-get-entity
+			    num (wl-summary-buffer-msgdb)))
+	      (setq date (elmo-msgdb-overview-entity-get-date entity))
+	      (setq from (elmo-msgdb-overview-entity-get-from entity))))
 	  (setq cite-title (format "At %s,\n%s wrote:"
 				   (or date "some time ago")
-				   (wl-summary-from-func-internal
-				    (or from "you"))))))
+				   (if wl-default-draft-cite-decorate-author
+				       (funcall wl-summary-from-function
+						(or from "you"))
+				     (or from "you"))))))
     (and cite-title
 	 (insert cite-title "\n"))
     (mail-indent-citation)))
@@ -665,7 +726,6 @@ Reply to author if WITH-ARG is non-nil."
 
 (defun wl-draft-hide (editing-buffer)
   "Hide the editing draft buffer if possible."
-  (interactive)
   (when (and editing-buffer
 	     (buffer-live-p editing-buffer))
     (set-buffer editing-buffer)
@@ -677,23 +737,23 @@ Reply to author if WITH-ARG is non-nil."
 	  (delete-frame)
 	;; hide draft window
 	(or (one-window-p)
-	    (delete-window)))
-      ;; stay folder window if required
-      (when wl-stay-folder-window
-	(if (setq fld-buf (get-buffer wl-folder-buffer-name))
-	    (if (setq fld-win (get-buffer-window fld-buf))
-		(select-window fld-win)
-	      (if wl-draft-resume-folder-window ;; resume folder window
-		  (switch-to-buffer fld-buf)))))
-      (if (buffer-live-p sum-buf)
-	  (if (setq sum-win (get-buffer-window sum-buf t))
-	      ;; if Summary is on the frame, select it.
-	      (select-window sum-win)
-	    ;; if summary is not on the frame, switch to it.
-	    (if (and wl-stay-folder-window
-		     (or wl-draft-resume-folder-window fld-win))
-		(wl-folder-select-buffer sum-buf)
-	      (switch-to-buffer sum-buf)))))))
+	    (delete-window))
+	;; stay folder window if required
+	(when wl-stay-folder-window
+	  (if (setq fld-buf (get-buffer wl-folder-buffer-name))
+	      (if (setq fld-win (get-buffer-window fld-buf))
+		  (select-window fld-win)
+		(if wl-draft-resume-folder-window ;; resume folder window
+		    (switch-to-buffer fld-buf)))))
+	(if (buffer-live-p sum-buf)
+	    (if (setq sum-win (get-buffer-window sum-buf t))
+		;; if Summary is on the frame, select it.
+		(select-window sum-win)
+	      ;; if summary is not on the frame, switch to it.
+	      (if (and wl-stay-folder-window
+		       (or wl-draft-resume-folder-window fld-win))
+		  (wl-folder-select-buffer sum-buf)
+		(switch-to-buffer sum-buf))))))))
 
 (defun wl-draft-delete (editing-buffer)
   "kill the editing draft buffer and delete the file corresponds to it."
@@ -732,6 +792,42 @@ Reply to author if WITH-ARG is non-nil."
       (mail-position-on-field "to"))
   (insert "\nFcc: "))
 
+;; Imported from message.el.
+(defun wl-draft-elide-region (b e)
+  "Elide the text in the region.
+An ellipsis (from `wl-draft-elide-ellipsis') will be inserted where the
+text was killed."
+  (interactive "r")
+  (kill-region b e)
+  (insert wl-draft-elide-ellipsis))
+
+;; Imported from message.el.
+(defun wl-draft-beginning-of-line (&optional n)
+  "Move point to beginning of header value or to beginning of line."
+  (interactive "p")
+  (let ((zrs 'zmacs-region-stays))
+    (when (and (interactive-p) (boundp zrs))
+      (set zrs t)))
+  (if (wl-draft-point-in-header-p)
+      (let* ((here (point))
+	     (bol (progn (beginning-of-line n) (point)))
+	     (eol (line-end-position))
+	     (eoh (and (looking-at "[^ \t]")
+		       (re-search-forward ": *" eol t))))
+	(if (and eoh (or (> here eoh) (= here bol)))
+	    (goto-char eoh)
+	  (goto-char bol)))
+    (beginning-of-line n)))
+
+(defun wl-draft-point-in-header-p ()
+  "Return t if point is in the header."
+  (save-excursion
+    (let ((p (point)))
+      (goto-char (point-min))
+      (not (re-search-forward
+	    (concat "^" (regexp-quote mail-header-separator) "\n")
+	    p t)))))
+
 ;; function for wl-sent-message-via
 
 (defmacro wl-draft-sent-message-p (type)
@@ -778,7 +874,7 @@ Reply to author if WITH-ARG is non-nil."
 				   ","))))
 		   ""))
 	     (id (if id (concat " id=" id) ""))
-	     (time (wl-sendlog-time)))
+	     (time (format-time-string "%Y/%m/%d %T")))
 	(insert (format "%s proto=%s stat=%s%s%s%s\n"
 			time proto status server to id))
 	(if (and wl-draft-sendlog-max-size filesize
@@ -787,7 +883,7 @@ Reply to author if WITH-ARG is non-nil."
 	(if (file-writable-p filename)
 	    (write-region-as-binary (point-min) (point-max)
 				    filename t 'no-msg)
-	  (message (format "%s is not writable." filename)))))))
+	  (message "%s is not writable." filename))))))
 
 (defun wl-draft-get-header-delimiter (&optional delete)
   ;; If DELETE is non-nil, replace the header delimiter with a blank line
@@ -809,6 +905,7 @@ to find out how to use this."
 	   (not (elmo-plugged-p)))
       (wl-draft-set-sent-message 'mail 'unplugged)
     ;; send the message
+    (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
     (let ((id (std11-field-body "Message-ID"))
 	  (to (std11-field-body "To")))
       (case
@@ -836,8 +933,21 @@ to find out how to use this."
 				msg-id-list))))
     (nreverse msg-id-list)))
 
+(defun wl-draft-eword-encode-address-list (string &optional column)
+  "Encode header field STRING as list of address, and return the result.
+Cause an error when STRING contains invalid address.
+Optional argument COLUMN is start-position of the field."
+  (car (eword-encode-rword-list
+	(or column eword-encode-default-start-column)
+	(eword-encode-addresses-to-rword-list
+	 (wl-draft-std11-parse-addresses (std11-lexical-analyze string))))))
+
 (defun wl-draft-std11-parse-addresses (lal)
   (let ((ret (std11-parse-address lal)))
+    (when (and (not (and (eq (length lal) 1)
+			 (eq (car (car lal)) 'spaces)))
+	       (null ret))
+      (error "Error while parsing address"))
     (if ret
 	(let ((dest (list (car ret))))
 	  (setq lal (cdr ret))
@@ -899,7 +1009,10 @@ from current buffer."
   "Get address list suitable for smtp RCPT TO:<address>.
 Group list content is removed if `wl-draft-remove-group-list-contents' is
 non-nil."
-  (let ((fields '("to" "cc" "bcc"))
+  (let ((fields (if (and wl-draft-doing-mime-bcc
+			 wl-draft-disable-bcc-for-mime-bcc)
+		    '("to" "cc")
+		  '("to" "cc" "bcc")))
 	(resent-fields '("resent-to" "resent-cc" "resent-bcc"))
 	(case-fold-search t)
 	addrs recipients)
@@ -939,18 +1052,7 @@ non-nil."
 			       "$\\|^$") nil t)
 		      (point-marker)))
 	 (smtp-server
-	  (or wl-smtp-posting-server
-	      ;; Compatibility stuff for FLIM 1.12.5 or earlier.
-	      ;; They don't accept a function as the value of `smtp-server'.
-	      (if (functionp smtp-server)
-		  (funcall
-		   smtp-server
-		   sender
-		   ;; no harm..
-		   (let (wl-draft-remove-group-list-contents)
-		     (wl-draft-deduce-address-list
-		      (current-buffer) (point-min) delimline)))
-		(or smtp-server "localhost"))))
+	  (or wl-smtp-posting-server smtp-server "localhost"))
 	 (smtp-service (or wl-smtp-posting-port smtp-service))
 	 (smtp-local-domain (or smtp-local-domain wl-local-domain))
 	 (id (std11-field-body "message-id"))
@@ -969,7 +1071,7 @@ non-nil."
 	    (goto-char (1+ delimline))
 	    (if (eval mail-mailer-swallows-blank-line)
 		(newline))
-;;;	    (run-hooks 'wl-mail-send-pre-hook)
+	    (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
 	    (if mail-interactive
 		(save-excursion
 		  (set-buffer errbuf)
@@ -985,6 +1087,13 @@ non-nil."
 		    (error
 		     (wl-draft-write-sendlog 'failed 'smtp smtp-server
 					     recipients id)
+		     (if (and (eq (car err) 'smtp-response-error)
+			      (= (nth 1 err) 535))
+			 (elmo-remove-passwd
+			  (wl-smtp-password-key
+			   smtp-sasl-user-name
+			   (car smtp-sasl-mechanisms)
+			   smtp-server)))
 		     (signal (car err) (cdr err)))))
 		 (wl-draft-set-sent-message 'mail 'sent)
 		 (wl-draft-write-sendlog
@@ -995,34 +1104,39 @@ non-nil."
 (defun wl-draft-send-mail-with-pop-before-smtp ()
   "Send the prepared message buffer with POP-before-SMTP."
   (require 'elmo-pop3)
-  (condition-case ()
-      (let ((session (elmo-pop3-get-session
-		      (luna-make-entity
-		       'elmo-pop3-folder
-		       :user (or wl-pop-before-smtp-user
-				 elmo-pop3-default-user)
-		       :server (or wl-pop-before-smtp-server
-				   elmo-pop3-default-server)
-		       :port (or wl-pop-before-smtp-port
-				 elmo-pop3-default-port)
-		       :auth (or wl-pop-before-smtp-authenticate-type
-				 elmo-pop3-default-authenticate-type)
-		       :stream-type (or wl-pop-before-smtp-stream-type
-					elmo-pop3-default-stream-type)))))
-	(when session (elmo-network-close-session session)))
-    (error))
+  (let ((session
+	 (luna-make-entity
+	  'elmo-pop3-folder
+	  :user   (or wl-pop-before-smtp-user
+		      elmo-pop3-default-user)
+	  :server (or wl-pop-before-smtp-server
+		      elmo-pop3-default-server)
+	  :port   (or wl-pop-before-smtp-port
+		      elmo-pop3-default-port)
+	  :auth   (or wl-pop-before-smtp-authenticate-type
+		      elmo-pop3-default-authenticate-type)
+	  :stream-type (or wl-pop-before-smtp-stream-type
+			   elmo-pop3-default-stream-type))))
+    (condition-case error
+	(progn
+	  (elmo-pop3-get-session session)
+	  (when session (elmo-network-close-session session)))
+      (error
+       (elmo-network-close-session session)
+       (unless (string= (nth 1 error) "Unplugged")
+	 (signal (car error)(cdr error))))))
   (wl-draft-send-mail-with-smtp))
 
 (defun wl-draft-insert-required-fields (&optional force-msgid)
   "Insert Message-ID, Date, and From field.
-If FORCE-MSGID, ignore 'wl-insert-message-id'."
+If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
   ;; Insert Message-Id field...
   (goto-char (point-min))
   (when (and (or force-msgid
 		 wl-insert-message-id)
 	     (not (re-search-forward "^Message-ID[ \t]*:" nil t)))
     (insert (concat "Message-ID: "
-		    (wl-draft-make-message-id-string)
+		    (funcall wl-message-id-function)
 		    "\n")))
   ;; Insert date field.
   (goto-char (point-min))
@@ -1045,7 +1159,7 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
     ;; ignore any blank lines in the header
     (while (re-search-forward "\n\n\n*" nil t)
       (replace-match "\n")))
-  (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.
@@ -1055,7 +1169,7 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
 
 (defun wl-draft-dispatch-message (&optional mes-string)
   "Send the message in the current buffer.  Not modified the header fields."
-  (let (delimline)
+  (let (delimline mime-bcc)
     (if (and wl-draft-verbose-send mes-string)
 	(message mes-string))
     ;; get fcc folders.
@@ -1068,19 +1182,33 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
 	(progn
 	  (if (and (wl-message-mail-p)
 		   (not (wl-draft-sent-message-p 'mail)))
-	      (funcall wl-draft-send-mail-function))
+	      (if (or (not (or wl-draft-force-queuing
+			       wl-draft-force-queuing-mail))
+		      (memq 'mail wl-sent-message-queued))
+		  (progn
+		    (setq mime-bcc (wl-draft-mime-bcc-field))
+		    (funcall wl-draft-send-mail-function)
+		    (when (not (zerop (length mime-bcc)))
+		      (wl-draft-do-mime-bcc mime-bcc)))
+		(push 'mail wl-sent-message-queued)
+		(wl-draft-set-sent-message 'mail 'unplugged)))
 	  (if (and (wl-message-news-p)
 		   (not (wl-draft-sent-message-p 'news))
 		   (not (wl-message-field-exists-p "Resent-to")))
-	      (funcall wl-draft-send-news-function)))
-      ;;
+	      (if (or (not (or wl-draft-force-queuing
+			       wl-draft-force-queuing-news))
+		      (memq 'news wl-sent-message-queued))
+		  (funcall wl-draft-send-news-function)
+		(push 'news wl-sent-message-queued)
+		(wl-draft-set-sent-message 'news 'unplugged))))
       (let* ((status (wl-draft-sent-message-results))
 	     (unplugged-via (car status))
 	     (sent-via (nth 1 status)))
 	;; If one sent, process fcc folder.
 	(if (and sent-via wl-draft-fcc-list)
 	    (progn
-	      (wl-draft-do-fcc (wl-draft-get-header-delimiter) wl-draft-fcc-list)
+	      (wl-draft-do-fcc (wl-draft-get-header-delimiter)
+			       wl-draft-fcc-list)
 	      (setq wl-draft-fcc-list nil)))
 	(if wl-draft-use-cache
 	    (let ((id (std11-field-body "Message-ID"))
@@ -1091,7 +1219,9 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
 	(when (and unplugged-via
 		   wl-sent-message-modified)
 	  (if wl-draft-enable-queuing
-	      (wl-draft-queue-append wl-sent-message-via)
+	      (progn
+		(wl-draft-queue-append wl-sent-message-via)
+		(setq wl-sent-message-modified 'requeue))
 	    (error "Unplugged")))
 	(when wl-draft-verbose-send
 	  (if (and unplugged-via sent-via);; combined message
@@ -1112,7 +1242,7 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
     (let (wl-interactive-send
 ;;;	  wl-draft-verbose-send
 	  (wl-mail-send-pre-hook (and force-pre-hook wl-mail-send-pre-hook))
-;;;	  wl-news-send-pre-hook
+	  (wl-news-send-pre-hook (and force-pre-hook wl-news-send-pre-hook))
 	  mail-send-hook
 	  mail-send-actions)
       (wl-draft-send kill-when-done mes-string))))
@@ -1153,7 +1283,15 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		     (not (wl-message-news-p)))
 		(error "No recipient is specified"))
 	    (expand-abbrev) ; for mail-abbrevs
-	    (run-hooks 'mail-send-hook) ; translate buffer
+	    (let ((mime-header-encode-method-alist
+		   (append
+		    '((wl-draft-eword-encode-address-list
+		       .  (To Cc Bcc Resent-To Resent-Cc Bcc Resent-Bcc)))
+		    (if (boundp 'mime-header-encode-method-alist)
+			(symbol-value 'mime-header-encode-method-alist)))))
+	      (run-hooks 'mail-send-hook) ; translate buffer
+	      )
+	    ;;
 	    (if wl-draft-verbose-send
 		(message (or mes-string "Sending...")))
 	    (funcall wl-draft-send-function editing-buffer kill-when-done)
@@ -1164,9 +1302,6 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 			 (cdr (car mail-send-actions)))
 		(error))
 	      (setq mail-send-actions (cdr mail-send-actions)))
-;;	    (if (or (eq major-mode 'wl-draft-mode)
-;;		    (eq major-mode 'mail-mode))
-;;		(local-set-key "\C-c\C-s" 'wl-draft-send)) ; override
 	    (if wl-draft-verbose-send
 		(message (concat (or wl-draft-verbose-msg
 				     mes-string "Sending...")
@@ -1175,15 +1310,79 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	(and (buffer-live-p sending-buffer)
 	     (kill-buffer sending-buffer))))))
 
+(defun wl-draft-mime-bcc-field ()
+  "Return the MIME-Bcc field body. The field is deleted."
+  (prog1 (std11-field-body wl-draft-mime-bcc-field-name)
+    (wl-draft-delete-field wl-draft-mime-bcc-field-name)))
+
+(defun wl-draft-do-mime-bcc (field-body)
+  "Send MIME-Bcc (Encapsulated blind carbon copy)."
+  (let ((orig-from (mime-decode-field-body (std11-field-body "from")
+					   'From))
+	(orig-subj (mime-decode-field-body (or (std11-field-body "subject")
+					       "")
+					   'Subject))
+	(recipients (wl-parse-addresses field-body))
+	(draft-buffer (current-buffer))
+	wl-draft-use-frame)
+    (save-window-excursion
+      (when (and (not wl-draft-doing-mime-bcc) ; To avoid infinite loop.
+		 (not (zerop (length field-body))))
+	(let ((wl-draft-doing-mime-bcc t))
+	  (dolist (recipient recipients)
+	    (wl-draft-create-buffer)
+	    (wl-draft-create-contents
+	     (append `((From . ,orig-from)
+		       (To . ,recipient)
+		       (Subject . ,(concat "A blind carbon copy ("
+					   orig-subj
+					   ")")))
+		     (wl-draft-default-headers)))
+	    (wl-draft-insert-mail-header-separator)
+	    (wl-draft-prepare-edit)
+	    (goto-char (point-max))
+	    (insert (or wl-draft-mime-bcc-body
+			"This is a blind carbon copy.")
+		    "\n")
+	    (mime-edit-insert-tag "message" "rfc822")
+	    (insert-buffer draft-buffer)
+	    (let (wl-interactive-send)
+	      (wl-draft-send 'kill-when-done))))))))
+
+;; Derived from `message-save-drafts' in T-gnus.
 (defun wl-draft-save ()
   "Save current draft."
   (interactive)
-  (save-buffer)
-  (wl-draft-config-info-operation
-   (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
-	(string-to-int
-	 (match-string 0 wl-draft-buffer-file-name)))
-   'save))
+  (if (buffer-modified-p)
+      (progn
+	(message "Saving %s..." wl-draft-buffer-file-name)
+	(let ((msg (buffer-substring-no-properties (point-min) (point-max))))
+	  (with-temp-file wl-draft-buffer-file-name
+	    (insert msg)
+	    ;; If no header separator, insert it.
+	    (save-excursion
+	      (goto-char (point-min))
+	      (unless (re-search-forward
+		       (concat "^" (regexp-quote mail-header-separator) "$")
+		       nil t)
+		(goto-char (point-min))
+		(if (re-search-forward "\n\n" nil t)
+		    (replace-match (concat "\n" mail-header-separator "\n"))
+		  (goto-char (point-max))
+		  (insert (if (eq (char-before) ?\n) "" "\n")
+			  mail-header-separator "\n"))))
+	    (let ((mime-header-encode-method-alist
+		   '((eword-encode-unstructured-field-body))))
+	      (mime-edit-translate-buffer))
+	    (wl-draft-get-header-delimiter t)))
+	(set-buffer-modified-p nil)
+	(wl-draft-config-info-operation
+	 (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
+	      (string-to-int
+	       (match-string 0 wl-draft-buffer-file-name)))
+	 'save)
+	(message "Saving %s...done" wl-draft-buffer-file-name))
+    (message "(No changes need to be saved)")))
 
 (defun wl-draft-mimic-kill-buffer ()
   "Kill the current (draft) buffer with query."
@@ -1194,7 +1393,13 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (if (or (not bufname)
 	    (string-equal bufname "")
 	    (string-equal bufname (buffer-name)))
-	(wl-draft-save-and-exit)
+	(let ((bufname (current-buffer)))
+	  (when (or (not (buffer-modified-p))
+		    (yes-or-no-p
+		     (format "Buffer %s modified; kill anyway? " bufname)))
+	    (set-buffer-modified-p nil)
+	    (wl-draft-hide bufname)
+	    (kill-buffer bufname)))
       (kill-buffer bufname))))
 
 (defun wl-draft-save-and-exit ()
@@ -1215,20 +1420,20 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
   (let ((wl-interactive-send t))
     (wl-draft-send-and-exit)))
 
-(defun wl-draft-delete-field (field &optional delimline)
-  (wl-draft-delete-fields (regexp-quote field) delimline))
+(defun wl-draft-delete-field (field &optional delimline replace)
+  (wl-draft-delete-fields (regexp-quote field) delimline replace))
 
-(defun wl-draft-delete-fields (regexp &optional delimline)
+(defun wl-draft-delete-fields (field &optional delimline replace)
   (save-restriction
     (unless delimline
+      (goto-char (point-min))
       (if (search-forward "\n\n" nil t)
 	  (setq delimline (point))
 	(setq delimline (point-max))))
     (narrow-to-region (point-min) delimline)
     (goto-char (point-min))
-    (let ((regexp (concat "^" regexp ":"))
-	  (case-fold-search t)
-	  last)
+    (let ((regexp (concat "^" field ":"))
+	  (case-fold-search t))
       (while (not (eobp))
 	(if (looking-at regexp)
 	    (progn
@@ -1238,33 +1443,43 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		 (forward-line 1)
 		 (if (re-search-forward "^[^ \t]" nil t)
 		     (goto-char (match-beginning 0))
-		   (point-max)))))
+		   (point-max))))
+	      (if replace
+		  (insert (concat field ": " replace "\n"))))
 	  (forward-line 1)
 	  (if (re-search-forward "^[^ \t]" nil t)
 	      (goto-char (match-beginning 0))
 	    (point-max)))))))
 
 (defun wl-draft-get-fcc-list (header-end)
-  (let (fcc-list
-	(case-fold-search t))
-    (or (markerp header-end) (error "HEADER-END must be a marker"))
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward "^Fcc:[ \t]*" header-end t)
-	(setq fcc-list
-	      (cons (buffer-substring-no-properties
-		     (point)
-		     (progn
-		       (end-of-line)
-		       (skip-chars-backward " \t")
-		       (point)))
-		    fcc-list))
-	(save-match-data
-	  (wl-folder-confirm-existence
-	   (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list)))))
-	(delete-region (match-beginning 0)
-		       (progn (forward-line 1) (point)))))
-    fcc-list))
+  (if (and wl-draft-doing-mime-bcc
+	   wl-draft-disable-fcc-for-mime-bcc)
+      (progn
+	(wl-draft-delete-field "fcc")
+	nil)
+    (let (fcc-list
+	  (case-fold-search t))
+      (or (markerp header-end) (error "HEADER-END must be a marker"))
+      (save-excursion
+	(goto-char (point-min))
+	(while (re-search-forward "^Fcc:[ \t]*" header-end t)
+	  (save-match-data
+	    (setq fcc-list
+		  (append fcc-list
+			  (split-string
+			   (buffer-substring-no-properties
+			    (point)
+			    (progn
+			      (end-of-line)
+			      (skip-chars-backward " \t")
+			      (point)))
+			   ",[ \t]*")))
+	    (dolist (folder fcc-list)
+	      (wl-folder-confirm-existence
+	       (wl-folder-get-elmo-folder (eword-decode-string folder)))))
+	  (delete-region (match-beginning 0)
+			 (progn (forward-line 1) (point)))))
+      fcc-list)))
 
 (defun wl-draft-do-fcc (header-end &optional fcc-list)
   (let ((send-mail-buffer (current-buffer))
@@ -1322,15 +1537,12 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		nil
 	      (if (re-search-forward ":" pos t) nil t)))))))
 
-(defun wl-draft-random-alphabet ()
-  (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)))
-    (nth (abs (% (random) 26)) alphabet)))
-
+;;;;;;;;;;;;;;;;
 ;;;###autoload
-(defun wl-draft (&optional to subject in-reply-to cc references newsgroups
-			   mail-followup-to
+(defun wl-draft (&optional header-alist
 			   content-type content-transfer-encoding
-			   body edit-again summary-buf from parent-folder)
+			   body edit-again
+			   parent-folder)
   "Write and send mail/news message with Wanderlust."
   (interactive)
   (require 'wl)
@@ -1339,11 +1551,65 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (wl-folder-init)
     (elmo-init)
     (wl-plugged-init t))
-  (wl-init) ; returns immediately if already initialized.
-  (if (interactive-p)
-      (setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name))))
-  (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
-	buf-name file-name num wl-demo change-major-mode-hook)
+  (let (wl-demo)
+    (wl-init)) ; returns immediately if already initialized.
+
+
+  (let (buf-name header-alist-internal)
+    (setq buf-name
+	  (wl-draft-create-buffer
+	   (or
+	    (eq this-command 'wl-draft)
+	    (eq this-command 'wl-summary-write)
+	    (eq this-command 'wl-summary-write-current-folder)
+	    (eq this-command 'wl-folder-write-current-folder))
+	   parent-folder))
+
+    (unless (cdr (assq 'From header-alist))
+      (setq header-alist
+	    (append (list (cons 'From wl-from)) header-alist)))
+    (unless (cdr (assq 'To header-alist))
+      (let ((to))
+	(when (setq to (and
+			(interactive-p)
+			""))
+	  (if (assq 'To header-alist)
+	      (setcdr (assq 'To header-alist) to)
+	    (setq header-alist
+		  (append header-alist
+			  (list (cons 'To to))))))))
+    (unless (cdr (assq 'Subject header-alist))
+      (if (assq 'Subject header-alist)
+	  (setcdr (assq 'Subject header-alist) "")
+	(setq header-alist
+	      (append header-alist (list (cons 'Subject ""))))))
+    (setq header-alist (append header-alist
+			       (wl-draft-default-headers)
+			       wl-draft-additional-header-alist
+			       (if body (list "" (cons 'Body body)))))
+    (wl-draft-create-contents header-alist)
+    (if edit-again
+	(wl-draft-decode-body
+	 content-type content-transfer-encoding))
+    (wl-draft-insert-mail-header-separator)
+    (wl-draft-prepare-edit)
+    (if (interactive-p)
+	(run-hooks 'wl-mail-setup-hook))
+    (goto-char (point-min))
+    (wl-user-agent-compose-internal) ;; user-agent
+    (cond ((and
+	    (interactive-p)
+	    (string= (cdr (assq 'To header-alist)) ""))
+	   (mail-position-on-field "To"))
+	  (t
+	   (goto-char (point-max))))
+    buf-name))
+
+(defun wl-draft-create-buffer (&optional full parent-folder)
+  (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+	 (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
+	 (summary-buf (wl-summary-get-buffer parent-folder))
+	buf-name file-name num change-major-mode-hook)
     (if (not (elmo-folder-message-file-p draft-folder))
 	(error "%s folder cannot be used for draft folder" wl-draft-folder))
     (setq num (elmo-max-of-list
@@ -1365,9 +1631,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 			   (buffer-name)))
 	(rename-buffer (concat wl-draft-folder "/" (int-to-string num))))
     (if (or (eq wl-draft-reply-buffer-style 'full)
-	    (eq this-command 'wl-draft)
-	    (eq this-command 'wl-summary-write)
-	    (eq this-command 'wl-summary-write-current-folder))
+	    full)
 	(delete-other-windows))
     (auto-save-mode -1)
     (wl-draft-mode)
@@ -1375,89 +1639,111 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (setq truncate-partial-width-windows nil)
     (setq truncate-lines wl-draft-truncate-lines)
     (setq wl-sent-message-via nil)
-    (setq wl-draft-parent-folder parent-folder)
-    (if (stringp (or from wl-from))
-	(insert "From: " (or from wl-from) "\n"))
-    (and (or (interactive-p)
-	     (eq this-command 'wl-summary-write)
-	     to)
-	 (insert "To: " (or to "") "\n"))
-    (and cc (insert "Cc: " (or cc "") "\n"))
-    (insert "Subject: " (or subject "") "\n")
-    (and newsgroups (insert "Newsgroups: " newsgroups "\n"))
-    (and mail-followup-to (insert "Mail-Followup-To: " mail-followup-to "\n"))
-    (and wl-insert-mail-reply-to
-	 (insert "Mail-Reply-To: "
-		 (wl-address-header-extract-address
-		  wl-from) "\n"))
-    (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n"))
-    (and references (insert "References: " references "\n"))
-    (insert (funcall wl-generate-mailer-string-function) "\n")
+    (setq wl-sent-message-queued nil)
     (setq wl-draft-buffer-file-name file-name)
-    (if mail-default-reply-to
-	(insert "Reply-To: " mail-default-reply-to "\n"))
-    (wl-draft-insert-ccs "Bcc: " (or wl-bcc
-			       (and mail-self-blind (user-login-name))))
-    (wl-draft-insert-ccs "Fcc: " wl-fcc)
-    (if wl-organization
-	(insert "Organization: " wl-organization "\n"))
-    (and wl-auto-insert-x-face
-	 (file-exists-p wl-x-face-file)
-	 (wl-draft-insert-x-face-field-here))
-    (if mail-default-headers
-	(insert mail-default-headers))
-    (if (not (= (preceding-char) ?\n))
-	(insert ?\n))
-    (if edit-again
-	(let (start)
-	  (setq start (point))
-	  (when content-type
-	    (insert "Content-type: " content-type "\n"))
-	  (when content-transfer-encoding
-	    (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
-	  (if (or content-type content-transfer-encoding)
-	      (insert "\n"))
-	  (and body (insert body))
-	  (save-restriction
-	    (narrow-to-region start (point))
-	    (and edit-again
-		 (wl-draft-decode-message-in-buffer))
-	    (widen)
-	    (goto-char start)
-	    (put-text-property (point)
-			       (progn
-				 (insert mail-header-separator "\n")
-				 (1- (point)))
-			       'category 'mail-header-separator)))
-      (put-text-property (point)
-			 (progn
-			   (insert mail-header-separator "\n")
-			   (1- (point)))
-			 'category 'mail-header-separator)
-      (and body (insert body)))
-    (as-binary-output-file
-     (write-region (point-min)(point-max) wl-draft-buffer-file-name
-		   nil t))
+    (setq wl-draft-config-exec-flag t)
+    (setq wl-draft-parent-folder (or parent-folder ""))
+    (or (eq this-command 'wl-folder-write-current-folder)
+	(setq wl-draft-buffer-cur-summary-buffer summary-buf))
+    buf-name))
+
+(defun wl-draft-create-contents (header-alist)
+  "header-alist' sample
+'(function  ;; funcall
+  string    ;; insert string
+  (symbol . string)    ;;  insert symbol-value: string
+  (symbol . function)  ;;  (funcall) and if it returns string,
+                       ;;  insert symbol-value: string
+  (symbol . nil)       ;;  do nothing
+  nil                  ;;  do nothing
+  )
+"
+  (unless (eq major-mode 'wl-draft-mode)
+    (error "wl-draft-create-header must be use in wl-draft-mode."))
+  (let ((halist header-alist)
+	field value)
+    (while halist
+      (cond
+       ;; function
+       ((functionp (car halist)) (funcall (car halist)))
+       ;; string
+       ((stringp (car halist)) (insert (car halist) "\n"))
+       ;; cons
+       ((consp (car halist))
+	(setq field (car (car halist)))
+	(setq value (cdr (car halist)))
+	(cond
+	 ((symbolp field)
+	  (cond
+	   ((eq field 'Body) ; body
+	    (insert value))
+	   ((stringp value) (insert (symbol-name field) ": " value "\n"))
+	   ((functionp value)
+	    (let ((value-return (funcall value)))
+	      (when (stringp value-return)
+		(insert (symbol-name field) ": " value-return "\n"))))
+	   ((not value))
+	   (t
+	    (debug))))
+	 ;;
+	 ((not field))
+	 (t
+	  (debug))
+	 )))
+      (setq halist (cdr halist)))))
+
+(defun wl-draft-prepare-edit ()
+  (unless (eq major-mode 'wl-draft-mode)
+    (error "wl-draft-create-header must be use in wl-draft-mode."))
+  (let (change-major-mode-hook)
     (wl-draft-editor-mode)
+    (add-hook 'local-write-file-hooks 'wl-draft-save)
     (wl-draft-overload-functions)
     (wl-highlight-headers 'for-draft)
-    (goto-char (point-min))
-    (setq wl-draft-config-exec-flag t)
-    (if (interactive-p)
-	(run-hooks 'wl-mail-setup-hook))
-    (wl-user-agent-compose-internal) ;; user-agent
-    (cond ((eq this-command 'wl-summary-write-current-newsgroup)
-	   (mail-position-on-field "Subject"))
-	  ((and (interactive-p) (null to))
-	   (mail-position-on-field "To"))
-	  (t
-	   (goto-char (point-max))))
-    (setq wl-draft-buffer-cur-summary-buffer (or summary-buf
-						 (get-buffer
-						  wl-summary-buffer-name)))
-    buf-name))
+    (wl-draft-save)
+    (clear-visited-file-modtime)))
 
-(defsubst wl-draft-insert-ccs (str cc)
+(defun wl-draft-decode-header ()
+  (save-excursion
+    (std11-narrow-to-header)
+    (wl-draft-decode-message-in-buffer)
+    (widen)))
+
+(defun wl-draft-decode-body (&optional content-type content-transfer-encoding)
+  (let ((content-type
+	 (or content-type
+		(std11-field-body "content-type")))
+	(content-transfer-encoding
+	 (or content-transfer-encoding
+	     (std11-field-body "content-transfer-encoding")))
+	delimline)
+    (save-excursion
+      (std11-narrow-to-header)
+      (wl-draft-delete-field "content-type")
+      (wl-draft-delete-field "content-transfer-encoding")
+      (goto-char (point-max))
+      (setq delimline (point-marker))
+      (widen)
+      (narrow-to-region delimline (point-max))
+      (goto-char (point-min))
+      (when content-type
+	(insert "Content-type: " content-type "\n"))
+      (when content-transfer-encoding
+	(insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
+      (wl-draft-decode-message-in-buffer)
+      (goto-char (point-min))
+      (unless (re-search-forward "^$" (point-at-eol) t)
+	(insert "\n"))
+      (widen)
+      delimline)))
+
+;;; subroutine for wl-draft-create-contents
+;;; must be used in wl-draft-mode
+(defun wl-draft-check-new-line ()
+  (if (not (= (preceding-char) ?\n))
+      (insert ?\n)))
+
+(defsubst wl-draft-trim-ccs (cc)
   (let ((field
 	 (if (functionp cc)
 	     (funcall cc)
@@ -1470,7 +1756,48 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 				  (wl-parse-addresses (std11-field-body "To"))
 				  (wl-parse-addresses (std11-field-body "Cc"))))
 			 (mapcar 'downcase wl-subscribed-mailing-list)))))
-	(insert str field "\n"))))
+	field
+      nil)))
+
+(defsubst wl-draft-default-headers ()
+  (list
+   (cons 'Mail-Reply-To (and wl-insert-mail-reply-to
+			     (wl-address-header-extract-address
+			      wl-from)))
+   (cons 'User-Agent wl-generate-mailer-string-function)
+   (cons 'Reply-To mail-default-reply-to)
+   (cons 'Bcc (function
+	       (lambda ()
+		 (wl-draft-trim-ccs
+		  (or wl-bcc (and mail-self-blind (user-login-name)))))))
+   (cons 'Fcc (function
+	       (lambda ()
+		 (wl-draft-trim-ccs wl-fcc))))
+   (cons 'Organization wl-organization)
+   (and wl-auto-insert-x-face
+	(file-exists-p wl-x-face-file)
+	'wl-draft-insert-x-face-field-here) ;; allow nil
+   mail-default-headers
+   ;; check \n at th end of line for `mail-default-headers'
+   'wl-draft-check-new-line
+   ))
+
+(defun wl-draft-insert-mail-header-separator (&optional delimline)
+  (save-excursion
+    (if delimline
+	(goto-char delimline)
+      (goto-char (point-min))
+      (if (search-forward "\n\n" nil t)
+	  (delete-backward-char 1)
+	(goto-char (point-max))))
+    (wl-draft-check-new-line)
+    (put-text-property (point)
+		       (progn
+			 (insert mail-header-separator "\n")
+			 (1- (point)))
+		       'category 'mail-header-separator)))
+
+;;;;;;;;;;;;;;;;
 
 (defun wl-draft-elmo-nntp-send ()
   (let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook)
@@ -1481,12 +1808,27 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	(elmo-nntp-default-port
 	 (or wl-nntp-posting-port elmo-nntp-default-port))
 	(elmo-nntp-default-stream-type
-	 (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type)))
+	 (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type))
+	(elmo-nntp-default-function wl-nntp-posting-function)
+	condition)
+    (if (setq condition (cdr (elmo-string-matched-assoc
+			      (std11-field-body "Newsgroups")
+			      wl-nntp-posting-config-alist)))
+	(if (stringp condition)
+	    (setq elmo-nntp-default-server condition)
+	  (while (car condition)
+	    (set (intern (format "elmo-nntp-default-%s"
+				 (symbol-name (caar condition))))
+		 (cdar condition))
+	    (setq condition (cdr condition)))))
+    (unless elmo-nntp-default-function
+      (error "wl-draft-nntp-send: posting-function is nil."))
     (if (not (elmo-plugged-p elmo-nntp-default-server elmo-nntp-default-port))
 	(wl-draft-set-sent-message 'news 'unplugged
 				   (cons elmo-nntp-default-server
 					 elmo-nntp-default-port))
-      (elmo-nntp-post elmo-nntp-default-server (current-buffer))
+      (funcall elmo-nntp-default-function
+	       elmo-nntp-default-server (current-buffer))
       (wl-draft-set-sent-message 'news 'sent)
       (wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server
 			      (std11-field-body "Newsgroups")
@@ -1514,35 +1856,63 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 (defun wl-draft-reedit (number)
   (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 	(wl-draft-reedit t)
-	buf-name file-name change-major-mode-hook)
+	buffer file-name change-major-mode-hook)
     (setq file-name (elmo-message-file-name draft-folder number))
     (unless (file-exists-p file-name)
       (error "File %s does not exist" file-name))
-    (setq buf-name (find-file-noselect file-name))
-    (if wl-draft-use-frame
-	(switch-to-buffer-other-frame buf-name)
-      (switch-to-buffer buf-name))
-    (set-buffer buf-name)
-    (if (not (string-match (regexp-quote wl-draft-folder)
-			   (buffer-name)))
-	(rename-buffer (concat wl-draft-folder "/" (buffer-name))))
-    (auto-save-mode -1)
-    (wl-draft-mode)
-    (setq wl-sent-message-via nil)
-    (setq wl-draft-buffer-file-name file-name)
-    (wl-draft-config-info-operation number 'load)
-    (goto-char (point-min))
-    (or (re-search-forward "\n\n" nil t)
-	(search-forward (concat mail-header-separator "\n") nil t))
-    (write-region (point-min)(point-max) wl-draft-buffer-file-name
-		  nil t)
-    (wl-draft-overload-functions)
-    (wl-draft-editor-mode)
-    (wl-highlight-headers 'for-draft)
-    (run-hooks 'wl-draft-reedit-hook)
-    (goto-char (point-max))
-    buf-name
-    ))
+    (if (setq buffer (get-buffer
+		      (concat wl-draft-folder "/"
+			      (number-to-string number))))
+	(progn
+	  (if wl-draft-use-frame
+	      (switch-to-buffer-other-frame buffer)
+	    (switch-to-buffer buffer))
+	  (set-buffer buffer))
+      (setq buffer (get-buffer-create (number-to-string number)))
+      (if wl-draft-use-frame
+	  (switch-to-buffer-other-frame buffer)
+	(switch-to-buffer buffer))
+      (set-buffer buffer)
+      (insert-file-contents-as-binary file-name)
+      (elmo-delete-cr-buffer)
+      (let((mime-edit-again-ignored-field-regexp
+	    "^\\(Content-.*\\|Mime-Version\\):"))
+;	(wl-draft-decode-message-in-buffer))
+	;;;; From gnus-article-mime-edit-article-setup in T-gnus
+	;;;; XXX: it is semi issue, perhaps [wl:10790]
+	(let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
+	  (fset 'mime-edit-decode-single-part-in-buffer
+		(lambda (&rest args)
+		  (unless (let ((content-type (car args)))
+			    (eq 'text (mime-content-type-primary-type
+				       content-type)))
+		    (setcar (cdr args) 'not-decode-text))
+		  (apply ofn args)))
+	  (unwind-protect
+	      (wl-draft-decode-message-in-buffer)
+	    (fset 'mime-edit-decode-single-part-in-buffer ofn))))
+      (wl-draft-insert-mail-header-separator)
+      (if (not (string-match (regexp-quote wl-draft-folder)
+			     (buffer-name)))
+	  (rename-buffer (concat wl-draft-folder "/" (buffer-name))))
+      (auto-save-mode -1)
+      (wl-draft-mode)
+      (setq buffer-file-name file-name)
+      (make-local-variable 'truncate-partial-width-windows)
+      (setq truncate-partial-width-windows nil)
+      (setq truncate-lines wl-draft-truncate-lines)
+      (setq wl-sent-message-via nil)
+      (setq wl-sent-message-queued nil)
+      (setq wl-draft-buffer-file-name file-name)
+      (wl-draft-config-info-operation number 'load)
+      (goto-char (point-min))
+      (wl-draft-overload-functions)
+      (wl-draft-editor-mode)
+      (add-hook 'local-write-file-hooks 'wl-draft-save)
+      (wl-highlight-headers 'for-draft)
+      (run-hooks 'wl-draft-reedit-hook)
+      (goto-char (point-max))
+      buffer)))
 
 (defmacro wl-draft-body-goto-top ()
   (` (progn
@@ -1561,34 +1931,41 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	   (beginning-of-line)
 	 (goto-char (point-max))))))
 
+(defsubst wl-draft-config-sub-eval-insert (content &optional newline)
+  (let (content-value)
+    (when (and content
+	       (stringp (setq content-value (eval content))))
+      (insert content-value)
+      (if newline (insert "\n")))))
+
 (defun wl-draft-config-sub-body (content)
   (wl-draft-body-goto-top)
   (delete-region (point) (point-max))
-  (if content (insert (eval content))))
+  (wl-draft-config-sub-eval-insert content))
 
 (defun wl-draft-config-sub-top (content)
   (wl-draft-body-goto-top)
-  (if content (insert (eval content))))
+  (wl-draft-config-sub-eval-insert content))
 
 (defun wl-draft-config-sub-bottom (content)
   (wl-draft-body-goto-bottom)
-  (if content (insert (eval content))))
+  (wl-draft-config-sub-eval-insert content))
 
 (defun wl-draft-config-sub-header (content)
   (wl-draft-config-body-goto-header)
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defun wl-draft-config-sub-header-top (content)
   (goto-char (point-min))
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defun wl-draft-config-sub-part-top (content)
   (goto-char (mime-edit-content-beginning))
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defun wl-draft-config-sub-part-bottom (content)
   (goto-char (mime-edit-content-end))
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defsubst wl-draft-config-sub-file (content)
   (let ((coding-system-for-read wl-cs-autoconv)
@@ -1673,7 +2050,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	  (wl-draft-config-exec config-alist reply-buf)))))
 
 (defun wl-draft-config-exec (&optional config-alist reply-buf)
-  "Change headers in draft sending time."
+  "Change headers according to the value of `wl-draft-config-alist'.
+Automatically applied in draft sending time."
   (interactive)
   (let ((case-fold-search t)
 	(alist (or config-alist wl-draft-config-alist))
@@ -1795,7 +2173,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 				wl-draft-config-variables
 				(list 'wl-draft-fcc-list)))))
 	(if add-sent-message-via
-	    (push 'wl-sent-message-via variables))
+	    (progn
+	      (push 'wl-sent-message-queued variables)
+	      (push 'wl-sent-message-via variables)))
 	(while (setq variable (pop variables))
 	  (when (boundp variable)
 	    (wl-append alist
@@ -1847,9 +2227,10 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
       (catch 'found
 	(while sent-via
 	  (when (and (eq (nth 1 (car sent-via)) 'unplugged)
-		     (elmo-plugged-p
-		      (car (nth 2 (car sent-via)))
-		      (cdr (nth 2 (car sent-via)))))
+		     (or (not (nth 2 (car sent-via)))
+			 (elmo-plugged-p
+			  (car (nth 2 (car sent-via)))
+			  (cdr (nth 2 (car sent-via))))))
 	    (wl-append msgs (list (car msgs2)))
 	    (throw 'found t))
 	  (setq sent-via (cdr sent-via))))
@@ -1886,11 +2267,16 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		   (setq failure t))
 		  (quit
 		   (setq failure t)))
-		(unless failure
-		  (elmo-folder-delete-messages
-		   queue-folder (cons (car msgs) nil))
-		  (wl-draft-queue-info-operation (car msgs) 'delete)
-		  (setq performed (+ 1 performed)))
+		(if (eq wl-sent-message-modified 'requeue)
+		    (progn
+		      (elmo-folder-delete-messages
+		       queue-folder (cons (car msgs) nil))
+		      (wl-draft-queue-info-operation (car msgs) 'delete))
+		  (unless failure
+		    (elmo-folder-delete-messages
+		     queue-folder (cons (car msgs) nil))
+		    (wl-draft-queue-info-operation (car msgs) 'delete)
+		    (setq performed (+ 1 performed))))
 		(setq msgs (cdr msgs)))
 	      (kill-buffer buffer)
 	      (message "%d message(s) are sent." performed)))
@@ -1903,25 +2289,18 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
   (interactive "P")
   (if arg
       (wl-jump-to-draft-folder)
-    (let ((bufs (buffer-list))
-	  (draft-regexp (concat
-			 "^" (regexp-quote
-			      (elmo-localdir-folder-directory-internal
-			       (wl-folder-get-elmo-folder wl-draft-folder)))))
-	  buf draft-bufs)
-      (while bufs
-	(if (and
-	     (setq buf (buffer-file-name (car bufs)))
-	     (string-match draft-regexp buf))
-	    (setq draft-bufs (cons (buffer-name (car bufs)) draft-bufs)))
-	(setq bufs (cdr bufs)))
+    (let ((draft-bufs (wl-collect-draft))
+	  buf)
       (cond
        ((null draft-bufs)
 	(message "No draft buffer exist."))
        (t
 	(setq draft-bufs
-	      (sort draft-bufs (function (lambda (a b) (not (string< a b))))))
-	(if (setq buf (cdr (member (buffer-name) draft-bufs)))
+	      (sort (mapcar 'buffer-name draft-bufs)
+		    (function (lambda (a b)
+				(not (string< a b))))))
+	(if (setq buf (cdr (member (buffer-name)
+				   draft-bufs)))
 	    (setq buf (car buf))
 	  (setq buf (car draft-bufs)))
 	(switch-to-buffer buf))))))
@@ -1944,11 +2323,13 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 
 (defun wl-draft-highlight-and-recenter (&optional n)
   (interactive "P")
-  (if wl-highlight-body-too
-      (let ((beg (point-min))
-	    (end (point-max)))
-	(put-text-property beg end 'face nil)
-	(wl-highlight-message beg end t)))
+  (when wl-highlight-body-too
+    (let ((modified (buffer-modified-p)))
+      (unwind-protect
+	  (progn
+	    (put-text-property (point-min) (point-max) 'face nil)
+	    (wl-highlight-message (point-min) (point-max) t))
+	(set-buffer-modified-p modified))))
   (recenter n))
 
 ;;;; user-agent support by Sen Nagata