* wl-draft.el (wl-draft-save):
[elisp/wanderlust.git] / wl / wl-draft.el
index ff7781a..9168336 100644 (file)
@@ -1,4 +1,4 @@
-;;; wl-draft.el -- Message draft mode for Wanderlust.
+;;; wl-draft.el --- Message draft mode for Wanderlust.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
 ;;
 
 ;;; Commentary:
-;; 
+;;
 
 ;;; Code:
-;; 
+;;
 
 (require 'sendmail)
 (require 'wl-template)
   (defalias-maybe 'wl-init 'ignore)
   (defalias-maybe 'wl-draft-mode 'ignore))
 
+(eval-and-compile
+  (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)
 (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-config-sub-func-alist
-  '((body        . wl-draft-config-sub-body)
-    (top         . wl-draft-config-sub-top)
-    (bottom      . wl-draft-config-sub-bottom)
-    (header      . wl-draft-config-sub-header)
-    (body-file   . wl-draft-config-sub-body-file)
-    (top-file    . wl-draft-config-sub-top-file)
-    (bottom-file . wl-draft-config-sub-bottom-file)
-    (header-file . wl-draft-config-sub-header-file)
-    (template    . wl-draft-config-sub-template)
-    (x-face      . wl-draft-config-sub-x-face)))
+  '((body              . wl-draft-config-sub-body)
+    (top               . wl-draft-config-sub-top)
+    (bottom            . wl-draft-config-sub-bottom)
+    (header            . wl-draft-config-sub-header)
+    (header-top                . wl-draft-config-sub-header-top)
+    (header-bottom     . wl-draft-config-sub-header)
+    (part-top          . wl-draft-config-sub-part-top)
+    (part-bottom       . wl-draft-config-sub-part-bottom)
+    (body-file         . wl-draft-config-sub-body-file)
+    (top-file          . wl-draft-config-sub-top-file)
+    (bottom-file       . wl-draft-config-sub-bottom-file)
+    (header-file       . wl-draft-config-sub-header-file)
+    (template          . wl-draft-config-sub-template)
+    (x-face            . wl-draft-config-sub-x-face)))
 
 (make-variable-buffer-local 'wl-draft-buffer-file-name)
 (make-variable-buffer-local 'wl-draft-buffer-cur-summary-buffer)
 (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
                             wl-smtp-authenticate-type
                           (list wl-smtp-authenticate-type)))))
            (smtp-use-sasl (and smtp-sasl-mechanisms t))
-           (smtp-use-starttls wl-smtp-connection-type)
+           (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
            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 
+                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))
             (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 ()
   (mail-position-on-field "To"))
 
 (defun wl-draft-strip-subject-re (subject)
-  "Remove \"Re:\" from subject lines. Shamelessly copied from Gnus"
+  "Remove \"Re:\" from subject lines. Shamelessly copied from Gnus."
   (if (string-match wl-subject-prefix-regexp subject)
       (substring subject (match-end 0))
     subject))
@@ -272,7 +287,9 @@ 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)
+       from to-alist cc-alist decoder parent-folder)
+    (set-buffer summary-buf)
+    (setq parent-folder (wl-summary-buffer-folder-name))
     (set-buffer buf)
     (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
     (catch 'done
@@ -320,14 +337,14 @@ Reply to author if WITH-ARG is non-nil."
       (setq decoder (mime-find-field-decoder 'Subject 'plain))
       (setq subject (if (and subject decoder)
                        (funcall decoder subject) subject))
-      (setq to-alist 
+      (setq to-alist
            (mapcar
             (lambda (addr)
               (setq decoder (mime-find-field-decoder 'To 'plain))
               (cons (nth 1 (std11-extract-address-components addr))
                     (if decoder (funcall decoder addr) addr)))
             to))
-      (setq cc-alist 
+      (setq cc-alist
            (mapcar
             (lambda (addr)
               (setq decoder (mime-find-field-decoder 'Cc 'plain))
@@ -336,7 +353,7 @@ Reply to author if WITH-ARG is non-nil."
             cc)))
     (and wl-reply-subject-prefix
         (setq subject (concat wl-reply-subject-prefix
-                               (wl-draft-strip-subject-re
+                              (wl-draft-strip-subject-re
                                (or subject "")))))
     (setq in-reply-to (std11-field-body "Message-Id"))
     (setq references (nconc
@@ -352,10 +369,18 @@ Reply to author if WITH-ARG is non-nil."
       (setq mail-followup-to
            (wl-draft-make-mail-followup-to (append to cc)))
       (setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
-    (setq newsgroups (wl-parse newsgroups
-                              "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
-         newsgroups (wl-delete-duplicates newsgroups)
-         newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
+    (with-temp-buffer                  ; to keep raw buffer unibyte.
+      (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+      (setq newsgroups (wl-parse newsgroups
+                                "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
+           newsgroups (wl-delete-duplicates newsgroups)
+           newsgroups
+           (if newsgroups
+               (mapconcat
+                (lambda (grp)
+                  (setq decoder (mime-find-field-decoder 'Newsgroups 'plain))
+                  (if decoder (funcall decoder grp) grp))
+                newsgroups ","))))
     (setq to (wl-delete-duplicates to nil t))
     (setq cc (wl-delete-duplicates
              (append (wl-delete-duplicates cc nil t)
@@ -390,32 +415,36 @@ Reply to author if WITH-ARG is non-nil."
                         (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 nil nil nil summary-buf nil parent-folder)
     (setq wl-draft-reply-buffer buf))
   (run-hooks 'wl-reply-hook))
 
 (defun wl-draft-add-references ()
+  (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)
-                   (std11-field-body "message-id")))
-         (ref (std11-field-body "References"))
-         (ref-list nil) (st nil))
+                  (set-buffer mail-reply-buffer)
+                  (std11-field-body "message-id")))
+        (field (or alt-field "In-Reply-To"))
+        (ref (std11-field-body field))
+        (ref-list nil) (st nil))
     (when (and mes-id ref)
       (while (string-match "<[^>]+>" ref st)
-        (setq ref-list
-              (cons (substring ref (match-beginning 0) (setq st (match-end 0)))
-                    ref-list)))
+       (setq ref-list
+             (cons (substring ref (match-beginning 0) (setq st (match-end 0)))
+                   ref-list)))
       (when (and ref-list
                 (member mes-id ref-list))
        (setq mes-id nil)))
     (when mes-id
       (save-excursion
-        (when (mail-position-on-field "References")
-          (forward-line)
-          (while (looking-at "^[ \t]")
-            (forward-line))
-          (setq mes-id (concat "\t" mes-id "\n")))
-        (insert mes-id))
+       (when (mail-position-on-field field)
+         (forward-line)
+         (while (looking-at "^[ \t]")
+           (forward-line))
+         (setq mes-id (concat "\t" mes-id "\n")))
+       (insert mes-id))
       t)))
 
 (defun wl-draft-yank-from-mail-reply-buffer (decode-it
@@ -424,8 +453,7 @@ Reply to author if WITH-ARG is non-nil."
   (save-restriction
     (narrow-to-region (point)(point))
     (insert
-     (save-excursion
-       (set-buffer mail-reply-buffer)
+     (with-current-buffer mail-reply-buffer
        (when decode-it
         (decode-mime-charset-region (point-min) (point-max)
                                     wl-mime-charset))
@@ -435,15 +463,17 @@ Reply to author if WITH-ARG is non-nil."
       (goto-char (point-min))
       (wl-draft-delete-fields ignored-fields))
     (goto-char (point-max))
-    (push-mark)
+    (push-mark (point) nil t)
     (goto-char (point-min)))
   (let ((beg (point)))
     (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
          (mail-yank-hooks (run-hooks 'mail-yank-hooks))
          (wl-draft-cite-function (funcall wl-draft-cite-function))) ; default cite
     (run-hooks 'wl-draft-cited-hook)
-    (when (and wl-draft-add-references
-              (wl-draft-add-references))
+    (when (if wl-draft-add-references
+             (wl-draft-add-references)
+           (if wl-draft-add-in-reply-to
+               (wl-draft-add-in-reply-to)))
       (wl-highlight-headers 'for-draft)) ; highlight when added References:
     (when wl-highlight-body-too
       (wl-highlight-body-region beg (point-max)))))
@@ -470,6 +500,7 @@ Reply to author if WITH-ARG is non-nil."
 (defun wl-message-mail-p ()
   "If exist To, Cc or Bcc field, return non-nil."
   (or (wl-message-field-exists-p "To")
+      (wl-message-field-exists-p "Resent-to")
       (wl-message-field-exists-p "Cc")
       (wl-message-field-exists-p "Bcc")
 ;;; This may be needed..
@@ -483,7 +514,8 @@ Reply to author if WITH-ARG is non-nil."
   (wl-draft-edit-string (elmo-get-file-string
                         (or file
                             (read-file-name "File to edit: "
-                                            (or wl-tmp-dir "~/"))))))
+                                            (or wl-temporary-file-directory
+                                                "~/"))))))
 
 (defun wl-draft-edit-string (string)
   (let ((cur-buf (current-buffer))
@@ -548,7 +580,8 @@ Reply to author if WITH-ARG is non-nil."
   (let (original-buffer
        mail-reply-buffer
        mail-citation-hook mail-yank-hooks
-       wl-draft-add-references wl-draft-cite-function)
+       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))
@@ -595,25 +628,25 @@ Reply to author if WITH-ARG is non-nil."
        (summary-buf wl-current-summary-buffer)
        (message-buf (get-buffer (wl-current-message-buffer)))
        from date cite-title num entity)
-    (setq date (std11-fetch-field "date"))
     (if (and summary-buf
             (buffer-live-p summary-buf)
             message-buf
             (buffer-live-p message-buf))
        (progn
-         (save-excursion
-           (set-buffer summary-buf)
-           (setq num
-                 (save-excursion
-                   (set-buffer message-buf)
-                   wl-message-buffer-cur-number))
+         (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)))
          (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
+                                    (wl-summary-from-func-internal
+                                     (or from "you"))
+                                    (or from "you"))))))
     (and cite-title
         (insert cite-title "\n"))
     (mail-indent-citation)))
@@ -640,7 +673,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)
@@ -694,7 +726,7 @@ Reply to author if WITH-ARG is non-nil."
     (when (and (or (eq major-mode 'wl-draft-mode)
                   (eq major-mode 'mail-mode))
               (or force-kill
-                  (y-or-n-p "Kill Current Draft?")))
+                  (y-or-n-p "Kill Current Draft? ")))
       (let ((cur-buf (current-buffer)))
        (wl-draft-hide cur-buf)
        (wl-draft-delete cur-buf)))
@@ -707,6 +739,15 @@ 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))
+
 ;; function for wl-sent-message-via
 
 (defmacro wl-draft-sent-message-p (type)
@@ -735,10 +776,9 @@ Reply to author if WITH-ARG is non-nil."
 (defun wl-draft-write-sendlog (status proto server to id)
   "Write send log file, if `wl-draft-sendlog' is non-nil."
   (when wl-draft-sendlog
-    (save-excursion
-      (let* ((tmp-buf (get-buffer-create " *wl-draft-sendlog*"))
-            (filename (expand-file-name wl-draft-sendlog-filename
-                                        elmo-msgdb-dir))
+    (with-temp-buffer
+      (let* ((filename (expand-file-name wl-draft-sendlog-filename
+                                        elmo-msgdb-directory))
             (filesize (nth 7 (file-attributes filename)))
             (server (if server (concat " server=" server) ""))
             (to (if to (cond
@@ -755,18 +795,15 @@ Reply to author if WITH-ARG is non-nil."
                   ""))
             (id (if id (concat " id=" id) ""))
             (time (wl-sendlog-time)))
-       (set-buffer tmp-buf)
-       (erase-buffer)
        (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
                 (> filesize wl-draft-sendlog-max-size))
            (rename-file filename (concat filename ".old") t))
        (if (file-writable-p filename)
-           (write-region (point-min) (point-max)
-                         filename t 'no-msg)
-         (message (format "%s is not writable." filename)))
-       (kill-buffer tmp-buf)))))
+           (write-region-as-binary (point-min) (point-max)
+                                   filename t 'no-msg)
+         (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
@@ -788,6 +825,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
@@ -801,10 +839,10 @@ to find out how to use this."
        (0   (progn
               (wl-draft-set-sent-message 'mail 'sent)
               (wl-draft-write-sendlog 'ok 'qmail nil (list to) id)))
-       (1   (error "qmail-inject reported permanent failure"))
-       (111 (error "qmail-inject reported transient failure"))
+       (1   (error "`qmail-inject' reported permanent failure"))
+       (111 (error "`qmail-inject' reported transient failure"))
        ;; should never happen
-       (t   (error "qmail-inject reported unknown failure"))))))
+       (t   (error "`qmail-inject' reported unknown failure"))))))
 
 (defun wl-draft-parse-msg-id-list-string (string)
   "Get msg-id list from STRING."
@@ -815,6 +853,22 @@ to find out how to use this."
                                msg-id-list))))
     (nreverse msg-id-list)))
 
+(defun wl-draft-std11-parse-addresses (lal)
+  (let ((ret (std11-parse-address lal)))
+    (if ret
+       (let ((dest (list (car ret))))
+         (setq lal (cdr ret))
+         (while (and (setq ret (std11-parse-ascii-token lal))
+                     (string-equal (cdr (assq 'specials (car ret))) ",")
+                     (setq ret (std11-parse-address (cdr ret)))
+                     )
+           (setq dest (cons (car ret) dest))
+           (setq lal (cdr ret)))
+         (while (eq 'spaces (car (car lal)))
+           (setq lal (cdr lal)))
+         (if lal (error "Error while parsing address"))
+         (nreverse dest)))))
+
 (defun wl-draft-parse-mailbox-list (field &optional remove-group-list)
   "Get mailbox list of FIELD from current buffer.
 The buffer is expected to be narrowed to just the headers of the message.
@@ -834,7 +888,7 @@ from current buffer."
        (skip-chars-backward "\n")
        (setq seq (std11-lexical-analyze
                   (buffer-substring-no-properties beg (point))))
-       (setq addresses (std11-parse-addresses seq))
+       (setq addresses (wl-draft-std11-parse-addresses seq))
        (while addresses
          (cond ((eq (car (car addresses)) 'group)
                 (setq has-group-list t)
@@ -862,7 +916,7 @@ 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 '("to" "cc" "bcc"))
        (resent-fields '("resent-to" "resent-cc" "resent-bcc"))
        (case-fold-search t)
        addrs recipients)
@@ -932,7 +986,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)
@@ -948,6 +1002,12 @@ non-nil."
                    (error
                     (wl-draft-write-sendlog 'failed 'smtp smtp-server
                                             recipients id)
+                    (if (/= (nth 1 err) 334)
+                        (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
@@ -958,21 +1018,27 @@ 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
-                     (list 'pop3
-                           (or wl-pop-before-smtp-user
-                               elmo-pop3-default-user)
-                           (or wl-pop-before-smtp-authenticate-type
-                               elmo-pop3-default-authenticate-type)
-                           (or wl-pop-before-smtp-server
-                               elmo-pop3-default-server)
-                           (or wl-pop-before-smtp-port
-                               elmo-pop3-default-port)
-                           (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)
@@ -984,7 +1050,7 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
                 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))
@@ -1007,7 +1073,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.
@@ -1030,11 +1096,21 @@ 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))
+                 (funcall wl-draft-send-mail-function)
+               (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))
@@ -1053,7 +1129,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
@@ -1074,7 +1152,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))))
@@ -1093,14 +1171,14 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
 
 (defun wl-draft-send (&optional kill-when-done mes-string)
   "Send current draft message.
-If optional argument is non-nil, current draft buffer is killed"
+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)
   (run-hooks 'wl-draft-send-hook)
   (when (or (not wl-interactive-send)
-           (y-or-n-p "Send current draft. OK?"))
+           (y-or-n-p "Do you really want to send current draft? "))
     (let ((send-mail-function 'wl-draft-raw-send)
          (editing-buffer (current-buffer))
          (sending-buffer (wl-draft-generate-clone-buffer
@@ -1138,14 +1216,39 @@ If optional argument is non-nil, current draft buffer is killed"
             (kill-buffer sending-buffer))))))
 
 (defun wl-draft-save ()
-  "Save current draft."
+  "Save current draft.
+Derived from `message-save-drafts' in T-gnus."
   (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."
@@ -1166,7 +1269,7 @@ If optional argument is non-nil, current draft buffer is killed"
   (let ((editing-buffer (current-buffer)))
     (wl-draft-hide editing-buffer)
     (kill-buffer editing-buffer)))
-  
+
 (defun wl-draft-send-and-exit ()
   "Send current draft message and kill it."
   (interactive)
@@ -1177,20 +1280,20 @@ If optional argument 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
@@ -1200,7 +1303,9 @@ If optional argument 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))
@@ -1209,7 +1314,7 @@ If optional argument is non-nil, current draft buffer is killed"
 (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"))
+    (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)
@@ -1233,7 +1338,7 @@ If optional argument is non-nil, current draft buffer is killed"
        (tembuf (generate-new-buffer " fcc output"))
        (case-fold-search t)
        beg end)
-    (or (markerp header-end) (error "header-end must be a marker"))
+    (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)))
@@ -1257,7 +1362,7 @@ If optional argument is non-nil, current draft buffer is killed"
          (if (elmo-folder-append-buffer
               (wl-folder-get-elmo-folder
                (eword-decode-string (car fcc-list)))
-              id)
+              (not wl-fcc-force-as-read))
              (wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id)
            (wl-draft-write-sendlog 'failed 'fcc nil (car fcc-list) id))
          (setq fcc-list (cdr fcc-list)))))
@@ -1288,22 +1393,72 @@ If optional argument is non-nil, current draft buffer is killed"
   (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
                           content-type content-transfer-encoding
-                          body edit-again summary-buf from)
+                          body edit-again summary-buf from parent-folder)
   "Write and send mail/news message with Wanderlust."
   (interactive)
-  (unless (featurep 'wl)
-    (require 'wl))
+  (require 'wl)
   (unless wl-init
-    (wl-load-profile))
-  (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)
+    (wl-load-profile)
+    (wl-folder-init)
+    (elmo-init)
+    (wl-plugged-init t))
+  (let (wl-demo)
+    (wl-init)) ; returns immediately if already initialized.
+
+  (let (buf-name header-alist)
+    (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))
+          parent-folder summary-buf))
+    (setq header-alist
+         (list
+          (cons "From: " (or from wl-from))
+          (cons "To: " (or to
+                           (and
+                            (or (interactive-p)
+                                (eq this-command 'wl-summary-write))
+                            "")))
+          (cons "Cc: " cc)
+          (cons "Subject: " (or subject ""))
+          (cons "Newsgroups: " newsgroups)
+          (cons "Mail-Followup-To: " mail-followup-to)
+          (cons "In-Reply-To: " in-reply-to)
+          (cons "References: " references)))
+    (setq header-alist (append header-alist
+                              (wl-draft-default-headers)
+                              (if body (list "" 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 ((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))))
+    buf-name))
+
+(defun wl-draft-create-buffer (&optional full parent-folder summary-buf)
+  (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+        (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
+        (summary-buf (or 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
@@ -1325,96 +1480,111 @@ If optional argument 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)
+    (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)
-    (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)))
-    (if wl-on-nemacs
-       (push-mark (point) t)
-      (push-mark (point) t t))
-    (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 parent-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
+  (string . string)    ;;  insert string string
+  (string . function)  ;;  insert string (funcall)
+  (string . nil)       ;;  insert nothing
+  (function . (arg1 arg2 ..))  ;; call function with argument
+  nil                  ;;  insert 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
+        ((functionp field) (apply field value))
+        ((stringp field)
+         (cond
+          ((stringp value) (insert field value "\n"))
+          ((functionp value) (insert field (funcall value) "\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)))
+
+(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-insert-ccs (str cc)
   (let ((field
@@ -1431,6 +1601,46 @@ If optional argument is non-nil, current draft buffer is killed"
                         (mapcar 'downcase wl-subscribed-mailing-list)))))
        (insert str field "\n"))))
 
+(defsubst wl-draft-default-headers ()
+  (list
+   (cons "Mail-Reply-To: " (and wl-insert-mail-reply-to
+                               (wl-address-header-extract-address
+                                wl-from)))
+   (cons "" wl-generate-mailer-string-function)
+   (cons "Reply-To: " mail-default-reply-to)
+   (cons 'wl-draft-insert-ccs
+        (list "Bcc: " (or wl-bcc
+                          (and mail-self-blind (user-login-name)))))
+   (cons 'wl-draft-insert-ccs
+        (list "Fcc: " 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
+;   wl-draft-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)
        (elmo-nntp-default-user
@@ -1442,17 +1652,17 @@ If optional argument is non-nil, current draft buffer is killed"
        (elmo-nntp-default-stream-type
         (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type)))
     (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))
+       (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))
       (wl-draft-set-sent-message 'news 'sent)
       (wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server
-                             (std11-field-body "Newsgroups")
-                             (std11-field-body "Message-ID")))))
+                             (std11-field-body "Newsgroups")
+                             (std11-field-body "Message-ID")))))
 
 (defun wl-draft-generate-clone-buffer (name &optional local-variables)
-  "generate clone of current buffer named NAME."
+  "Generate clone of current buffer named NAME."
   (let ((editing-buffer (current-buffer)))
     (save-excursion
       (set-buffer (generate-new-buffer name))
@@ -1473,38 +1683,49 @@ If optional argument 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))
-    (if wl-on-nemacs
-       (push-mark (point) t)
-      (push-mark (point) t 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)
+      (let((mime-edit-again-ignored-field-regexp
+           "^\\(Content-.*\\|Mime-Version\\):"))
+       (wl-draft-decode-message-in-buffer))
+      (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
@@ -1540,6 +1761,18 @@ If optional argument is non-nil, current draft buffer is killed"
   (wl-draft-config-body-goto-header)
   (if content (insert (concat (eval content) "\n"))))
 
+(defun wl-draft-config-sub-header-top (content)
+  (goto-char (point-min))
+  (if content (insert (concat (eval content) "\n"))))
+
+(defun wl-draft-config-sub-part-top (content)
+  (goto-char (mime-edit-content-beginning))
+  (if content (insert (concat (eval content) "\n"))))
+
+(defun wl-draft-config-sub-part-bottom (content)
+  (goto-char (mime-edit-content-end))
+  (if content (insert (concat (eval content) "\n"))))
+
 (defsubst wl-draft-config-sub-file (content)
   (let ((coding-system-for-read wl-cs-autoconv)
        (file (expand-file-name (eval content))))
@@ -1587,26 +1820,24 @@ If optional argument is non-nil, current draft buffer is killed"
     (while clist
       (setq config (car clist))
       (cond
+       ((functionp config)
+       (funcall config))
        ((consp config)
        (let ((field (car config))
              (content (cdr config))
              ret-val)
-         (cond
-          ((stringp field)
-           (wl-draft-replace-field field (eval content) t))
-          ((setq ret-val (wl-draft-config-sub-func field content))
+         (cond
+          ((stringp field)
+           (wl-draft-replace-field field (eval content) t))
+          ((setq ret-val (wl-draft-config-sub-func field content))
            (if (cdr ret-val) ;; for wl-draft-config-sub-template
                (wl-append local-variables (cdr ret-val))))
-          ((boundp field) ;; variable
-           (make-local-variable field)
-           (set field (eval content))
-           (wl-append local-variables (list field)))
-          (t
-           (error "%s: not variable" field)))))
-       ((or (functionp config)
-           (and (symbolp config)
-                (fboundp config)))
-       (funcall config))
+          ((boundp field) ;; variable
+           (make-local-variable field)
+           (set field (eval content))
+           (wl-append local-variables (list field)))
+          (t
+           (error "%s: not variable" field)))))
        (t
        (error "%s: not supported type" config)))
       (setq clist (cdr clist)))
@@ -1747,7 +1978,9 @@ If optional argument 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
@@ -1786,7 +2019,9 @@ If optional argument is non-nil, current draft buffer is killed"
   "Flush draft queue."
   (interactive)
   (let* ((queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
-        (msgs2 (elmo-folder-list-messages queue-folder))
+        (msgs2 (progn
+                 (elmo-folder-open-internal queue-folder)
+                 (elmo-folder-list-messages queue-folder)))
         (i 0)
         (performed 0)
         (wl-draft-queue-flushing t)
@@ -1797,16 +2032,17 @@ If optional argument 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))))
       (setq msgs2 (cdr msgs2)))
     (when (> (setq len (length msgs)) 0)
       (if (elmo-y-or-n-p (format
-                         "%d message(s) are in the sending queue. Send now?"
+                         "%d message(s) are in the sending queue.  Send now? "
                          len)
                         (not elmo-dop-flush-confirm) t)
          (progn
@@ -1836,15 +2072,21 @@ If optional argument 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)))
        (message "%d message(s) are remained to be sent." len))
+      (elmo-folder-close queue-folder)
       len)))
 
 (defun wl-jump-to-draft-buffer (&optional arg)
@@ -1860,7 +2102,8 @@ If optional argument is non-nil, current draft buffer is killed"
          buf draft-bufs)
       (while bufs
        (if (and
-            (setq buf (buffer-file-name (car bufs)))
+            (setq buf (with-current-buffer (car bufs)
+                        wl-draft-buffer-file-name))
             (string-match draft-regexp buf))
            (setq draft-bufs (cons (buffer-name (car bufs)) draft-bufs)))
        (setq bufs (cdr bufs)))
@@ -1912,11 +2155,11 @@ If optional argument is non-nil, current draft buffer is killed"
   "Insert HEADER-NAME w/ value HEADER-VALUE into a message."
   ;; it seems like overriding existing headers is acceptable -- should
   ;; we provide an option?
-  
+
   ;; plan was: unfold header (might be folded), remove existing value, insert
   ;;           new value
   ;; wl doesn't seem to fold header lines yet anyway :-)
-  
+
   (let ((kill-whole-line t)
        end-of-line)
     (mail-position-on-field (capitalize header-name))
@@ -1952,8 +2195,8 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
   ;; protect these -- to and subject get bound at some point, so it looks
   ;; 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-reply-buffer-style 'split))
+       (wl-draft-use-frame (eq switch-function 'switch-to-buffer-other-frame))
+       (wl-draft-reply-buffer-style 'split))
     (when (eq switch-function 'switch-to-buffer-other-window)
       (when (one-window-p t)
        (if (window-minibuffer-p) (other-window 1))