((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)
(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"
"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."
"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
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))
(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)
(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.")
(if arg
(let (buf mail-reply-buffer)
(elmo-set-work-buf
+ (insert "\n")
(yank)
(setq buf (current-buffer)))
(setq mail-reply-buffer buf)
(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
(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 "")))
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
(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
"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
(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)
(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"
;; (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
(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
(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))))))
(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"))
(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)))
(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)
(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)))
(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)))))
(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
(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))
(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...