(wl-user-agent-insert-body): Make sure body ends with newline.
[elisp/wanderlust.git] / wl / wl-draft.el
index 13ba443..0e64e1b 100644 (file)
@@ -135,36 +135,32 @@ e.g.
          user mechanism server))
 
 (defmacro wl-smtp-extension-bind (&rest body)
-  (` (let* ((smtp-sasl-mechanisms
-            (if wl-smtp-authenticate-type
-                (mapcar 'upcase
-                        (if (listp wl-smtp-authenticate-type)
-                            wl-smtp-authenticate-type
-                          (list wl-smtp-authenticate-type)))))
-           (smtp-use-sasl (and smtp-sasl-mechanisms t))
-           (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
-           (smtp-open-connection-function
-            (if (eq wl-smtp-connection-type 'ssl)
-                #'open-ssl-stream
-              smtp-open-connection-function))
-           (smtp-end-of-line
-            (if (eq wl-smtp-connection-type 'ssl)
-                "\n"
-              smtp-end-of-line))
-           smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
-       (setq smtp-sasl-user-name wl-smtp-posting-user
-            smtp-sasl-properties (when wl-smtp-authenticate-realm
-                                   (list 'realm
-                                         wl-smtp-authenticate-realm)))
-       (setq sasl-read-passphrase
-            (function
-             (lambda (prompt)
-               (elmo-get-passwd
-                (wl-smtp-password-key
-                 smtp-sasl-user-name
-                 (car smtp-sasl-mechanisms)
-                 smtp-server)))))
-       (,@ body))))
+  `(let* ((smtp-sasl-mechanisms
+          (if wl-smtp-authenticate-type
+              (mapcar 'upcase
+                      (if (listp wl-smtp-authenticate-type)
+                          wl-smtp-authenticate-type
+                        (list wl-smtp-authenticate-type)))))
+         (smtp-use-sasl (and smtp-sasl-mechanisms t))
+         (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
+         (smtp-open-connection-function
+          (if (eq wl-smtp-connection-type 'ssl)
+              #'open-ssl-stream
+            smtp-open-connection-function))
+         smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
+     (setq smtp-sasl-user-name wl-smtp-posting-user
+          smtp-sasl-properties (when wl-smtp-authenticate-realm
+                                 (list 'realm
+                                       wl-smtp-authenticate-realm)))
+     (setq sasl-read-passphrase
+          (function
+           (lambda (prompt)
+             (elmo-get-passwd
+              (wl-smtp-password-key
+               smtp-sasl-user-name
+               (car smtp-sasl-mechanisms)
+               smtp-server)))))
+     ,@body))
 
 (defun wl-draft-insert-date-field ()
   "Insert Date field."
@@ -293,8 +289,7 @@ e.g.
     (wl-draft (list (cons 'To "")
                    (cons 'Subject subject)
                    (cons 'References references))
-             nil nil nil nil parent-folder))
-  (setq wl-draft-parent-number number)
+             nil nil nil nil parent-folder number))
   (goto-char (point-max))
   (wl-draft-insert-message)
   (mail-position-on-field "To")
@@ -308,70 +303,71 @@ e.g.
   "Return t when From address in the current message is user's self one or not."
   (wl-address-user-mail-address-p (or (elmo-field-body "From") "")))
 
+(defun wl-draft-find-reply-headers (rule-symbol)
+  (let ((rule-list (symbol-value rule-symbol))
+       condition-match-p result)
+    (setq condition-match-p
+         (lambda (condition)
+           (cond ((stringp condition)
+                  (std11-field-body condition))
+                 ((functionp condition)
+                  (funcall condition))
+                 ((consp condition)
+                  (and (funcall condition-match-p (car condition))
+                       (funcall condition-match-p (cdr condition))))
+                 ((null condition))
+                 (t
+                  (error "Unkown condition in `%s'" rule-symbol)))))
+    (while (and (null result) rule-list)
+      (let ((rule (car rule-list)))
+       (when (funcall condition-match-p (car rule))
+         (setq result (cdr rule)))
+       (setq rule-list (cdr rule-list))))
+    result))
+
 (defun wl-draft-reply (buf with-arg summary-buf &optional number)
-  "Reply to BUF buffer message.
-Reply to author if WITH-ARG is non-nil."
+  "Create draft for replying to the message in buffer BUF.
+Recipients are prepared along `wl-draft-reply-without-argument-list',
+or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
 ;;;(save-excursion
-  (let (r-list
+  (let ((rule-list (if with-arg
+                      'wl-draft-reply-with-argument-list
+                    'wl-draft-reply-without-argument-list))
+       reply-headers
        to mail-followup-to cc subject in-reply-to references newsgroups
        to-alist cc-alist decoder parent-folder)
     (when (buffer-live-p summary-buf)
       (with-current-buffer summary-buf
        (setq parent-folder (wl-summary-buffer-folder-name))))
     (set-buffer (or buf mime-mother-buffer))
-    (setq r-list (if with-arg wl-draft-reply-with-argument-list
-                  wl-draft-reply-without-argument-list))
-    (catch 'done
-      (while r-list
-       (when (let ((condition (car (car r-list))))
-               (cond ((stringp condition)
-                      (std11-field-body condition))
-                     ((listp condition)
-                      (catch 'done
-                        (while condition
-                          (cond
-                           ((stringp (car condition))
-                            (or (std11-field-body (car condition))
-                                (throw 'done nil)))
-                           ((symbolp (car condition))
-                            (or (funcall (car condition))
-                                (throw 'done nil)))
-                           (t
-                            (debug)))
-                          (setq condition (cdr condition)))
-                        t))
-                     ((symbolp condition)
-                      (funcall condition))))
-         (let ((r-to-list (nth 0 (cdr (car r-list))))
-               (r-cc-list (nth 1 (cdr (car r-list))))
-               (r-ng-list (nth 2 (cdr (car r-list)))))
-           (when (and (member "Followup-To" r-ng-list)
-                      (string= (std11-field-body "Followup-To") "poster"))
-             (setq r-to-list (cons "From" r-to-list))
-             (setq r-ng-list (delete "Followup-To"
-                                     (copy-sequence r-ng-list))))
-           (if (and r-to-list (symbolp r-to-list))
-               (setq to (wl-concat-list (funcall r-to-list) ","))
-             (setq to (wl-concat-list (cons to
-                                            (elmo-multiple-fields-body-list
-                                             r-to-list))
-                                      ",")))
-           (if (and r-cc-list (symbolp r-cc-list))
-               (setq cc (wl-concat-list (funcall r-cc-list) ","))
-             (setq cc (wl-concat-list (cons cc
-                                            (elmo-multiple-fields-body-list
-                                             r-cc-list))
-                                      ",")))
-           (if (and r-ng-list (symbolp r-ng-list))
-               (setq newsgroups (wl-concat-list (funcall r-ng-list) ","))
-             (setq newsgroups (wl-concat-list (cons newsgroups
-                                                    (std11-field-bodies
-                                                     r-ng-list))
-                                              ","))))
-         (throw 'done nil))
-       (setq r-list (cdr r-list)))
-      (error "No match field: check your `wl-draft-reply-%s-argument-list'"
-            (if with-arg "with" "without")))
+    (setq reply-headers
+         (or (wl-draft-find-reply-headers rule-list)
+             (error "No match field: check your `%s'" rule-list)))
+    (let ((r-to-list (nth 0 reply-headers))
+         (r-cc-list (nth 1 reply-headers))
+         (r-ng-list (nth 2 reply-headers)))
+      (setq to (wl-concat-list
+               (nconc
+                (if (functionp r-to-list)
+                    (funcall r-to-list)
+                  (elmo-multiple-fields-body-list r-to-list))
+                (and (member "Followup-To" r-ng-list)
+                     (string= (std11-field-body "Followup-To") "poster")
+                     (progn
+                       (setq r-ng-list (delete "Followup-To"
+                                               (copy-sequence r-ng-list)))
+                       (elmo-multiple-fields-body-list '("From")))))
+               ","))
+      (setq cc (wl-concat-list
+               (if (functionp r-cc-list)
+                   (funcall r-cc-list)
+                 (elmo-multiple-fields-body-list r-cc-list))
+               ","))
+      (setq newsgroups (wl-concat-list
+                       (if (functionp r-ng-list)
+                           (funcall r-ng-list)
+                         (std11-field-bodies r-ng-list))
+                       ",")))
     (setq subject (std11-field-body "Subject"))
     (setq to (wl-parse-addresses to)
          cc (wl-parse-addresses cc))
@@ -411,7 +407,7 @@ Reply to author if WITH-ARG is non-nil."
       (setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
     (with-temp-buffer                  ; to keep raw buffer unibyte.
       (set-buffer-multibyte default-enable-multibyte-characters)
-      (setq newsgroups (wl-parse newsgroups
+      (setq newsgroups (elmo-parse newsgroups
                                 "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
            newsgroups (wl-delete-duplicates newsgroups)
            newsgroups
@@ -427,24 +423,24 @@ Reply to author if WITH-ARG is non-nil."
                      to (copy-sequence to))
              t t))
     (and to (setq to (mapconcat
-                     '(lambda (addr)
-                        (if wl-draft-reply-use-address-with-full-name
-                            (or (cdr (assoc addr to-alist)) addr)
-                          addr))
+                     (lambda (addr)
+                       (if wl-draft-reply-use-address-with-full-name
+                           (or (cdr (assoc addr to-alist)) addr)
+                         addr))
                      to ",\n\t")))
     (and cc (setq cc (mapconcat
-                     '(lambda (addr)
-                        (if wl-draft-reply-use-address-with-full-name
-                            (or (cdr (assoc addr cc-alist)) addr)
-                          addr))
+                     (lambda (addr)
+                       (if wl-draft-reply-use-address-with-full-name
+                           (or (cdr (assoc addr cc-alist)) addr)
+                         addr))
                      cc ",\n\t")))
     (and mail-followup-to
         (setq mail-followup-to
               (mapconcat
-               '(lambda (addr)
-                  (if wl-draft-reply-use-address-with-full-name
-                      (or (cdr (assoc addr (append to-alist cc-alist))) addr)
-                    addr))
+               (lambda (addr)
+                 (if wl-draft-reply-use-address-with-full-name
+                     (or (cdr (assoc addr (append to-alist cc-alist))) addr)
+                   addr))
                mail-followup-to ",\n\t")))
     (and (null to) (setq to cc cc nil))
     (setq references (delq nil references)
@@ -463,8 +459,7 @@ Reply to author if WITH-ARG is non-nil."
                    (cons 'In-Reply-To in-reply-to)
                    (cons 'References references)
                    (cons 'Mail-Followup-To mail-followup-to))
-             nil nil nil nil parent-folder)
-    (setq wl-draft-parent-number number)
+             nil nil nil nil parent-folder number)
     (setq wl-draft-reply-buffer buf)
     (setq wl-draft-config-variables
          (append wl-draft-parent-variables
@@ -492,8 +487,7 @@ Reply to author if WITH-ARG is non-nil."
   (wl-draft-add-in-reply-to "References"))
 
 (defun wl-draft-add-in-reply-to (&optional alt-field)
-  (let* ((mes-id (save-excursion
-                  (set-buffer mail-reply-buffer)
+  (let* ((mes-id (with-current-buffer mail-reply-buffer
                   (std11-field-body "message-id")))
         (field (or alt-field "In-Reply-To"))
         (ref (std11-field-body field))
@@ -761,9 +755,8 @@ Reply to author if WITH-ARG is non-nil."
 
 (defun wl-draft-delete (editing-buffer)
   "Kill the editing draft buffer and delete the file corresponds to it."
-  (save-excursion
-    (when editing-buffer
-      (set-buffer editing-buffer)
+  (when editing-buffer
+    (with-current-buffer editing-buffer
       (when wl-draft-buffer-message-number
        (elmo-folder-delete-messages (wl-draft-get-folder)
                                     (list
@@ -833,16 +826,16 @@ text was killed."
 ;; function for wl-sent-message-via
 
 (defmacro wl-draft-sent-message-p (type)
-  (` (eq (nth 1 (assq (, type) wl-sent-message-via)) 'sent)))
+  `(eq (nth 1 (assq ,type wl-sent-message-via)) 'sent))
 
 (defmacro wl-draft-set-sent-message (type result &optional server-port)
-  (` (let ((element (assq (, type) wl-sent-message-via)))
-       (if element
-          (unless (eq (nth 1 element) (, result))
-            (setcdr element (list (, result) (, server-port)))
-            (setq wl-sent-message-modified t))
-        (push (list (, type) (, result) (, server-port)) wl-sent-message-via)
-        (setq wl-sent-message-modified t)))))
+  `(let ((element (assq ,type wl-sent-message-via)))
+     (if element
+        (unless (eq (nth 1 element) ,result)
+          (setcdr element (list ,result ,server-port))
+          (setq wl-sent-message-modified t))
+       (push (list ,type ,result ,server-port) wl-sent-message-via)
+       (setq wl-sent-message-modified t))))
 
 (defun wl-draft-sent-message-results ()
   (let ((results wl-sent-message-via)
@@ -872,7 +865,7 @@ text was killed."
                          (concat " to="
                                  (mapconcat
                                   'identity
-                                  (mapcar '(lambda(x) (format "<%s>" x)) to)
+                                  (mapcar (lambda (x) (format "<%s>" x)) to)
                                   ","))))
                   ""))
             (id (if id (concat " id=" id) ""))
@@ -1075,8 +1068,7 @@ non-nil."
                (newline))
            (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
            (if mail-interactive
-               (save-excursion
-                 (set-buffer errbuf)
+               (with-current-buffer errbuf
                  (erase-buffer)))
            (wl-draft-delete-field "bcc" delimline)
            (wl-draft-delete-field "resent-bcc" delimline)
@@ -1175,7 +1167,7 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
            nil t)
       (when (string= "" (match-string 1))
        (replace-match ""))))
-;;;  (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
+;;;  (run-hooks 'wl-mail-send-pre-hook) ; X-PGP-Sig, Cancel-Lock
   (wl-draft-dispatch-message)
   (when kill-when-done
     ;; hide editing-buffer.
@@ -1277,56 +1269,41 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
     result))
 
 (defcustom wl-draft-send-confirm-with-preview t
-  "Non-nil to invoke preview through confirmation of sending.
+  "*Non-nil to invoke preview through confirmation of sending.
 This variable is valid when `wl-interactive-send' has non-nil value."
   :type 'boolean
   :group 'wl-draft)
 
 (defun wl-draft-send-confirm ()
-  (let (answer)
-    (unwind-protect
-       (condition-case quit
-           (progn
-             (when wl-draft-send-confirm-with-preview
-               (wl-draft-preview-message))
-             (save-excursion
-               (goto-char (point-min)) ; to show recipients in header
-               (catch 'done
-                 (while t
-                   (discard-input)
-                   (message "Send current draft? <y/n/j(down)/k(up)> ")
-                   (setq answer (let ((cursor-in-echo-area t)) (read-char)))
-                   (cond
-                    ((or (eq answer ?y)
-                         (eq answer ?Y)
-                         (eq answer ? ))
-                 (throw 'done t))
-                    ((or (eq answer ?v)
-                         (eq answer ?j)
-                         (eq answer ?J))
-                     (condition-case err
-                         (scroll-up)
-                       (error nil)))
-                    ((or (eq answer ?^)
-                         (eq answer ?k)
-                         (eq answer ?K))
-                     (condition-case err
-                         (scroll-down)
-                       (error nil)))
-                    (t
-                     (throw 'done nil)))))))
-         (quit nil))
-      (when (and wl-draft-send-confirm-with-preview
-                (eq major-mode 'mime-view-mode))
-       (wl-mime-quit-preview)))))
+  (unwind-protect
+      (condition-case nil
+         (progn
+           (when wl-draft-send-confirm-with-preview
+             (let (wl-draft-send-hook
+                   (pgg-decrypt-automatically nil))
+               (wl-draft-preview-message)))
+           (save-excursion
+             (goto-char (point-min)) ; to show recipients in header
+             (funcall
+              (if (functionp wl-draft-send-confirm-type)
+                  wl-draft-send-confirm-type
+                (lambda (prompt)
+                  (wl-y-or-n-p-with-scroll
+                   prompt
+                   (eq wl-draft-send-confirm-type 'scroll-by-SPC/BS))))
+              "Send current draft? ")))
+       (quit nil))
+    (when (and wl-draft-send-confirm-with-preview
+              (eq major-mode 'mime-view-mode))
+      (wl-mime-quit-preview))))
 
 (defun wl-draft-send (&optional kill-when-done mes-string)
   "Send current draft message.
 If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
   (interactive)
-  ;; Don't call this explicitly.
-  ;; Added to 'wl-draft-send-hook (by teranisi)
-  ;; (wl-draft-config-exec)
+;;; Don't call this explicitly.
+;;; Added to 'wl-draft-send-hook (by teranisi)
+;;;  (wl-draft-config-exec)
   (run-hooks 'wl-draft-send-hook)
   (when (or (not wl-interactive-send)
            (wl-draft-send-confirm))
@@ -1342,8 +1319,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
          (wl-draft-verbose-msg nil)
          err)
       (unwind-protect
-         (save-excursion
-           (set-buffer sending-buffer)
+         (with-current-buffer sending-buffer
            (if (and (not (wl-message-mail-p))
                     (not (wl-message-news-p)))
                (error "No recipient is specified"))
@@ -1366,8 +1342,11 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
            ;; It causes a huge loss in the IMAP folder.
            (when (and parent-flag parent-number
                       (not (eq (length parent-folder) 0)))
-             (wl-folder-set-persistent-mark
-              parent-folder parent-number parent-flag))
+             (condition-case nil
+                 (wl-folder-set-persistent-mark
+                  parent-folder parent-number parent-flag)
+               (error
+                (message "Set mark (%s) failed" (symbol-name parent-flag)))))
            (funcall wl-draft-send-function editing-buffer kill-when-done)
            ;; Now perform actions on successful sending.
            (while mail-send-actions
@@ -1420,7 +1399,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                        "This is a blind carbon copy.")
                    "\n")
            (mime-edit-insert-tag "message" "rfc822")
-           (insert-buffer draft-buffer)
+           (insert-buffer-substring draft-buffer)
            (let (wl-interactive-send)
              (wl-draft-send 'kill-when-done))))))))
 
@@ -1465,7 +1444,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
          (elmo-folder-check (wl-draft-get-folder))
          (elmo-folder-commit (wl-draft-get-folder))
          (setq wl-draft-buffer-message-number next-number)
-         (rename-buffer (format "%s/%d" wl-draft-folder next-number))
+         (rename-buffer (format "%s/%d" wl-draft-folder next-number) t)
          (setq buffer-file-name (buffer-name))
          (set-buffer-modified-p nil)
          (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
@@ -1576,15 +1555,12 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 
 (defun wl-draft-do-fcc (header-end &optional fcc-list)
   (let ((send-mail-buffer (current-buffer))
-       (tembuf (generate-new-buffer " fcc output"))
        (case-fold-search t)
        beg end)
     (or (markerp header-end) (error "HEADER-END must be a marker"))
-    (save-excursion
-      (unless fcc-list
-       (setq fcc-list (wl-draft-get-fcc-list header-end)))
-      (set-buffer tembuf)
-      (erase-buffer)
+    (unless fcc-list
+      (setq fcc-list (wl-draft-get-fcc-list header-end)))
+    (with-temp-buffer
       ;; insert just the headers to avoid moving the gap more than
       ;; necessary (the message body could be arbitrarily huge.)
       (insert-buffer-substring send-mail-buffer 1 header-end)
@@ -1605,8 +1581,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
              (or (equal (car fcc-list) (car wl-read-folder-history))
                  (setq wl-read-folder-history
                        (append (list (car fcc-list)) wl-read-folder-history))))
-         (setq fcc-list (cdr fcc-list)))))
-    (kill-buffer tembuf)))
+         (setq fcc-list (cdr fcc-list)))))))
 
 (defun wl-draft-on-field-p ()
   (if (< (point)
@@ -1634,7 +1609,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 (defun wl-draft (&optional header-alist
                           content-type content-transfer-encoding
                           body edit-again
-                          parent-folder)
+                          parent-folder
+                          parent-number)
   "Write and send mail/news message with Wanderlust."
   (interactive)
   (require 'wl)
@@ -1646,9 +1622,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
   (let (wl-demo)
     (wl-init)) ; returns immediately if already initialized.
 
-  (wl-set-save-drafts)
+  (wl-start-save-drafts)
   (let (buffer header-alist-internal)
-    (setq buffer (wl-draft-create-buffer parent-folder))
+    (setq buffer (wl-draft-create-buffer parent-folder parent-number))
     (unless (cdr (assq 'From header-alist))
       (setq header-alist
            (append (list (cons 'From wl-from)) header-alist)))
@@ -1690,10 +1666,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
           (goto-char (point-max))))
     buffer))
 
-(defun wl-draft-create-buffer (&optional parent-folder)
+(defun wl-draft-create-buffer (&optional parent-folder parent-number)
   (let* ((draft-folder (wl-draft-get-folder))
-        (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
-        (summary-buf (wl-summary-get-buffer parent-folder))
         (reply-or-forward
          (or (eq this-command 'wl-summary-reply)
              (eq this-command 'wl-summary-reply-with-citation)
@@ -1746,8 +1720,10 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (setq wl-sent-message-queued nil)
     (setq wl-draft-config-exec-flag t)
     (setq wl-draft-parent-folder (or parent-folder ""))
+    (setq wl-draft-parent-number parent-number)
     (or (eq this-command 'wl-folder-write-current-folder)
-       (setq wl-draft-buffer-cur-summary-buffer summary-buf))
+       (setq wl-draft-buffer-cur-summary-buffer
+             (wl-summary-get-buffer parent-folder)))
     buffer))
 
 (defun wl-draft-create-contents (header-alist)
@@ -1873,7 +1849,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
        field
       nil)))
 
-(defsubst wl-draft-default-headers ()
+(defun wl-draft-default-headers ()
   (list
    (cons 'Mail-Reply-To (and wl-insert-mail-reply-to
                             (wl-address-header-extract-address
@@ -1952,18 +1928,16 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 (defun wl-draft-generate-clone-buffer (name &optional local-variables)
   "Generate clone of current buffer named NAME."
   (let ((editing-buffer (current-buffer)))
-    (save-excursion
-      (set-buffer (generate-new-buffer name))
+    (with-current-buffer (generate-new-buffer name)
       (erase-buffer)
       (wl-draft-mode)
       (wl-draft-editor-mode)
-      (insert-buffer editing-buffer)
+      (insert-buffer-substring editing-buffer)
       (message "")
       (while local-variables
        (make-local-variable (car local-variables))
        (set (car local-variables)
-            (save-excursion
-              (set-buffer editing-buffer)
+            (with-current-buffer editing-buffer
               (symbol-value (car local-variables))))
        (setq local-variables (cdr local-variables)))
       (current-buffer))))
@@ -2014,8 +1988,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                                "\\1"))
                  auto-save-file-name-transforms)))
     (setq buffer-file-name (buffer-name)
-         wl-draft-parent-folder ""
          wl-draft-buffer-message-number number)
+    (unless wl-draft-parent-folder
+      (setq wl-draft-parent-folder ""))
     (when wl-draft-write-file-function
       (add-hook 'local-write-file-hooks wl-draft-write-file-function))
     (wl-highlight-headers 'for-draft)
@@ -2024,22 +1999,20 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (goto-char (point-max))
     buffer))
 
-(defmacro wl-draft-body-goto-top ()
-  (` (progn
-       (goto-char (point-min))
-       (if (re-search-forward mail-header-separator nil t)
-          (forward-char 1)
-        (goto-char (point-max))))))
+(defun wl-draft-body-goto-top ()
+  (goto-char (point-min))
+  (if (re-search-forward mail-header-separator nil t)
+      (forward-char 1)
+    (goto-char (point-max))))
 
-(defmacro wl-draft-body-goto-bottom ()
-  (` (goto-char (point-max))))
+(defun wl-draft-body-goto-bottom ()
+  (goto-char (point-max)))
 
-(defmacro wl-draft-config-body-goto-header ()
-  (` (progn
-       (goto-char (point-min))
-       (if (re-search-forward mail-header-separator nil t)
-          (beginning-of-line)
-        (goto-char (point-max))))))
+(defun wl-draft-config-body-goto-header ()
+  (goto-char (point-min))
+  (if (re-search-forward mail-header-separator nil t)
+      (beginning-of-line)
+    (goto-char (point-max))))
 
 (defsubst wl-draft-config-sub-eval-insert (content &optional newline)
   (let (content-value)
@@ -2181,8 +2154,7 @@ Automatically applied in draft sending time."
             ((eq key 'reply)
              (when (and
                     reply-buf
-                    (save-excursion
-                      (set-buffer reply-buf)
+                    (with-current-buffer reply-buf
                       (save-restriction
                         (std11-narrow-to-header)
                         (goto-char (point-min))
@@ -2423,7 +2395,7 @@ Automatically applied in draft sending time."
        (message "No draft message exist.")
       (if (string-match (concat "^" wl-draft-folder "/") mybuf)
          (setq msg (cadr (memq
-                          (string-to-int (substring mybuf (match-end 0)))
+                          (string-to-number (substring mybuf (match-end 0)))
                           msgs))))
       (or msg (setq msg (car msgs)))
       (if (setq buf (get-buffer (format "%s/%d" wl-draft-folder msg)))
@@ -2467,8 +2439,8 @@ Automatically applied in draft sending time."
                  ((looking-at wl-folder-complete-header-regexp)
                   (and (boundp 'wl-read-folder-history)
                        (setq history wl-read-folder-history)))
-                 ;; ((looking-at wl-address-complete-header-regexp)
-                 ;;  (setq history .....))
+;;;              ((looking-at wl-address-complete-header-regexp)
+;;;               (setq history .....))
                  (t
                   nil)))
               (eolp))
@@ -2555,7 +2527,8 @@ Automatically applied in draft sending time."
   (goto-char (point-min))
   (search-forward mail-header-separator)
   (forward-line 1)
-  (insert body-text))
+  (insert body-text)
+  (or (bolp) (insert "\n")))
 
 ;;;###autoload
 (defun wl-user-agent-compose (&optional to subject other-headers continue
@@ -2574,26 +2547,23 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
   ;; to be necessary to protect the values used w/in
   (let ((wl-user-agent-headers-and-body-alist other-headers)
        (wl-draft-use-frame (eq switch-function 'switch-to-buffer-other-frame))
-       (wl-draft-buffer-style switch-function))
+       (wl-draft-buffer-style switch-function)
+       tem)
     (if to
-       (if (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
-                                  'ignore-case)
-           (setcdr
-            (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
-                                   'ignore-case)
-            to)
+       (if (setq tem (wl-string-match-assoc
+                      "\\`to\\'"
+                      wl-user-agent-headers-and-body-alist
+                      'ignore-case))
+           (setcdr tem to)
          (setq wl-user-agent-headers-and-body-alist
                (cons (cons "to" to)
                      wl-user-agent-headers-and-body-alist))))
     (if subject
-       (if (wl-string-match-assoc "subject"
-                                  wl-user-agent-headers-and-body-alist
-                                  'ignore-case)
-           (setcdr
-            (wl-string-match-assoc "subject"
-                                   wl-user-agent-headers-and-body-alist
-                                   'ignore-case)
-            subject)
+       (if (setq tem (wl-string-match-assoc
+                      "\\`subject\\'"
+                      wl-user-agent-headers-and-body-alist
+                      'ignore-case))
+           (setcdr tem subject)
          (setq wl-user-agent-headers-and-body-alist
                (cons (cons "subject" subject)
                      wl-user-agent-headers-and-body-alist))))
@@ -2625,12 +2595,11 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
        ;; highlight headers (from wl-draft in wl-draft.el)
        (wl-highlight-headers 'for-draft)
        ;; insert body
-       (if (wl-string-match-assoc "body" wl-user-agent-headers-and-body-alist
-                                  'ignore-case)
-           (wl-user-agent-insert-body
-            (cdr (wl-string-match-assoc
-                  "body"
-                  wl-user-agent-headers-and-body-alist 'ignore-case)))))
+       (let ((body (wl-string-match-assoc "\\`body\\'"
+                                          wl-user-agent-headers-and-body-alist
+                                          'ignore-case)))
+         (if body
+             (wl-user-agent-insert-body (cdr body)))))
     t))
 
 (defun wl-draft-setup-parent-flag (flag)
@@ -2643,7 +2612,7 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
 (defun wl-draft-buffer-change-number (old-number new-number)
   (when (eq wl-draft-buffer-message-number old-number)
     (setq wl-draft-buffer-message-number new-number)
-    (rename-buffer (format "%s/%d" wl-draft-folder new-number))
+    (rename-buffer (format "%s/%d" wl-draft-folder new-number) t)
     (setq buffer-file-name (buffer-name))
     (set-buffer-modified-p nil)))