X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=ea773a2f481a50ad8dc99f3154ab4cacd13d6777;hb=9d6cb38e87c7636fb0036b94ff4252ed3dee49f1;hp=ed9c352283e1bd266ac8711d693e051893ddf878;hpb=86a94b48a6752fb8dc639f44492346aecac07502;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index ed9c352..ea773a2 100644
--- a/wl/wl-draft.el
+++ b/wl/wl-draft.el
@@ -73,9 +73,20 @@
 (defvar wl-draft-reedit nil)
 (defvar wl-draft-reply-buffer nil)
 (defvar wl-draft-forward nil)
-(defvar wl-draft-parent-folder nil)
 (defvar wl-draft-doing-mime-bcc nil)
 
+(defvar wl-draft-parent-folder nil
+  "Folder name of the summary in which current draft is invoked.
+This variable is local in each draft buffer.
+You can refer its value in `wl-draft-config-alist'.
+
+e.g.
+\(setq wl-draft-config-alist
+      '(((string-match \".*@domain1$\" wl-draft-parent-folder)
+         (\"From\" . \"user@domain1\"))
+        ((string-match \".*@domain2$\" wl-draft-parent-folder)
+         (\"From\" . \"user@domain2\"))))")
+
 (defvar wl-draft-config-sub-func-alist
   '((body		. wl-draft-config-sub-body)
     (top		. wl-draft-config-sub-top)
@@ -284,6 +295,9 @@
 	    references (wl-delete-duplicates references)
 	    references (when references
 			 (mapconcat 'identity references "\n\t"))))
+    (and wl-draft-use-frame
+	 (get-buffer-window summary-buf)
+	 (select-window (get-buffer-window summary-buf)))
     (wl-draft (list (cons 'To "")
 		    (cons 'Subject
 			  (concat wl-forward-subject-prefix original-subject))
@@ -317,9 +331,10 @@ Reply to author if WITH-ARG is non-nil."
   (let (r-list
 	to mail-followup-to cc subject in-reply-to references newsgroups
 	to-alist cc-alist decoder parent-folder)
-    (set-buffer summary-buf)
-    (setq parent-folder (wl-summary-buffer-folder-name))
-    (set-buffer buf)
+    (when (buffer-live-p summary-buf)
+      (with-current-buffer summary-buf
+	(setq parent-folder (wl-summary-buffer-folder-name))))
+    (set-buffer (or buf mime-mother-buffer))
     (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
     (catch 'done
       (while r-list
@@ -449,6 +464,9 @@ Reply to author if WITH-ARG is non-nil."
 	  references (wl-delete-duplicates references)
 	  references (if references
 			 (mapconcat 'identity references "\n\t")))
+    (and wl-draft-use-frame
+	 (get-buffer-window summary-buf)
+	 (select-window (get-buffer-window summary-buf)))
     (wl-draft (list (cons 'To to)
 		    (cons 'Cc cc)
 		    (cons 'Newsgroups newsgroups)
@@ -600,10 +618,12 @@ Reply to author if WITH-ARG is non-nil."
 		   content-type content-transfer-encoding
 		   (buffer-substring (point) (point-max))
 		   'edit-again))
-      (and to (mail-position-on-field "To"))
-      (delete-other-windows)
-      (kill-buffer tmp-buf)))
-  (run-hooks 'wl-draft-reedit-hook))
+      (kill-buffer tmp-buf))
+    ;; Set cursor point to the top.
+    (goto-char (point-min))
+    (search-forward (concat mail-header-separator "\n") nil t)
+    (run-hooks 'wl-draft-reedit-hook)
+    (and to (mail-position-on-field "To"))))
 
 (defun wl-draft-insert-current-message (dummy)
   (interactive)
@@ -715,23 +735,23 @@ Reply to author if WITH-ARG is non-nil."
 	  (delete-frame)
 	;; hide draft window
 	(or (one-window-p)
-	    (delete-window)))
-      ;; stay folder window if required
-      (when wl-stay-folder-window
-	(if (setq fld-buf (get-buffer wl-folder-buffer-name))
-	    (if (setq fld-win (get-buffer-window fld-buf))
-		(select-window fld-win)
-	      (if wl-draft-resume-folder-window ;; resume folder window
-		  (switch-to-buffer fld-buf)))))
-      (if (buffer-live-p sum-buf)
-	  (if (setq sum-win (get-buffer-window sum-buf t))
-	      ;; if Summary is on the frame, select it.
-	      (select-window sum-win)
-	    ;; if summary is not on the frame, switch to it.
-	    (if (and wl-stay-folder-window
-		     (or wl-draft-resume-folder-window fld-win))
-		(wl-folder-select-buffer sum-buf)
-	      (switch-to-buffer sum-buf)))))))
+	    (delete-window))
+	;; stay folder window if required
+	(when wl-stay-folder-window
+	  (if (setq fld-buf (get-buffer wl-folder-buffer-name))
+	      (if (setq fld-win (get-buffer-window fld-buf))
+		  (select-window fld-win)
+		(if wl-draft-resume-folder-window ;; resume folder window
+		    (switch-to-buffer fld-buf)))))
+	(if (buffer-live-p sum-buf)
+	    (if (setq sum-win (get-buffer-window sum-buf t))
+		;; if Summary is on the frame, select it.
+		(select-window sum-win)
+	      ;; if summary is not on the frame, switch to it.
+	      (if (and wl-stay-folder-window
+		       (or wl-draft-resume-folder-window fld-win))
+		  (wl-folder-select-buffer sum-buf)
+		(switch-to-buffer sum-buf))))))))
 
 (defun wl-draft-delete (editing-buffer)
   "kill the editing draft buffer and delete the file corresponds to it."
@@ -1535,13 +1555,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 
   (let (buf-name header-alist-internal)
     (setq buf-name
-	  (wl-draft-create-buffer
-	   (or
-	    (eq this-command 'wl-draft)
-	    (eq this-command 'wl-summary-write)
-	    (eq this-command 'wl-summary-write-current-folder)
-	    (eq this-command 'wl-folder-write-current-folder))
-	   parent-folder))
+	  (wl-draft-create-buffer parent-folder))
 
     (unless (cdr (assq 'From header-alist))
       (setq header-alist
@@ -1583,11 +1597,16 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	   (goto-char (point-max))))
     buf-name))
 
-(defun wl-draft-create-buffer (&optional full parent-folder)
+(defun wl-draft-create-buffer (&optional parent-folder)
   (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 	 (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
 	 (summary-buf (wl-summary-get-buffer parent-folder))
-	buf-name file-name num change-major-mode-hook)
+	 (reply-or-forward
+	  (or (eq this-command 'wl-summary-reply)
+	      (eq this-command 'wl-summary-forward)
+	      (eq this-command 'wl-summary-target-mark-forward)
+	      (eq this-command 'wl-summary-target-mark-reply-with-citation)))
+	 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
@@ -1601,16 +1620,43 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 			  (elmo-message-file-name
 			   (wl-folder-get-elmo-folder wl-draft-folder)
 			   num))))
+    ;; switch-buffer according to draft buffer style.
     (if wl-draft-use-frame
 	(switch-to-buffer-other-frame buf-name)
-      (switch-to-buffer buf-name))
+      (if reply-or-forward
+	  (case wl-draft-reply-buffer-style
+	    (split
+	     (split-window-vertically)
+	     (other-window 1)
+	     (switch-to-buffer buf-name))
+	    (keep
+	     (switch-to-buffer buf-name))
+	    (full
+	     (delete-other-windows)
+	     (switch-to-buffer buf-name))
+	    (t
+	     (if (functionp wl-draft-reply-buffer-style)
+		 (funcall wl-draft-reply-buffer-style buf-name)
+	       (error "Invalid value for wl-draft-reply-buffer-style"))))
+	(case wl-draft-buffer-style
+	  (split
+	   (when (eq major-mode 'wl-summary-mode)
+	     (wl-summary-toggle-disp-msg 'off))
+	   (split-window-vertically)
+	   (other-window 1)
+	   (switch-to-buffer buf-name))
+	  (keep
+	   (switch-to-buffer buf-name))
+	  (full
+	   (delete-other-windows)
+	   (switch-to-buffer buf-name))
+	  (t (if (functionp wl-draft-buffer-style)
+		 (funcall wl-draft-buffer-style buf-name)
+	       (error "Invalid value for wl-draft-buffer-style"))))))
     (set-buffer buf-name)
     (if (not (string-match (regexp-quote wl-draft-folder)
 			   (buffer-name)))
 	(rename-buffer (concat wl-draft-folder "/" (int-to-string num))))
-    (if (or (eq wl-draft-reply-buffer-style 'full)
-	    full)
-	(delete-other-windows))
     (auto-save-mode -1)
     (wl-draft-mode)
     (make-local-variable 'truncate-partial-width-windows)
@@ -1675,7 +1721,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
     (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)
+    (when wl-draft-write-file-function
+      (add-hook 'local-write-file-hooks wl-draft-write-file-function))
     (wl-draft-overload-functions)
     (wl-highlight-headers 'for-draft)
     (wl-draft-save)
@@ -1773,7 +1820,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 		       (progn
 			 (insert mail-header-separator "\n")
 			 (1- (point)))
-		       'category 'mail-header-separator)))
+		       'category 'mail-header-separator)
+    (point)))
 
 ;;;;;;;;;;;;;;;;
 
@@ -1831,10 +1879,15 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	(setq local-variables (cdr local-variables)))
       (current-buffer))))
 
+(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)))))
+
 (defun wl-draft-reedit (number)
   (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 	(wl-draft-reedit t)
-	buffer file-name change-major-mode-hook)
+	buffer file-name change-major-mode-hook body-top)
     (setq file-name (elmo-message-file-name draft-folder number))
     (unless (file-exists-p file-name)
       (error "File %s does not exist" file-name))
@@ -1847,15 +1900,28 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	    (switch-to-buffer buffer))
 	  (set-buffer buffer))
       (setq buffer (get-buffer-create (number-to-string number)))
+      ;; switch-buffer according to draft buffer style.
       (if wl-draft-use-frame
 	  (switch-to-buffer-other-frame buffer)
-	(switch-to-buffer buffer))
+	(case wl-draft-buffer-style
+	  (split
+	   (split-window-vertically)
+	   (other-window 1)
+	   (switch-to-buffer buffer))
+	  (keep
+	   (switch-to-buffer buffer))
+	  (full
+	   (delete-other-windows)
+	   (switch-to-buffer buffer))
+	  (t (if (functionp wl-draft-buffer-style)
+		 (funcall wl-draft-buffer-style buffer)
+	       (error "Invalid value for wl-draft-buffer-style")))))
       (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)
+      (setq body-top (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))))
@@ -1872,8 +1938,10 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
       (goto-char (point-min))
       (wl-draft-overload-functions)
       (wl-draft-editor-mode)
-      (add-hook 'local-write-file-hooks 'wl-draft-save)
+      (when wl-draft-write-file-function
+	(add-hook 'local-write-file-hooks wl-draft-write-file-function))
       (wl-highlight-headers 'for-draft)
+      (goto-char body-top)
       (run-hooks 'wl-draft-reedit-hook)
       (goto-char (point-max))
       buffer)))
@@ -1895,34 +1963,41 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 	   (beginning-of-line)
 	 (goto-char (point-max))))))
 
+(defsubst wl-draft-config-sub-eval-insert (content &optional newline)
+  (let (content-value)
+    (when (and content
+	       (stringp (setq content-value (eval content))))
+      (insert content-value)
+      (if newline (insert "\n")))))
+
 (defun wl-draft-config-sub-body (content)
   (wl-draft-body-goto-top)
   (delete-region (point) (point-max))
-  (if content (insert (eval content))))
+  (wl-draft-config-sub-eval-insert content))
 
 (defun wl-draft-config-sub-top (content)
   (wl-draft-body-goto-top)
-  (if content (insert (eval content))))
+  (wl-draft-config-sub-eval-insert content))
 
 (defun wl-draft-config-sub-bottom (content)
   (wl-draft-body-goto-bottom)
-  (if content (insert (eval content))))
+  (wl-draft-config-sub-eval-insert content))
 
 (defun wl-draft-config-sub-header (content)
   (wl-draft-config-body-goto-header)
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defun wl-draft-config-sub-header-top (content)
   (goto-char (point-min))
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defun wl-draft-config-sub-part-top (content)
   (goto-char (mime-edit-content-beginning))
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defun wl-draft-config-sub-part-bottom (content)
   (goto-char (mime-edit-content-end))
-  (if content (insert (concat (eval content) "\n"))))
+  (wl-draft-config-sub-eval-insert content 'newline))
 
 (defsubst wl-draft-config-sub-file (content)
   (let ((coding-system-for-read wl-cs-autoconv)
@@ -2280,11 +2355,13 @@ Automatically applied in draft sending time."
 
 (defun wl-draft-highlight-and-recenter (&optional n)
   (interactive "P")
-  (if wl-highlight-body-too
-      (let ((beg (point-min))
-	    (end (point-max)))
-	(put-text-property beg end 'face nil)
-	(wl-highlight-message beg end t)))
+  (when wl-highlight-body-too
+    (let ((modified (buffer-modified-p)))
+      (unwind-protect
+	  (progn
+	    (put-text-property (point-min) (point-max) 'face nil)
+	    (wl-highlight-message (point-min) (point-max) t))
+	(set-buffer-modified-p modified))))
   (recenter n))
 
 ;;;; user-agent support by Sen Nagata
@@ -2336,16 +2413,13 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
 
   (unless (featurep 'wl)
     (require 'wl))
+  (or switch-function
+      (setq switch-function 'keep))
   ;; 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))
-    (when (eq switch-function 'switch-to-buffer-other-window)
-      (when (one-window-p t)
-	(if (window-minibuffer-p) (other-window 1))
-	(split-window))
-      (other-window 1))
+	(wl-draft-buffer-style switch-function))
     (if to
 	(if (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
 				   'ignore-case)