X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=8c5a236d74ad28604748f3a84792355e0a1e7642;hb=bd1c7daca8de303dd5766cb7831e964cfe3a03c5;hp=adeb247544b7b69fe19b15ee92331d1a4a12037d;hpb=11a0b35d8be2879888e135b4e00f6ca131e07d73;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index adeb247..8c5a236 100644
--- a/wl/wl-draft.el
+++ b/wl/wl-draft.el
@@ -87,6 +87,12 @@ e.g.
         ((string-match \".*@domain2$\" wl-draft-parent-folder)
          (\"From\" . \"user@domain2\"))))")
 
+(defvar wl-draft-parent-number nil)
+
+(defconst wl-draft-reply-saved-variables
+  '(wl-draft-parent-folder
+    wl-draft-parent-number))
+
 (defvar wl-draft-config-sub-func-alist
   '((body		. wl-draft-config-sub-body)
     (top		. wl-draft-config-sub-top)
@@ -112,6 +118,7 @@ e.g.
 (make-variable-buffer-local 'wl-draft-fcc-list)
 (make-variable-buffer-local 'wl-draft-reply-buffer)
 (make-variable-buffer-local 'wl-draft-parent-folder)
+(make-variable-buffer-local 'wl-draft-parent-number)
 
 (defsubst wl-smtp-password-key (user mechanism server)
   (format "SMTP:%s/%s@%s"
@@ -154,48 +161,11 @@ e.g.
   "Insert From field."
   ;; Put the "From:" field in unless for some odd reason
   ;; they put one in themselves.
-  (let* ((login (or user-mail-address (user-login-name)))
-	 (fullname (user-full-name)))
-    (cond ((eq mail-from-style 'angles)
-	   (insert "From: " fullname)
-	   (let ((fullname-start (+ (point-min) (length "From: ")))
-		 (fullname-end (point-marker)))
-	     (goto-char fullname-start)
-	     ;; Look for a character that cannot appear unquoted
-	     ;; according to RFC 822.
-	     (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
-				    fullname-end 1)
-		 (progn
-		   ;; Quote fullname, escaping specials.
-		   (goto-char fullname-start)
-		   (insert "\"")
-		   (while (re-search-forward "[\"\\]"
-					     fullname-end 1)
-		     (replace-match "\\\\\\&" t))
-		   (insert "\""))))
-	   (insert " <" login ">\n"))
-	  ((eq mail-from-style 'parens)
-	   (insert "From: " login " (")
-	   (let ((fullname-start (point)))
-	     (insert fullname)
-	     (let ((fullname-end (point-marker)))
-	       (goto-char fullname-start)
-	       ;; RFC 822 says \ and nonmatching parentheses
-	       ;; must be escaped in comments.
-	       ;; Escape every instance of ()\ ...
-	       (while (re-search-forward "[()\\]" fullname-end 1)
-		 (replace-match "\\\\\\&" t))
-	       ;; ... then undo escaping of matching parentheses,
-	       ;; including matching nested parentheses.
-	       (goto-char fullname-start)
-	       (while (re-search-forward
-		       "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
-		       fullname-end 1)
-		 (replace-match "\\1(\\3)" t)
-		 (goto-char fullname-start))))
-	   (insert ")\n"))
-	  ((not mail-from-style)
-	   (insert "From: " login "\n")))))
+  (let (from)
+    (condition-case err
+	(setq from (wl-draft-eword-encode-address-list wl-from))
+      (error (error "Please look at `wl-from' again")))
+    (insert "From: " from "\n")))
 
 (defun wl-draft-insert-x-face-field ()
   "Insert X-Face header."
@@ -308,23 +278,16 @@ e.g.
   (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 string. Shamelessly copied from Gnus."
   (if (string-match wl-subject-prefix-regexp subject)
       (substring subject (match-end 0))
     subject))
 
-(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 with-arg
-	  'wl-draft-reply-myself-with-argument-list
-	'wl-draft-reply-myself-without-argument-list)
-    (if with-arg
-	'wl-draft-reply-with-argument-list
-      'wl-draft-reply-without-argument-list)))
-
-(defun wl-draft-reply (buf with-arg summary-buf)
+(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 (buf with-arg summary-buf &optional number)
   "Reply to BUF buffer message.
 Reply to author if WITH-ARG is non-nil."
 ;;;(save-excursion
@@ -335,7 +298,8 @@ Reply to author if WITH-ARG is non-nil."
       (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)))
+    (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))))
@@ -344,8 +308,15 @@ Reply to author if WITH-ARG is non-nil."
 		      ((listp condition)
 		       (catch 'done
 			 (while condition
-			   (if (not (std11-field-body (car condition)))
-			       (throw 'done nil))
+			   (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)
@@ -365,7 +336,7 @@ Reply to author if WITH-ARG is non-nil."
 					      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 (funcall r-cc-list) ","))
 	      (setq cc (wl-concat-list (cons cc
 					     (elmo-multiple-fields-body-list
 					      r-cc-list))
@@ -378,8 +349,8 @@ Reply to author if WITH-ARG is non-nil."
 					       ","))))
 	  (throw 'done nil))
 	(setq r-list (cdr r-list)))
-      (error "No match field: check your `%s'"
-	     (symbol-name (wl-draft-reply-list-symbol with-arg))))
+      (error "No match field: check your `wl-draft-reply-%s-argument-list'"
+	     (if with-arg "with" "without")))
     (setq subject (std11-field-body "Subject"))
     (setq to (wl-parse-addresses to)
 	  cc (wl-parse-addresses cc))
@@ -475,8 +446,12 @@ Reply to author if WITH-ARG is non-nil."
 		    (cons 'References references)
 		    (cons 'Mail-Followup-To mail-followup-to))
 	      nil nil nil nil parent-folder)
+    (setq wl-draft-parent-number number)
     (setq wl-draft-reply-buffer buf)
-    (run-hooks 'wl-reply-hook)))
+    (setq wl-draft-config-variables
+	  (append wl-draft-reply-saved-variables
+		  wl-draft-config-variables)))
+  (run-hooks 'wl-reply-hook))
 
 (defun wl-draft-reply-position (position)
   (cond ((eq position 'body)
@@ -691,34 +666,23 @@ Reply to author if WITH-ARG is non-nil."
 (defun wl-default-draft-cite ()
   (let ((mail-yank-ignored-headers "[^:]+:")
 	(mail-yank-prefix "> ")
-	(summary-buf wl-current-summary-buffer)
-	(message-buf (get-buffer (wl-current-message-buffer)))
-	from date cite-title num entity)
-    (if (and summary-buf
-	     (buffer-live-p summary-buf)
-	     message-buf
-	     (buffer-live-p message-buf))
-	(progn
-	  (with-current-buffer summary-buf
-	    (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")
-				   (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"))
+	date from cite-title)
+    (save-restriction
+      (if (< (mark t) (point))
+	  (exchange-point-and-mark))
+      (narrow-to-region (point)(point-max))
+      (setq date (std11-field-body "date")
+	    from (std11-field-body "from")))
+    (when (or date from)
+      (insert (format "At %s,\n%s wrote:\n"
+		      (or date "some time ago")
+		      (if wl-default-draft-cite-decorate-author
+			  (funcall wl-summary-from-function
+				   (or from "you"))
+			(or from "you")))))
     (mail-indent-citation)))
 
-(defvar wl-draft-buffer nil "Draft buffer to yank content")
+(defvar wl-draft-buffer nil "Draft buffer to yank content.")
 (defun wl-draft-yank-to-draft-buffer (buffer)
   "Yank BUFFER content to `wl-draft-buffer'."
   (set-buffer wl-draft-buffer)
@@ -732,6 +696,7 @@ Reply to author if WITH-ARG is non-nil."
   (if arg
       (let (buf mail-reply-buffer)
 	(elmo-set-work-buf
+	 (insert "\n")
 	 (yank)
 	 (setq buf (current-buffer)))
 	(setq mail-reply-buffer buf)
@@ -770,7 +735,7 @@ Reply to author if WITH-ARG is non-nil."
 		(switch-to-buffer sum-buf))))))))
 
 (defun wl-draft-delete (editing-buffer)
-  "kill the editing draft buffer and delete the file corresponds to it."
+  "Kill the editing draft buffer and delete the file corresponds to it."
   (save-excursion
     (when editing-buffer
       (set-buffer editing-buffer)
@@ -795,6 +760,23 @@ Reply to author if WITH-ARG is non-nil."
 	       (or force-kill
 		   (y-or-n-p "Kill Current Draft? ")))
       (let ((cur-buf (current-buffer)))
+	(when (and wl-draft-parent-number
+		   (not (string= wl-draft-parent-folder "")))
+	  (let* ((number wl-draft-parent-number)
+		 (folder-name wl-draft-parent-folder)
+		 (folder (wl-folder-get-elmo-folder folder-name))
+		 buffer)
+	    (if (and (setq buffer (wl-summary-get-buffer folder-name))
+		     (with-current-buffer buffer
+		       (string= (wl-summary-buffer-folder-name)
+				folder-name)))
+		(with-current-buffer buffer
+		  (elmo-folder-unmark-answered folder (list number))
+		  (when (wl-summary-jump-to-msg number)
+		    (wl-summary-update-persistent-mark)))
+	      (elmo-folder-open folder 'load-msgdb)
+	      (elmo-folder-unmark-answered folder (list number))
+	      (elmo-folder-close folder))))
 	(wl-draft-hide cur-buf)
 	(wl-draft-delete cur-buf)))
     (message "")))
@@ -1108,6 +1090,10 @@ non-nil."
 			   smtp-sasl-user-name
 			   (car smtp-sasl-mechanisms)
 			   smtp-server)))
+		     (signal (car err) (cdr err)))
+		    (quit
+		     (wl-draft-write-sendlog 'uncertain 'smtp smtp-server
+					     recipients id)
 		     (signal (car err) (cdr err)))))
 		 (wl-draft-set-sent-message 'mail 'sent)
 		 (wl-draft-write-sendlog
@@ -1164,15 +1150,24 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
 (defun wl-draft-normal-send-func (editing-buffer kill-when-done)
   "Send the message in the current buffer."
   (save-restriction
-    (std11-narrow-to-header mail-header-separator)
+    (narrow-to-region (goto-char (point-min))
+		      (if (re-search-forward
+			   (concat
+			    "^" (regexp-quote mail-header-separator) "$")
+			   nil t)
+			  (match-beginning 0)
+			(point-max)))
     (wl-draft-insert-required-fields)
-    ;; Delete null fields.
-    (goto-char (point-min))
-    (while (re-search-forward "^[^ \t\n:]+:[ \t]*\n" nil t)
-      (replace-match ""))
     ;; ignore any blank lines in the header
-    (while (re-search-forward "\n\n\n*" nil t)
-      (replace-match "\n")))
+    (while (progn (goto-char (point-min))
+		  (re-search-forward "\n[ \t]*\n\n*" nil t))
+      (replace-match "\n"))
+    (goto-char (point-min))
+    (while (re-search-forward 
+	    "^[^ \t\n:]+:[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n"
+	    nil t)
+      (when (string= "" (match-string 1))
+	(replace-match ""))))
 ;;;  (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
   (wl-draft-dispatch-message)
   (when kill-when-done
@@ -1185,7 +1180,7 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
   "Send the message in the current buffer.  Not modified the header fields."
   (let (delimline mime-bcc)
     (if (and wl-draft-verbose-send mes-string)
-	(message mes-string))
+	(message "%s" mes-string))
     ;; get fcc folders.
     (setq delimline (wl-draft-get-header-delimiter t))
     (unless wl-draft-fcc-list
@@ -1243,10 +1238,11 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
 		(setq wl-draft-verbose-msg
 		      (format "Sending%s and Queuing%s..."
 			      sent-via unplugged-via))
-		(message (concat wl-draft-verbose-msg "done")))
+		(message "%sdone" wl-draft-verbose-msg))
 	    (if mes-string
-		(message (concat mes-string
-				 (if sent-via "done" "failed")))))))))
+		(message "%s%s"
+			 mes-string
+			 (if sent-via "done" "failed"))))))))
   (not wl-sent-message-modified)) ;; return value
 
 (defun wl-draft-raw-send (&optional kill-when-done force-pre-hook mes-string)
@@ -1273,6 +1269,48 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
       (setq locals (cdr locals)))
     result))
 
+(defcustom wl-draft-send-confirm-with-preview t
+  "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
+		    (message "Send current draft? <y/n/j(down)/k(up)> ")
+		    (setq answer (let ((cursor-in-echo-area t)) (read-char)))
+		    (cond
+		     ((or (eq answer ?y)
+			  (eq answer ?Y)
+			  (eq answer ? ))
+		  (throw 'done t))
+		     ((or (eq answer ?v)
+			  (eq answer ?j)
+			  (eq answer ?J))
+		      (condition-case err
+			  (scroll-up)
+			(error nil)))
+		     ((or (eq answer ?^)
+			  (eq answer ?k)
+			  (eq answer ?K))
+		      (condition-case err
+			  (scroll-down)
+			(error nil)))
+		     (t
+		      (throw 'done nil)))))))
+	  (quit nil))
+      (when wl-draft-send-confirm-with-preview
+	(mime-preview-quit)))))
+
 (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"
@@ -1282,17 +1320,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
   ;; (wl-draft-config-exec)
   (run-hooks 'wl-draft-send-hook)
   (when (or (not wl-interactive-send)
-	    (let (result)
-	      (wl-draft-preview-message)
-	      (goto-char (point-min))
-	      (condition-case nil
-		  (setq result
-			(y-or-n-p "Do you really want to send current draft? "))
-		(quit
-		 (mime-preview-quit)
-		 (signal 'quit nil)))
-	      (mime-preview-quit)
-	      result))
+	    (wl-draft-send-confirm))
     (let ((send-mail-function 'wl-draft-raw-send)
 	  (editing-buffer (current-buffer))
 	  (sending-buffer (wl-draft-generate-clone-buffer
@@ -1302,22 +1330,23 @@ 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)
+	  (save-excursion
+	    (set-buffer sending-buffer)
 	    (if (and (not (wl-message-mail-p))
 		     (not (wl-message-news-p)))
 		(error "No recipient is specified"))
-	    (expand-abbrev) ; for mail-abbrevs
+	    (expand-abbrev)		; for mail-abbrevs
 	    (let ((mime-header-encode-method-alist
 		   (append
 		    '((wl-draft-eword-encode-address-list
-		       .  (To Cc Bcc Resent-To Resent-Cc Bcc Resent-Bcc)))
+		       .  (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From)))
 		    (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...")))
+		(message "%s" (or mes-string "Sending...")))
 	    (funcall wl-draft-send-function editing-buffer kill-when-done)
 	    ;; Now perform actions on successful sending.
 	    (while mail-send-actions
@@ -1327,15 +1356,16 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		(error))
 	      (setq mail-send-actions (cdr mail-send-actions)))
 	    (if wl-draft-verbose-send
-		(message (concat (or wl-draft-verbose-msg
-				     mes-string "Sending...")
-				 "done"))))
+		(message "%sdone"
+			 (or wl-draft-verbose-msg
+			     mes-string
+			     "Sending..."))))
 	;; kill sending buffer, anyway.
 	(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."
+  "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)))
 
@@ -1534,7 +1564,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	  (if (elmo-folder-append-buffer
 	       (wl-folder-get-elmo-folder
 		(eword-decode-string (car fcc-list)))
-	       (not wl-fcc-force-as-read))
+	       (and wl-fcc-force-as-read '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)))))
@@ -1614,6 +1644,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (if (interactive-p)
 	(run-hooks 'wl-mail-setup-hook))
     (goto-char (point-min))
+    (setq buffer-undo-list nil)
     (wl-user-agent-compose-internal) ;; user-agent
     (cond ((and
 	    (interactive-p)
@@ -1629,6 +1660,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	 (summary-buf (wl-summary-get-buffer parent-folder))
 	 (reply-or-forward
 	  (or (eq this-command 'wl-summary-reply)
+	      (eq this-command 'wl-summary-reply-with-citation)
 	      (eq this-command 'wl-summary-forward)
 	      (eq this-command 'wl-summary-target-mark-forward)
 	      (eq this-command 'wl-summary-target-mark-reply-with-citation)))
@@ -1706,10 +1738,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                        ;;  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."))
+    (error "`wl-draft-create-header' must be use in wl-draft-mode"))
   (let ((halist header-alist)
 	field value)
     (while halist
@@ -1744,7 +1775,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 
 (defun wl-draft-prepare-edit ()
   (unless (eq major-mode 'wl-draft-mode)
-    (error "wl-draft-create-header must be use in wl-draft-mode."))
+    (error "`wl-draft-create-header' must be use in wl-draft-mode"))
   (let (change-major-mode-hook)
     (wl-draft-editor-mode)
     (when wl-draft-write-file-function
@@ -1874,7 +1905,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		 (cdar condition))
 	    (setq condition (cdr condition)))))
     (unless elmo-nntp-default-function
-      (error "wl-draft-nntp-send: posting-function is nil."))
+      (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
@@ -1907,8 +1938,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 
 (defun wl-draft-remove-text-plain-tag ()
   "Remove text/plain tag of mime-edit."
-  (if (looking-at "^--\\[\\[text/plain\\]\\]$")
-      (delete-region (point-at-bol)(1+ (point-at-eol)))))
+  (when (string= (mime-make-text-tag "plain")
+		 (buffer-substring-no-properties (point-at-bol)(point-at-eol)))
+    (delete-region (point-at-bol)(1+ (point-at-eol)))))
 
 (defun wl-draft-reedit (number)
   (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
@@ -1943,7 +1975,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		 (funcall wl-draft-buffer-style buffer)
 	       (error "Invalid value for wl-draft-buffer-style")))))
       (set-buffer buffer)
+      (setq wl-draft-parent-folder "")
       (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))
@@ -2256,7 +2290,7 @@ Automatically applied in draft sending time."
   (let ((send-buffer (current-buffer))
 	(folder (wl-folder-get-elmo-folder wl-queue-folder))
 	(message-id (std11-field-body "Message-ID")))
-    (if (elmo-folder-append-buffer folder t)
+    (if (elmo-folder-append-buffer folder)
 	(progn
 	  (wl-draft-queue-info-operation
 	   (car (elmo-folder-status folder))