* wl-summary.el (wl-summary-forward): Put subject in original
[elisp/wanderlust.git] / wl / wl-draft.el
index ae93ac0..5d5e661 100644 (file)
@@ -44,6 +44,7 @@
 (defvar mail-from-style)
 
 (eval-when-compile
+  (require 'cl)
   (require 'static)
   (require 'elmo-pop3)
   (defalias-maybe 'x-face-insert 'ignore)
@@ -91,10 +92,12 @@ e.g.
          (\"From\" . \"user@domain2\"))))")
 
 (defvar wl-draft-parent-number nil)
+(defvar wl-draft-parent-flag nil)
 
-(defconst wl-draft-reply-saved-variables
+(defconst wl-draft-parent-variables
   '(wl-draft-parent-folder
-    wl-draft-parent-number))
+    wl-draft-parent-number
+    wl-draft-parent-flag))
 
 (defvar wl-draft-config-sub-func-alist
   '((body              . wl-draft-config-sub-body)
@@ -122,6 +125,7 @@ e.g.
 (make-variable-buffer-local 'wl-draft-reply-buffer)
 (make-variable-buffer-local 'wl-draft-parent-folder)
 (make-variable-buffer-local 'wl-draft-parent-number)
+(make-variable-buffer-local 'wl-draft-parent-flag)
 
 (defvar wl-draft-folder-internal nil
   "Internal variable for caching `opened' draft folder.")
@@ -270,11 +274,17 @@ e.g.
                  wl-subject-re-prefix-regexp)))
        (t original-subject)))
 
-(defun wl-draft-forward (original-subject summary-buf)
+(defun wl-draft-forward (original-subject summary-buf &optional number)
   (let (references parent-folder subject)
     (with-current-buffer summary-buf
       (setq parent-folder (wl-summary-buffer-folder-name)))
-    (setq subject (wl-draft-forward-make-subject original-subject))
+    (with-temp-buffer                  ; to keep raw buffer unibyte.
+      (set-buffer-multibyte default-enable-multibyte-characters)
+      (let ((decoder (mime-find-field-decoder 'Subject 'plain)))
+       (setq subject (wl-draft-reply-make-subject
+                      (if (and original-subject decoder)
+                          (funcall decoder original-subject) original-subject)))))
+    (setq subject (wl-draft-forward-make-subject subject))
     (with-current-buffer (wl-message-get-original-buffer)
       (setq references (nconc
                        (std11-field-bodies '("References" "In-Reply-To"))
@@ -292,9 +302,15 @@ e.g.
                    (cons 'Subject subject)
                    (cons 'References references))
              nil nil nil nil parent-folder))
+  (setq wl-draft-parent-number number)
   (goto-char (point-max))
   (wl-draft-insert-message)
-  (mail-position-on-field "To"))
+  (mail-position-on-field "To")
+  (setq wl-draft-config-variables
+       (append wl-draft-parent-variables
+               wl-draft-config-variables))
+  (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
+  (run-hooks 'wl-draft-forward-hook))
 
 (defun wl-draft-self-reply-p ()
   "Return t when From address in the current message is user's self one or not."
@@ -459,9 +475,10 @@ Reply to author if WITH-ARG is non-nil."
     (setq wl-draft-parent-number number)
     (setq wl-draft-reply-buffer buf)
     (setq wl-draft-config-variables
-         (append wl-draft-reply-saved-variables
-                 wl-draft-config-variables)))
-  (run-hooks 'wl-reply-hook))
+         (append wl-draft-parent-variables
+                 wl-draft-config-variables))
+    (wl-draft-config-info-operation wl-draft-buffer-message-number 'save))
+  (run-hooks 'wl-draft-reply-hook))
 
 (defun wl-draft-reply-position (position)
   (cond ((eq position 'body)
@@ -771,23 +788,7 @@ Reply to author if WITH-ARG is non-nil."
               (or force-kill
                   (yes-or-no-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-unset-flag folder (list number) 'answered)
-                 (when (wl-summary-jump-to-msg number)
-                   (wl-summary-update-persistent-mark)))
-             (elmo-folder-open folder 'load-msgdb)
-             (elmo-folder-unset-flag folder (list number) 'answered)
-             (elmo-folder-close folder))))
+       (run-hooks 'wl-draft-kill-pre-hook)
        (wl-draft-hide cur-buf)
        (wl-draft-delete cur-buf)))
     (message "")))
@@ -1175,7 +1176,7 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
                  (re-search-forward "\n[ \t]*\n\n*" nil t))
       (replace-match "\n"))
     (goto-char (point-min))
-    (while (re-search-forward 
+    (while (re-search-forward
            "^[^ \t\n:]+:[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n"
            nil t)
       (when (string= "" (match-string 1))
@@ -1321,8 +1322,9 @@ This variable is valid when `wl-interactive-send' has non-nil value."
                     (t
                      (throw 'done nil)))))))
          (quit nil))
-      (when wl-draft-send-confirm-with-preview
-       (mime-preview-quit)))))
+      (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.
@@ -1340,6 +1342,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                           " *wl-draft-sending-buffer*"
                           (append wl-draft-config-variables
                                   (wl-draft-clone-local-variables))))
+         (parent-flag wl-draft-parent-flag)
+         (parent-number wl-draft-parent-number)
+         (parent-folder wl-draft-parent-folder)
          (wl-draft-verbose-msg nil)
          err)
       (unwind-protect
@@ -1360,6 +1365,14 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
            ;;
            (if wl-draft-verbose-send
                (message "%s" (or mes-string "Sending...")))
+           ;; Set flag before send-function because
+           ;; there's no need to change current mailbox at this time.
+           ;; If flag is set after send-function, the current mailbox
+           ;; might changed by Fcc.
+           ;; It causes a huge loss in the IMAP folder.
+           (when (and parent-flag parent-number parent-folder)
+             (wl-folder-set-persistent-mark
+              parent-folder parent-number parent-flag))
            (funcall wl-draft-send-function editing-buffer kill-when-done)
            ;; Now perform actions on successful sending.
            (while mail-send-actions
@@ -1444,7 +1457,11 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                (insert (if (eq (char-before) ?\n) "" "\n")
                        mail-header-separator "\n")))
            (let ((mime-header-encode-method-alist
-                  '((eword-encode-unstructured-field-body))))
+                  (append
+                   '((eword-encode-unstructured-field-body
+                      .  (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From)))
+                   (if (boundp 'mime-header-encode-method-alist)
+                       (symbol-value 'mime-header-encode-method-alist)))))
              (mime-edit-translate-buffer))
            (wl-draft-get-header-delimiter t)
            (setq next-number
@@ -1580,14 +1597,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
       (goto-char (point-max))
       (insert-buffer-substring send-mail-buffer header-end)
       (let ((id (std11-field-body "Message-ID"))
-           (elmo-enable-disconnected-operation t)
-           cache-saved)
+           (elmo-enable-disconnected-operation t))
        (while fcc-list
-         (unless (or cache-saved
-                     (elmo-folder-plugged-p
-                      (wl-folder-get-elmo-folder (car fcc-list))))
-           (elmo-file-cache-save id nil) ;; for disconnected operation
-           (setq cache-saved t))
          (if (elmo-folder-append-buffer
               (wl-folder-get-elmo-folder
                (eword-decode-string (car fcc-list)))
@@ -1640,7 +1651,7 @@ 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)
   (let (buffer header-alist-internal)
     (setq buffer (wl-draft-create-buffer parent-folder))
     (unless (cdr (assq 'From header-alist))
@@ -1694,8 +1705,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
              (eq this-command 'wl-summary-forward)
              (eq this-command 'wl-summary-target-mark-forward)
              (eq this-command 'wl-summary-target-mark-reply-with-citation)))
-        (buffer (generate-new-buffer "*draft*")) ; Just for initial name.
-        change-major-mode-hook)
+        (buffer (generate-new-buffer "*draft*"))) ; Just for initial name.
     (set-buffer buffer)
     ;; switch-buffer according to draft buffer style.
     (if wl-draft-use-frame
@@ -1731,7 +1741,8 @@ 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"))))))
     (auto-save-mode -1)
-    (wl-draft-mode)
+    (let (change-major-mode-hook)
+      (wl-draft-mode))
     (set-buffer-multibyte t)           ; draft buffer is always multibyte.
     (make-local-variable 'truncate-partial-width-windows)
     (setq truncate-partial-width-windows nil)
@@ -2627,6 +2638,13 @@ been implemented yet.  Partial support for SWITCH-FUNCTION now supported."
                   wl-user-agent-headers-and-body-alist 'ignore-case)))))
     t))
 
+(defun wl-draft-setup-parent-flag (flag)
+  "Setup a FLAG for parent message."
+  (when (and (> (length wl-draft-parent-folder) 0)
+            wl-draft-parent-number)
+    (setq wl-draft-parent-flag flag)
+    (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)))
+
 (require 'product)
 (product-provide (provide 'wl-draft) (require 'wl-version))