X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=inline;f=wl%2Fwl-draft.el;h=52c3732fc6bebc4c24efd8e02094fef9033e4a01;hb=40ada79e654909e3b4061f1b7c59c447d00dd1d9;hp=15b05151040b886319db29faff7ce037472e89ac;hpb=c1a35a6c6bcf219976597e87bbcc1538742bb938;p=elisp%2Fwanderlust.git
diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index 15b0515..52c3732 100644
--- a/wl/wl-draft.el
+++ b/wl/wl-draft.el
@@ -43,6 +43,7 @@
(defvar mail-from-style)
(eval-when-compile
+ (require 'static)
(require 'elmo-pop3)
(defalias-maybe 'x-face-insert 'ignore)
(defalias-maybe 'x-face-insert-version-header 'ignore)
@@ -52,8 +53,9 @@
(eval-and-compile
(autoload 'wl-addrmgr "wl-addrmgr"))
-(defvar wl-draft-buf-name "Draft")
-(defvar wl-draft-buffer-file-name nil)
+(autoload 'open-ssl-stream "ssl")
+
+(defvar wl-draft-buffer-message-number nil)
(defvar wl-draft-field-completion-list nil)
(defvar wl-draft-verbose-send t)
(defvar wl-draft-verbose-msg nil)
@@ -73,7 +75,25 @@
(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-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)
@@ -91,7 +111,7 @@
(template . wl-draft-config-sub-template)
(x-face . wl-draft-config-sub-x-face)))
-(make-variable-buffer-local 'wl-draft-buffer-file-name)
+(make-variable-buffer-local 'wl-draft-buffer-message-number)
(make-variable-buffer-local 'wl-draft-buffer-cur-summary-buffer)
(make-variable-buffer-local 'wl-draft-config-variables)
(make-variable-buffer-local 'wl-draft-config-exec-flag)
@@ -100,6 +120,10 @@
(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)
+
+(defvar wl-draft-folder-internal nil
+ "Internal variable for caching `opened' draft folder.")
(defsubst wl-smtp-password-key (user mechanism server)
(format "SMTP:%s/%s@%s"
@@ -114,6 +138,14 @@
(list wl-smtp-authenticate-type)))))
(smtp-use-sasl (and smtp-sasl-mechanisms t))
(smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
+ (smtp-open-connection-function
+ (if (eq wl-smtp-connection-type 'ssl)
+ #'open-ssl-stream
+ smtp-open-connection-function))
+ (smtp-end-of-line
+ (if (eq wl-smtp-connection-type 'ssl)
+ "\n"
+ smtp-end-of-line))
smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
(if (and (string= (car smtp-sasl-mechanisms) "DIGEST-MD5")
;; sendmail bug?
@@ -142,55 +174,18 @@
"Insert From field."
;; Put the "From:" field in unless for some odd reason
;; they put one in themselves.
- (let* ((login (or user-mail-address (user-login-name)))
- (fullname (user-full-name)))
- (cond ((eq mail-from-style 'angles)
- (insert "From: " fullname)
- (let ((fullname-start (+ (point-min) (length "From: ")))
- (fullname-end (point-marker)))
- (goto-char fullname-start)
- ;; Look for a character that cannot appear unquoted
- ;; according to RFC 822.
- (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
- fullname-end 1)
- (progn
- ;; Quote fullname, escaping specials.
- (goto-char fullname-start)
- (insert "\"")
- (while (re-search-forward "[\"\\]"
- fullname-end 1)
- (replace-match "\\\\\\&" t))
- (insert "\""))))
- (insert " <" login ">\n"))
- ((eq mail-from-style 'parens)
- (insert "From: " login " (")
- (let ((fullname-start (point)))
- (insert fullname)
- (let ((fullname-end (point-marker)))
- (goto-char fullname-start)
- ;; RFC 822 says \ and nonmatching parentheses
- ;; must be escaped in comments.
- ;; Escape every instance of ()\ ...
- (while (re-search-forward "[()\\]" fullname-end 1)
- (replace-match "\\\\\\&" t))
- ;; ... then undo escaping of matching parentheses,
- ;; including matching nested parentheses.
- (goto-char fullname-start)
- (while (re-search-forward
- "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
- fullname-end 1)
- (replace-match "\\1(\\3)" t)
- (goto-char fullname-start))))
- (insert ")\n"))
- ((not mail-from-style)
- (insert "From: " login "\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."
(interactive)
(if (not (file-exists-p wl-x-face-file))
(error "File %s does not exist" wl-x-face-file)
- (beginning-of-buffer)
+ (goto-char (point-min))
(search-forward mail-header-separator nil t)
(beginning-of-line)
(wl-draft-insert-x-face-field-here)
@@ -212,13 +207,21 @@
(defun wl-draft-setup ()
(let ((field wl-draft-fields)
- ret-val)
+ cl)
(while field
- (setq ret-val (append ret-val
- (list (cons (concat (car field) " ")
- (concat (car field) " ")))))
+ (setq cl (append cl
+ (list (cons (concat (car field) " ")
+ (concat (car field) " ")))))
(setq field (cdr field)))
- (setq wl-draft-field-completion-list ret-val)))
+ (setq cl
+ (cons (cons (concat wl-draft-mime-bcc-field-name ": ")
+ (concat wl-draft-mime-bcc-field-name ": "))
+ cl))
+ (setq wl-draft-field-completion-list cl)
+ (setq wl-address-complete-header-regexp
+ (wl-regexp-opt
+ (append wl-address-complete-header-list
+ (list (concat wl-draft-mime-bcc-field-name ":")))))))
(defun wl-draft-make-mail-followup-to (recipients)
(if (elmo-list-member
@@ -228,7 +231,12 @@
(let ((rlist (elmo-list-delete
(or wl-user-mail-address-list
(list (wl-address-header-extract-address wl-from)))
- (copy-sequence recipients))))
+ recipients
+ (lambda (elem list)
+ (elmo-delete-if
+ (lambda (item) (string= (downcase elem)
+ (downcase item)))
+ list)))))
(if (elmo-list-member rlist (mapcar 'downcase
wl-subscribed-mailing-list))
rlist
@@ -240,10 +248,20 @@
(let ((myself (or wl-user-mail-address-list
(list (wl-address-header-extract-address wl-from)))))
(cond (wl-draft-always-delete-myself ; always-delete option
- (elmo-list-delete myself cc))
+ (elmo-list-delete myself cc
+ (lambda (elem list)
+ (elmo-delete-if
+ (lambda (item) (string= (downcase elem)
+ (downcase item)))
+ list))))
((elmo-list-member (append to cc) ; subscribed mailing-list
(mapcar 'downcase wl-subscribed-mailing-list))
- (elmo-list-delete myself cc))
+ (elmo-list-delete myself cc
+ (lambda (elem list)
+ (elmo-delete-if
+ (lambda (item) (string= (downcase elem)
+ (downcase item)))
+ list))))
(t cc))))
(defun wl-draft-forward (original-subject summary-buf)
@@ -260,9 +278,12 @@
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 "Forward: " original-subject))
+ (concat wl-forward-subject-prefix original-subject))
(cons 'References references))
nil nil nil nil parent-folder))
(goto-char (point-max))
@@ -270,33 +291,28 @@
(mail-position-on-field "To"))
(defun wl-draft-strip-subject-re (subject)
- "Remove \"Re:\" from subject lines. Shamelessly copied from Gnus."
+ "Remove \"Re:\" from SUBJECT string. Shamelessly copied from Gnus."
(if (string-match wl-subject-prefix-regexp subject)
(substring subject (match-end 0))
subject))
-(defun wl-draft-reply-list-symbol (with-arg)
- "Return symbol `wl-draft-reply-*-argument-list' match condition.
-Check WITH-ARG and From: field."
- (if (wl-address-user-mail-address-p (or (elmo-field-body "From") ""))
- (if with-arg
- 'wl-draft-reply-myself-with-argument-list
- 'wl-draft-reply-myself-without-argument-list)
- (if with-arg
- 'wl-draft-reply-with-argument-list
- 'wl-draft-reply-without-argument-list)))
-
-(defun wl-draft-reply (buf with-arg summary-buf)
+(defun wl-draft-self-reply-p ()
+ "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 &optional number)
"Reply to BUF buffer message.
Reply to author if WITH-ARG is non-nil."
;;;(save-excursion
(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)
- (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
+ (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 (if with-arg wl-draft-reply-with-argument-list
+ wl-draft-reply-without-argument-list))
(catch 'done
(while r-list
(when (let ((condition (car (car r-list))))
@@ -305,8 +321,15 @@ Reply to author if WITH-ARG is non-nil."
((listp condition)
(catch 'done
(while condition
- (if (not (std11-field-body (car condition)))
- (throw 'done nil))
+ (cond
+ ((stringp (car condition))
+ (or (std11-field-body (car condition))
+ (throw 'done nil)))
+ ((symbolp (car condition))
+ (or (funcall (car condition))
+ (throw 'done nil)))
+ (t
+ (debug)))
(setq condition (cdr condition)))
t))
((symbolp condition)
@@ -326,7 +349,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))
@@ -339,8 +362,8 @@ Reply to author if WITH-ARG is non-nil."
","))))
(throw 'done nil))
(setq r-list (cdr r-list)))
- (error "No match field: check your `%s'"
- (symbol-name (wl-draft-reply-list-symbol with-arg))))
+ (error "No match field: check your `wl-draft-reply-%s-argument-list'"
+ (if with-arg "with" "without")))
(setq subject (std11-field-body "Subject"))
(setq to (wl-parse-addresses to)
cc (wl-parse-addresses cc))
@@ -425,6 +448,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)
@@ -433,9 +459,29 @@ 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-reply-buffer buf))
+ (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))
+(defun wl-draft-reply-position (position)
+ (cond ((eq position 'body)
+ (wl-draft-body-goto-top))
+ ((eq position 'bottom)
+ (wl-draft-body-goto-bottom))
+ ((eq position 'top)
+ (goto-char (point-min)))
+ ((and (stringp position)
+ (std11-field-body position))
+ (progn (mail-position-on-field position)
+ (wl-draft-beginning-of-line)))
+ ((listp position)
+ (while (car position)
+ (wl-draft-reply-position (car position))
+ (setq position (cdr position))))))
+
(defun wl-draft-add-references ()
(wl-draft-add-in-reply-to "References"))
@@ -495,15 +541,6 @@ Reply to author if WITH-ARG is non-nil."
(when wl-highlight-body-too
(wl-highlight-body-region beg (point-max)))))
-(defun wl-draft-confirm ()
- "Confirm send message."
- (interactive)
- (y-or-n-p (format "Send current draft as %s? "
- (cond ((and (wl-message-mail-p) (wl-message-news-p))
- "Mail and News")
- ((wl-message-mail-p) "Mail")
- ((wl-message-news-p) "News")))))
-
(defun wl-message-news-p ()
"If exist valid Newsgroups field, return non-nil."
(std11-field-body "Newsgroups"))
@@ -520,26 +557,17 @@ Reply to author if WITH-ARG is non-nil."
(wl-message-field-exists-p "Resent-to")
(wl-message-field-exists-p "Cc")
(wl-message-field-exists-p "Bcc")
+ (wl-message-field-exists-p wl-draft-mime-bcc-field-name)
;;; This may be needed..
;;; (wl-message-field-exists-p "Fcc")
))
-(defun wl-draft-open-file (&optional file)
- "Open FILE for edit."
- (interactive)
-;;;(interactive "*fFile to edit: ")
- (wl-draft-edit-string (elmo-get-file-string
- (or file
- (read-file-name "File to edit: "
- (or wl-temporary-file-directory
- "~/"))))))
-
(defun wl-draft-edit-string (string)
(let ((cur-buf (current-buffer))
(tmp-buf (get-buffer-create " *wl-draft-edit-string*"))
to subject in-reply-to cc references newsgroups mail-followup-to
content-type content-transfer-encoding from
- body-beg buffer-read-only)
+ body-beg)
(set-buffer tmp-buf)
(erase-buffer)
(insert string)
@@ -594,11 +622,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)))
- (setq buffer-read-only nil) ;;??
- (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)
@@ -626,7 +655,7 @@ Reply to author if WITH-ARG is non-nil."
(wl-folder-get-entity-with-petname)
wl-folder-entity-hashtb)
nil nil wl-default-spec
- 'wl-read-folder-hist))
+ 'wl-read-folder-history))
(number (call-interactively
(function (lambda (num)
(interactive "nNumber: ")
@@ -650,34 +679,23 @@ 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
- (wl-summary-from-func-internal
- (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")
+(defvar wl-draft-buffer nil "Draft buffer to yank content.")
(defun wl-draft-yank-to-draft-buffer (buffer)
"Yank BUFFER content to `wl-draft-buffer'."
(set-buffer wl-draft-buffer)
@@ -691,6 +709,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)
@@ -700,8 +719,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
@@ -710,38 +730,35 @@ 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."
+ "Kill the editing draft buffer and delete the file corresponds to it."
(save-excursion
(when editing-buffer
(set-buffer editing-buffer)
- (if wl-draft-buffer-file-name
- (progn
- (if (file-exists-p wl-draft-buffer-file-name)
- (delete-file wl-draft-buffer-file-name))
- (let ((msg (and wl-draft-buffer-file-name
- (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))))
- (wl-draft-config-info-operation msg 'delete))))
+ (when wl-draft-buffer-message-number
+ (elmo-folder-delete-messages (wl-draft-get-folder)
+ (list
+ wl-draft-buffer-message-number))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number
+ 'delete))
(set-buffer-modified-p nil) ; force kill
(kill-buffer editing-buffer))))
@@ -752,8 +769,25 @@ Reply to author if WITH-ARG is non-nil."
(when (and (or (eq major-mode 'wl-draft-mode)
(eq major-mode 'mail-mode))
(or force-kill
- (y-or-n-p "Kill Current Draft? ")))
+ (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))))
(wl-draft-hide cur-buf)
(wl-draft-delete cur-buf)))
(message "")))
@@ -774,6 +808,33 @@ text was killed."
(kill-region b e)
(insert wl-draft-elide-ellipsis))
+;; Imported from message.el.
+(defun wl-draft-beginning-of-line (&optional n)
+ "Move point to beginning of header value or to beginning of line."
+ (interactive "p")
+ (let ((zrs 'zmacs-region-stays))
+ (when (and (interactive-p) (boundp zrs))
+ (set zrs t)))
+ (if (wl-draft-point-in-header-p)
+ (let* ((here (point))
+ (bol (progn (beginning-of-line n) (point)))
+ (eol (line-end-position))
+ (eoh (and (looking-at "[^ \t]")
+ (re-search-forward ": *" eol t))))
+ (if (and eoh (or (> here eoh) (= here bol)))
+ (goto-char eoh)
+ (goto-char bol)))
+ (beginning-of-line n)))
+
+(defun wl-draft-point-in-header-p ()
+ "Return t if point is in the header."
+ (save-excursion
+ (let ((p (point)))
+ (goto-char (point-min))
+ (not (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n")
+ p t)))))
+
;; function for wl-sent-message-via
(defmacro wl-draft-sent-message-p (type)
@@ -955,7 +1016,10 @@ from current buffer."
"Get address list suitable for smtp RCPT TO:
.
Group list content is removed if `wl-draft-remove-group-list-contents' is
non-nil."
- (let ((fields '("to" "cc" "bcc"))
+ (let ((fields (if (and wl-draft-doing-mime-bcc
+ wl-draft-disable-bcc-for-mime-bcc)
+ '("to" "cc")
+ '("to" "cc" "bcc")))
(resent-fields '("resent-to" "resent-cc" "resent-bcc"))
(case-fold-search t)
addrs recipients)
@@ -995,18 +1059,7 @@ non-nil."
"$\\|^$") nil t)
(point-marker)))
(smtp-server
- (or wl-smtp-posting-server
- ;; Compatibility stuff for FLIM 1.12.5 or earlier.
- ;; They don't accept a function as the value of `smtp-server'.
- (if (functionp smtp-server)
- (funcall
- smtp-server
- sender
- ;; no harm..
- (let (wl-draft-remove-group-list-contents)
- (wl-draft-deduce-address-list
- (current-buffer) (point-min) delimline)))
- (or smtp-server "localhost"))))
+ (or wl-smtp-posting-server smtp-server "localhost"))
(smtp-service (or wl-smtp-posting-port smtp-service))
(smtp-local-domain (or smtp-local-domain wl-local-domain))
(id (std11-field-body "message-id"))
@@ -1042,12 +1095,16 @@ non-nil."
(wl-draft-write-sendlog 'failed 'smtp smtp-server
recipients id)
(if (and (eq (car err) 'smtp-response-error)
- (/= (nth 1 err) 334))
+ (= (nth 1 err) 535))
(elmo-remove-passwd
(wl-smtp-password-key
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
@@ -1058,7 +1115,7 @@ non-nil."
(defun wl-draft-send-mail-with-pop-before-smtp ()
"Send the prepared message buffer with POP-before-SMTP."
(require 'elmo-pop3)
- (let ((session
+ (let ((folder
(luna-make-entity
'elmo-pop3-folder
:user (or wl-pop-before-smtp-user
@@ -1069,21 +1126,22 @@ non-nil."
elmo-pop3-default-port)
:auth (or wl-pop-before-smtp-authenticate-type
elmo-pop3-default-authenticate-type)
- :stream-type (or wl-pop-before-smtp-stream-type
- elmo-pop3-default-stream-type))))
+ :stream-type (elmo-get-network-stream-type
+ (or wl-pop-before-smtp-stream-type
+ elmo-pop3-default-stream-type))))
+ session)
(condition-case error
(progn
- (elmo-pop3-get-session session)
+ (setq session (elmo-pop3-get-session folder))
(when session (elmo-network-close-session session)))
(error
- (elmo-network-close-session session)
(unless (string= (nth 1 error) "Unplugged")
- (signal (car error)(cdr error))))))
+ (signal (car error) (cdr error))))))
(wl-draft-send-mail-with-smtp))
(defun wl-draft-insert-required-fields (&optional force-msgid)
"Insert Message-ID, Date, and From field.
-If FORCE-MSGID, ignore 'wl-insert-message-id'."
+If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
;; Insert Message-Id field...
(goto-char (point-min))
(when (and (or force-msgid
@@ -1104,15 +1162,24 @@ If FORCE-MSGID, ignore '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
@@ -1123,9 +1190,9 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
(defun wl-draft-dispatch-message (&optional mes-string)
"Send the message in the current buffer. Not modified the header fields."
- (let (delimline)
+ (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
@@ -1139,7 +1206,11 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
(if (or (not (or wl-draft-force-queuing
wl-draft-force-queuing-mail))
(memq 'mail wl-sent-message-queued))
- (funcall wl-draft-send-mail-function)
+ (progn
+ (setq mime-bcc (wl-draft-mime-bcc-field))
+ (funcall wl-draft-send-mail-function)
+ (when (not (zerop (length mime-bcc)))
+ (wl-draft-do-mime-bcc mime-bcc)))
(push 'mail wl-sent-message-queued)
(wl-draft-set-sent-message 'mail 'unplugged)))
(if (and (wl-message-news-p)
@@ -1151,14 +1222,14 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
(funcall wl-draft-send-news-function)
(push 'news wl-sent-message-queued)
(wl-draft-set-sent-message 'news 'unplugged))))
- ;;
(let* ((status (wl-draft-sent-message-results))
(unplugged-via (car status))
(sent-via (nth 1 status)))
;; If one sent, process fcc folder.
(if (and sent-via wl-draft-fcc-list)
(progn
- (wl-draft-do-fcc (wl-draft-get-header-delimiter) wl-draft-fcc-list)
+ (wl-draft-do-fcc (wl-draft-get-header-delimiter)
+ wl-draft-fcc-list)
(setq wl-draft-fcc-list nil)))
(if wl-draft-use-cache
(let ((id (std11-field-body "Message-ID"))
@@ -1179,10 +1250,11 @@ If FORCE-MSGID, ignore '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)
@@ -1209,6 +1281,49 @@ If FORCE-MSGID, ignore '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
+ (discard-input)
+ (message "Send current draft? ")
+ (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"
@@ -1218,7 +1333,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)
- (y-or-n-p "Do you really want to send current draft? "))
+ (wl-draft-send-confirm))
(let ((send-mail-function 'wl-draft-raw-send)
(editing-buffer (current-buffer))
(sending-buffer (wl-draft-generate-clone-buffer
@@ -1228,21 +1343,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)))
+ '((wl-draft-eword-encode-address-list
+ . (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
@@ -1251,50 +1368,96 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(cdr (car mail-send-actions)))
(error))
(setq mail-send-actions (cdr mail-send-actions)))
-;; (if (or (eq major-mode 'wl-draft-mode)
-;; (eq major-mode 'mail-mode))
-;; (local-set-key "\C-c\C-s" 'wl-draft-send)) ; override
(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))))))
+(defun wl-draft-mime-bcc-field ()
+ "Return the MIME-Bcc field body. The field is deleted."
+ (prog1 (std11-field-body wl-draft-mime-bcc-field-name)
+ (wl-draft-delete-field wl-draft-mime-bcc-field-name)))
+
+(defun wl-draft-do-mime-bcc (field-body)
+ "Send MIME-Bcc (Encapsulated blind carbon copy)."
+ (let ((orig-from (mime-decode-field-body (std11-field-body "from")
+ 'From))
+ (orig-subj (mime-decode-field-body (or (std11-field-body "subject")
+ "")
+ 'Subject))
+ (recipients (wl-parse-addresses field-body))
+ (draft-buffer (current-buffer))
+ wl-draft-use-frame)
+ (save-window-excursion
+ (when (and (not wl-draft-doing-mime-bcc) ; To avoid infinite loop.
+ (not (zerop (length field-body))))
+ (let ((wl-draft-doing-mime-bcc t))
+ (dolist (recipient recipients)
+ (wl-draft-create-buffer)
+ (wl-draft-create-contents
+ (append `((From . ,orig-from)
+ (To . ,recipient)
+ (Subject . ,(concat "A blind carbon copy ("
+ orig-subj
+ ")")))
+ (wl-draft-default-headers)))
+ (wl-draft-insert-mail-header-separator)
+ (wl-draft-prepare-edit)
+ (goto-char (point-max))
+ (insert (or wl-draft-mime-bcc-body
+ "This is a blind carbon copy.")
+ "\n")
+ (mime-edit-insert-tag "message" "rfc822")
+ (insert-buffer draft-buffer)
+ (let (wl-interactive-send)
+ (wl-draft-send 'kill-when-done))))))))
+
(defun wl-draft-save ()
- "Save current draft.
-Derived from `message-save-drafts' in T-gnus."
+ "Save current draft."
(interactive)
(if (buffer-modified-p)
(progn
- (message "Saving %s..." wl-draft-buffer-file-name)
- (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
- (with-temp-file wl-draft-buffer-file-name
+ (message "Saving...")
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max)))
+ next-number)
+ (when wl-draft-buffer-message-number
+ (elmo-folder-delete-messages (wl-draft-get-folder)
+ (list wl-draft-buffer-message-number))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number
+ 'delete))
+ (elmo-folder-check (wl-draft-get-folder))
+ ;; If no header separator, insert it.
+ (with-temp-buffer
(insert msg)
- ;; If no header separator, insert it.
- (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
(goto-char (point-min))
- (unless (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (goto-char (point-min))
- (if (re-search-forward "\n\n" nil t)
- (replace-match (concat "\n" mail-header-separator "\n"))
- (goto-char (point-max))
- (insert (if (eq (char-before) ?\n) "" "\n")
- mail-header-separator "\n"))))
+ (if (re-search-forward "\n\n" nil t)
+ (replace-match (concat "\n" mail-header-separator "\n"))
+ (goto-char (point-max))
+ (insert (if (eq (char-before) ?\n) "" "\n")
+ mail-header-separator "\n")))
(let ((mime-header-encode-method-alist
'((eword-encode-unstructured-field-body))))
(mime-edit-translate-buffer))
- (wl-draft-get-header-delimiter t)))
- (set-buffer-modified-p nil)
- (wl-draft-config-info-operation
- (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))
- 'save)
- (message "Saving %s...done" wl-draft-buffer-file-name))
+ (wl-draft-get-header-delimiter t)
+ (setq next-number
+ (elmo-folder-next-message-number (wl-draft-get-folder)))
+ (elmo-folder-append-buffer (wl-draft-get-folder)))
+ (elmo-folder-check (wl-draft-get-folder))
+ (elmo-folder-commit (wl-draft-get-folder))
+ (setq wl-draft-buffer-message-number next-number)
+ (rename-buffer (format "%s/%d" wl-draft-folder next-number))
+ (setq buffer-file-name (buffer-name))
+ (set-buffer-modified-p nil)
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
+ (message "Saving...done")))
(message "(No changes need to be saved)")))
(defun wl-draft-mimic-kill-buffer ()
@@ -1306,7 +1469,13 @@ Derived from `message-save-drafts' in T-gnus."
(if (or (not bufname)
(string-equal bufname "")
(string-equal bufname (buffer-name)))
- (wl-draft-save-and-exit)
+ (let ((bufname (current-buffer)))
+ (when (or (not (buffer-modified-p))
+ (yes-or-no-p
+ (format "Buffer %s modified; kill anyway? " bufname)))
+ (set-buffer-modified-p nil)
+ (wl-draft-hide bufname)
+ (kill-buffer bufname)))
(kill-buffer bufname))))
(defun wl-draft-save-and-exit ()
@@ -1359,26 +1528,39 @@ Derived from `message-save-drafts' in T-gnus."
(point-max)))))))
(defun wl-draft-get-fcc-list (header-end)
- (let (fcc-list
- (case-fold-search t))
- (or (markerp header-end) (error "HEADER-END must be a marker"))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^Fcc:[ \t]*" header-end t)
- (setq fcc-list
- (cons (buffer-substring-no-properties
- (point)
- (progn
- (end-of-line)
- (skip-chars-backward " \t")
- (point)))
- fcc-list))
- (save-match-data
- (wl-folder-confirm-existence
- (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list)))))
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point)))))
- fcc-list))
+ (if (and wl-draft-doing-mime-bcc
+ wl-draft-disable-fcc-for-mime-bcc)
+ (progn
+ (wl-draft-delete-field "fcc")
+ nil)
+ (let (fcc-list
+ (case-fold-search t))
+ (or (markerp header-end) (error "HEADER-END must be a marker"))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^Fcc:[ \t]*" header-end t)
+ (save-match-data
+ (setq fcc-list
+ (append fcc-list
+ (split-string
+ (buffer-substring-no-properties
+ (point)
+ (progn
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ ",[ \t]*")))
+ (dolist (folder fcc-list)
+ (wl-folder-confirm-existence
+ (wl-folder-get-elmo-folder (eword-decode-string folder)))))
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point)))))
+ fcc-list)))
+
+(defcustom wl-draft-fcc-append-read-folder-history t
+ "Non-nil to append fcc'ed folder to `wl-read-folder-history'."
+ :type 'boolean
+ :group 'wl-draft)
(defun wl-draft-do-fcc (header-end &optional fcc-list)
(let ((send-mail-buffer (current-buffer))
@@ -1409,9 +1591,14 @@ Derived from `message-save-drafts' in T-gnus."
(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-history
+ (boundp 'wl-read-folder-history))
+ (or (equal (car fcc-list) (car wl-read-folder-history))
+ (setq wl-read-folder-history
+ (append (list (car fcc-list)) wl-read-folder-history))))
(setq fcc-list (cdr fcc-list)))))
(kill-buffer tembuf)))
@@ -1436,10 +1623,6 @@ Derived from `message-save-drafts' in T-gnus."
nil
(if (re-search-forward ":" pos t) nil t)))))))
-(defun wl-draft-random-alphabet ()
- (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)))
- (nth (abs (% (random) 26)) alphabet)))
-
;;;;;;;;;;;;;;;;
;;;###autoload
(defun wl-draft (&optional header-alist
@@ -1458,16 +1641,8 @@ Derived from `message-save-drafts' in T-gnus."
(wl-init)) ; returns immediately if already initialized.
- (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))
-
+ (let (buffer header-alist-internal)
+ (setq buffer (wl-draft-create-buffer parent-folder))
(unless (cdr (assq 'From header-alist))
(setq header-alist
(append (list (cons 'From wl-from)) header-alist)))
@@ -1489,7 +1664,7 @@ Derived from `message-save-drafts' in T-gnus."
(setq header-alist (append header-alist
(wl-draft-default-headers)
wl-draft-additional-header-alist
- (if body (list "" body))))
+ (if body (list "" (cons 'Body body)))))
(wl-draft-create-contents header-alist)
(if edit-again
(wl-draft-decode-body
@@ -1499,6 +1674,7 @@ Derived from `message-save-drafts' in T-gnus."
(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)
@@ -1506,36 +1682,54 @@ Derived from `message-save-drafts' in T-gnus."
(mail-position-on-field "To"))
(t
(goto-char (point-max))))
- buf-name))
+ buffer))
-(defun wl-draft-create-buffer (&optional full parent-folder)
- (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+(defun wl-draft-create-buffer (&optional parent-folder)
+ (let* ((draft-folder (wl-draft-get-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)
- (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
- (or (elmo-folder-list-messages draft-folder) '(0))))
- (setq num (+ 1 num))
- ;; To get unused buffer name.
- (while (get-buffer (concat wl-draft-folder "/" (int-to-string num)))
- (setq num (+ 1 num)))
- (setq buf-name (find-file-noselect
- (setq file-name
- (elmo-message-file-name
- (wl-folder-get-elmo-folder wl-draft-folder)
- num))))
+ (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)))
+ (buffer (generate-new-buffer "*draft*")) ; Just for initial name.
+ change-major-mode-hook)
+ (set-buffer buffer)
+ ;; switch-buffer according to draft buffer style.
(if wl-draft-use-frame
- (switch-to-buffer-other-frame buf-name)
- (switch-to-buffer buf-name))
- (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))
+ (switch-to-buffer-other-frame buffer)
+ (if reply-or-forward
+ (case wl-draft-reply-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-reply-buffer-style)
+ (funcall wl-draft-reply-buffer-style buffer)
+ (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 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"))))))
(auto-save-mode -1)
(wl-draft-mode)
(make-local-variable 'truncate-partial-width-windows)
@@ -1543,12 +1737,11 @@ Derived from `message-save-drafts' in T-gnus."
(setq truncate-lines wl-draft-truncate-lines)
(setq wl-sent-message-via nil)
(setq wl-sent-message-queued nil)
- (setq wl-draft-buffer-file-name file-name)
(setq wl-draft-config-exec-flag t)
- (setq wl-draft-parent-folder parent-folder)
+ (setq wl-draft-parent-folder (or parent-folder ""))
(or (eq this-command 'wl-folder-write-current-folder)
(setq wl-draft-buffer-cur-summary-buffer summary-buf))
- buf-name))
+ buffer))
(defun wl-draft-create-contents (header-alist)
"header-alist' sample
@@ -1559,10 +1752,9 @@ Derived from `message-save-drafts' in T-gnus."
;; insert symbol-value: string
(symbol . nil) ;; do nothing
nil ;; do nothing
- )
-"
+ )"
(unless (eq major-mode 'wl-draft-mode)
- (error "wl-draft-create-header must be use in wl-draft-mode."))
+ (error "`wl-draft-create-header' must be use in wl-draft-mode"))
(let ((halist header-alist)
field value)
(while halist
@@ -1578,6 +1770,8 @@ Derived from `message-save-drafts' in T-gnus."
(cond
((symbolp field)
(cond
+ ((eq field 'Body) ; body
+ (insert value))
((stringp value) (insert (symbol-name field) ": " value "\n"))
((functionp value)
(let ((value-return (funcall value)))
@@ -1595,10 +1789,22 @@ Derived from `message-save-drafts' in T-gnus."
(defun wl-draft-prepare-edit ()
(unless (eq major-mode 'wl-draft-mode)
- (error "wl-draft-create-header must be use in wl-draft-mode."))
+ (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)
+ (static-when (boundp 'auto-save-file-name-transforms)
+ (make-local-variable 'auto-save-file-name-transforms)
+ (setq auto-save-file-name-transforms
+ (cons (list (concat (regexp-quote wl-draft-folder)
+ "/\\([0-9]+\\)")
+ (concat (expand-file-name
+ "auto-save-"
+ (elmo-folder-msgdb-path
+ (wl-draft-get-folder)))
+ "\\1"))
+ auto-save-file-name-transforms)))
+ (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)
@@ -1696,7 +1902,8 @@ Derived from `message-save-drafts' in T-gnus."
(progn
(insert mail-header-separator "\n")
(1- (point)))
- 'category 'mail-header-separator)))
+ 'category 'mail-header-separator)
+ (point)))
;;;;;;;;;;;;;;;;
@@ -1709,12 +1916,27 @@ Derived from `message-save-drafts' in T-gnus."
(elmo-nntp-default-port
(or wl-nntp-posting-port elmo-nntp-default-port))
(elmo-nntp-default-stream-type
- (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type)))
+ (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type))
+ (elmo-nntp-default-function wl-nntp-posting-function)
+ condition)
+ (if (setq condition (cdr (elmo-string-matched-assoc
+ (std11-field-body "Newsgroups")
+ wl-nntp-posting-config-alist)))
+ (if (stringp condition)
+ (setq elmo-nntp-default-server condition)
+ (while (car condition)
+ (set (intern (format "elmo-nntp-default-%s"
+ (symbol-name (caar condition))))
+ (cdar condition))
+ (setq condition (cdr condition)))))
+ (unless elmo-nntp-default-function
+ (error "wl-draft-nntp-send: posting-function is nil"))
(if (not (elmo-plugged-p elmo-nntp-default-server elmo-nntp-default-port))
(wl-draft-set-sent-message 'news 'unplugged
(cons elmo-nntp-default-server
elmo-nntp-default-port))
- (elmo-nntp-post elmo-nntp-default-server (current-buffer))
+ (funcall elmo-nntp-default-function
+ elmo-nntp-default-server (current-buffer))
(wl-draft-set-sent-message 'news 'sent)
(wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server
(std11-field-body "Newsgroups")
@@ -1739,52 +1961,62 @@ Derived from `message-save-drafts' in T-gnus."
(setq local-variables (cdr local-variables)))
(current-buffer))))
+(defun wl-draft-remove-text-plain-tag ()
+ "Remove text/plain tag of mime-edit."
+ (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)))))
+
(defun wl-draft-reedit (number)
- (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+ (let ((draft-folder (wl-draft-get-folder))
(wl-draft-reedit t)
- buffer file-name change-major-mode-hook)
- (setq file-name (elmo-message-file-name draft-folder number))
- (unless (file-exists-p file-name)
- (error "File %s does not exist" file-name))
- (if (setq buffer (get-buffer
- (concat wl-draft-folder "/"
- (number-to-string number))))
- (progn
- (if wl-draft-use-frame
- (switch-to-buffer-other-frame buffer)
- (switch-to-buffer buffer))
- (set-buffer buffer))
- (setq buffer (get-buffer-create (number-to-string number)))
- (if wl-draft-use-frame
- (switch-to-buffer-other-frame buffer)
- (switch-to-buffer buffer))
- (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)
- (if (not (string-match (regexp-quote wl-draft-folder)
- (buffer-name)))
- (rename-buffer (concat wl-draft-folder "/" (buffer-name))))
- (auto-save-mode -1)
- (wl-draft-mode)
- (setq buffer-file-name file-name)
- (make-local-variable 'truncate-partial-width-windows)
- (setq truncate-partial-width-windows nil)
- (setq truncate-lines wl-draft-truncate-lines)
- (setq wl-sent-message-via nil)
- (setq wl-sent-message-queued nil)
- (setq wl-draft-buffer-file-name file-name)
- (wl-draft-config-info-operation number 'load)
- (goto-char (point-min))
- (wl-draft-overload-functions)
- (wl-draft-editor-mode)
- (add-hook 'local-write-file-hooks 'wl-draft-save)
- (wl-highlight-headers 'for-draft)
- (run-hooks 'wl-draft-reedit-hook)
- (goto-char (point-max))
- buffer)))
+ (num 0)
+ buffer change-major-mode-hook body-top)
+ (setq buffer (get-buffer-create (format "%s/%d" wl-draft-folder
+ number)))
+ (if wl-draft-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ (set-buffer buffer)
+ (elmo-message-fetch draft-folder number (elmo-make-fetch-strategy 'entire)
+ nil (current-buffer))
+ (elmo-delete-cr-buffer)
+ (let ((mime-edit-again-ignored-field-regexp
+ "^\\(Content-.*\\|Mime-Version\\):"))
+ (wl-draft-decode-message-in-buffer))
+ (setq body-top (wl-draft-insert-mail-header-separator))
+ (auto-save-mode -1)
+ (wl-draft-mode)
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows nil)
+ (setq truncate-lines wl-draft-truncate-lines)
+ (setq wl-sent-message-via nil)
+ (setq wl-sent-message-queued nil)
+ (wl-draft-config-info-operation number 'load)
+ (goto-char (point-min))
+ (wl-draft-overload-functions)
+ (wl-draft-editor-mode)
+ (static-when (boundp 'auto-save-file-name-transforms)
+ (make-local-variable 'auto-save-file-name-transforms)
+ (setq auto-save-file-name-transforms
+ (cons (list (concat (regexp-quote wl-draft-folder)
+ "/\\([0-9]+\\)")
+ (concat (expand-file-name
+ "auto-save-"
+ (elmo-folder-msgdb-path
+ (wl-draft-get-folder)))
+ "\\1"))
+ auto-save-file-name-transforms)))
+ (setq buffer-file-name (buffer-name)
+ wl-draft-parent-folder ""
+ wl-draft-buffer-message-number number)
+ (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))
(defmacro wl-draft-body-goto-top ()
(` (progn
@@ -1803,34 +2035,41 @@ Derived from `message-save-drafts' in T-gnus."
(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)
@@ -1915,7 +2154,8 @@ Derived from `message-save-drafts' in T-gnus."
(wl-draft-config-exec config-alist reply-buf)))))
(defun wl-draft-config-exec (&optional config-alist reply-buf)
- "Change headers in draft sending time."
+ "Change headers according to the value of `wl-draft-config-alist'.
+Automatically applied in draft sending time."
(interactive)
(let ((case-fold-search t)
(alist (or config-alist wl-draft-config-alist))
@@ -1997,8 +2237,7 @@ Derived from `message-save-drafts' in T-gnus."
(insert (concat field ": " content "\n"))))))))
(defun wl-draft-config-info-operation (msg operation)
- (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-folder-get-elmo-folder
- wl-draft-folder)))
+ (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-draft-get-folder)))
(filename
(expand-file-name
(format "%s-%d" wl-draft-config-save-filename msg)
@@ -2062,7 +2301,7 @@ Derived from `message-save-drafts' in T-gnus."
(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))
@@ -2170,8 +2409,7 @@ Derived from `message-save-drafts' in T-gnus."
(switch-to-buffer buf))))))
(defun wl-jump-to-draft-folder ()
- (let ((msgs (reverse (elmo-folder-list-messages (wl-folder-get-elmo-folder
- wl-draft-folder))))
+ (let ((msgs (reverse (elmo-folder-list-messages (wl-draft-get-folder))))
(mybuf (buffer-name))
msg buf)
(if (not msgs)
@@ -2187,13 +2425,93 @@ Derived from `message-save-drafts' in T-gnus."
(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))))
+ (static-when (featurep 'xemacs)
+ ;; Cope with one of many XEmacs bugs that `recenter' takes
+ ;; a long time if there are a lot of invisible text lines.
+ (redraw-frame))
(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 beg end prev new)
+ (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-history)
+ (setq history wl-read-folder-history)))
+ ;; ((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...
@@ -2243,16 +2561,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)