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

diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index f8b2c92..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"
@@ -150,18 +157,15 @@ e.g.
   "Insert Date field."
   (insert "Date: " (wl-make-date-string) "\n"))
 
-(defun wl-draft-check-wl-from ()
-  (or wl-from (error "Please set `wl-from' to your mail address"))
-  (condition-case err
-      (wl-draft-eword-encode-address-list wl-from)
-    (error (error "Please look at `wl-from' again"))))
-
 (defun wl-draft-insert-from-field ()
   "Insert From field."
   ;; Put the "From:" field in unless for some odd reason
   ;; they put one in themselves.
-  (wl-draft-check-wl-from)
-  (insert "From: " wl-from "\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."
@@ -283,7 +287,7 @@ 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-reply (buf with-arg summary-buf)
+(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
@@ -332,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))
@@ -442,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)
@@ -658,31 +666,20 @@ 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.")
@@ -699,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)
@@ -762,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 "")))
@@ -1075,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
@@ -1131,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
@@ -1152,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
@@ -1210,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)
@@ -1240,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"
@@ -1249,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
@@ -1269,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
@@ -1294,9 +1356,10 @@ 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))))))
@@ -1501,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)))))
@@ -1581,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)
@@ -1596,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)))
@@ -1873,7 +1938,7 @@ 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."
-  (when (string= (mime-create-tag "text" "plain")
+  (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)))))
 
@@ -1910,6 +1975,7 @@ 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
@@ -2224,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))