* wl-draft.el (wl-draft-previous-history-element): New function.
[elisp/wanderlust.git] / wl / wl-draft.el
index bcf443a..6df2d19 100644 (file)
@@ -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"
@@ -280,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
@@ -439,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)
@@ -655,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.")
@@ -696,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)
@@ -705,8 +706,9 @@ Reply to author if WITH-ARG is non-nil."
 (defun wl-draft-hide (editing-buffer)
   "Hide the editing draft buffer if possible."
   (when (and editing-buffer
-            (buffer-live-p editing-buffer))
-    (set-buffer editing-buffer)
+            (buffer-live-p editing-buffer)
+            (get-buffer-window editing-buffer))
+    (select-window (get-buffer-window editing-buffer))
     (let ((sum-buf wl-draft-buffer-cur-summary-buffer)
          fld-buf sum-win fld-win)
       (if (and wl-draft-use-frame
@@ -759,6 +761,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 "")))
@@ -1132,15 +1151,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
@@ -1259,7 +1287,7 @@ This variable is valid when `wl-interactive-send' has non-nil value."
                (goto-char (point-min)) ; to show recipients in header
                (catch 'done
                  (while t
-                   (message "Send current draft? <y/n/j(up)/k(down)> ")
+                   (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)
@@ -1303,11 +1331,12 @@ 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
@@ -1507,6 +1536,11 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                         (progn (forward-line 1) (point)))))
       fcc-list)))
 
+(defcustom wl-draft-fcc-append-read-folder-hist t
+  "Non-nil to append fcc'ed folder to `wl-read-folder-hist'."
+  :type 'boolean
+  :group 'wl-draft)
+
 (defun wl-draft-do-fcc (header-end &optional fcc-list)
   (let ((send-mail-buffer (current-buffer))
        (tembuf (generate-new-buffer " fcc output"))
@@ -1536,9 +1570,14 @@ 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))
+         (if (and wl-draft-fcc-append-read-folder-hist
+                  (boundp 'wl-read-folder-hist))
+             (or (equal (car fcc-list) (car wl-read-folder-hist))
+                 (setq wl-read-folder-hist
+                       (append (list (car fcc-list)) wl-read-folder-hist))))
          (setq fcc-list (cdr fcc-list)))))
     (kill-buffer tembuf)))
 
@@ -1616,6 +1655,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)
@@ -1946,6 +1986,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
@@ -2260,7 +2301,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))
@@ -2394,6 +2435,80 @@ Automatically applied in draft sending time."
        (set-buffer-modified-p modified))))
   (recenter n))
 
+;; insert element from history
+(defvar wl-draft-current-history-position nil)
+(defvar wl-draft-history-backup-word "")
+
+(defun wl-draft-previous-history-element (n)
+  (interactive "p")
+  (let (bol history)
+    (when (and (not (wl-draft-on-field-p))
+              (< (point)
+                 (save-excursion
+                   (goto-char (point-min))
+                   (search-forward (concat "\n" mail-header-separator "\n") nil 0)
+                   (point)))
+              (save-excursion
+                (beginning-of-line)
+                (while (and (looking-at "^[ \t]")
+                            (not (= (point) (point-min))))
+                  (forward-line -1))
+                (cond
+                 ((looking-at wl-folder-complete-header-regexp)
+                  (and (boundp 'wl-read-folder-hist)
+                       (setq history wl-read-folder-hist)))
+                 ;; ((looking-at wl-address-complete-header-regexp)
+                 ;;  (setq history .....))
+                 (t
+                  nil)))
+              (eolp))
+      (setq bol (save-excursion (beginning-of-line) (point)))
+      (cond ((and (or (eq last-command 'wl-draft-previous-history-element)
+                     (eq last-command 'wl-draft-next-history-element))
+                 wl-draft-current-history-position)
+            (setq end (point))
+            (or (search-backward-regexp ",[ \t]*\\(.*\\)" bol t)
+                (search-backward-regexp "^[ \t]\\(.*\\)" bol t)
+                (search-backward-regexp "^[^ \t]*: \\(.*\\)" bol t))
+            (setq prev (match-string 1))
+            (goto-char (match-beginning 1))
+            (setq beg (point))
+            (if (cond ((< n 0)
+                       (>= (+ n wl-draft-current-history-position) 0))
+                      ((> n 0)
+                       (<= (+ n wl-draft-current-history-position)
+                           (length history))))
+                (progn
+                  (setq wl-draft-current-history-position
+                        (+ n wl-draft-current-history-position))
+                  (setq new
+                        (nth wl-draft-current-history-position
+                             (append (list wl-draft-history-backup-word)
+                                     history)))
+                  (delete-region beg end)
+                  (insert new))
+              (goto-char end)
+              (cond ((< n 0)
+                     (message "End of history; no next item"))
+                    ((> n 0)
+                     (message "Beginning of history; no preceding item")))))
+           ((and (> n 0)
+                 (save-excursion
+                   (or (search-backward-regexp ",[ \t]*\\(.*\\)" bol t)
+                       (search-backward-regexp "^[ \t]\\(.*\\)" bol t)
+                       (search-backward-regexp "^[^ \t]*: \\(.*\\)" bol t)))
+                 (car history))
+            (setq wl-draft-current-history-position 1)
+            (setq wl-draft-history-backup-word (match-string 1))
+            (delete-region (match-beginning 1) (match-end 1))
+            (insert (car history)))
+           (t
+            (setq wl-draft-current-history-position nil)))))))
+
+(defun wl-draft-next-history-element (n)
+  (interactive "p")
+  (wl-draft-previous-history-element (- n)))
+
 ;;;; user-agent support by Sen Nagata
 
 ;; this appears to be necessarily global...