X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-draft.el;h=56955a97039f353d687cb72299757321aa8acb7e;hb=52061841b6997afec3a3108019c9362c35e4864b;hp=5ef8bc2233a27822fb1ee37e1c9379788dda1fcb;hpb=99728a37cd314d1ed07d1cf365db1eeb9816ba32;p=elisp%2Fwanderlust.git diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 5ef8bc2..56955a9 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -73,9 +73,20 @@ (defvar wl-draft-reedit nil) (defvar wl-draft-reply-buffer nil) (defvar wl-draft-forward nil) -(defvar wl-draft-parent-folder nil) (defvar wl-draft-doing-mime-bcc nil) +(defvar wl-draft-parent-folder nil + "Folder name of the summary in which current draft is invoked. +This variable is local in each draft buffer. +You can refer its value in `wl-draft-config-alist'. + +e.g. +\(setq wl-draft-config-alist + '(((string-match \".*@domain1$\" wl-draft-parent-folder) + (\"From\" . \"user@domain1\")) + ((string-match \".*@domain2$\" wl-draft-parent-folder) + (\"From\" . \"user@domain2\"))))") + (defvar wl-draft-config-sub-func-alist '((body . wl-draft-config-sub-body) (top . wl-draft-config-sub-top) @@ -191,7 +202,7 @@ (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) @@ -237,7 +248,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 @@ -249,10 +265,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) @@ -269,9 +295,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)) @@ -284,16 +313,9 @@ (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-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) "Reply to BUF buffer message. @@ -302,10 +324,12 @@ Reply to author if WITH-ARG is non-nil." (let (r-list to mail-followup-to cc subject in-reply-to references newsgroups to-alist cc-alist decoder parent-folder) - (set-buffer summary-buf) - (setq parent-folder (wl-summary-buffer-folder-name)) - (set-buffer buf) - (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)))) @@ -314,8 +338,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) @@ -348,8 +379,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)) @@ -434,6 +465,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) @@ -442,8 +476,24 @@ 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)) - (run-hooks 'wl-reply-hook)) + (setq wl-draft-reply-buffer buf) + (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")) @@ -504,15 +554,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")) @@ -534,22 +575,12 @@ Reply to author if WITH-ARG is non-nil." ;;; (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) @@ -604,11 +635,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) @@ -720,23 +752,23 @@ Reply to author if WITH-ARG is non-nil." (delete-frame) ;; hide draft window (or (one-window-p) - (delete-window))) - ;; stay folder window if required - (when wl-stay-folder-window - (if (setq fld-buf (get-buffer wl-folder-buffer-name)) - (if (setq fld-win (get-buffer-window fld-buf)) - (select-window fld-win) - (if wl-draft-resume-folder-window ;; resume folder window - (switch-to-buffer fld-buf))))) - (if (buffer-live-p sum-buf) - (if (setq sum-win (get-buffer-window sum-buf t)) - ;; if Summary is on the frame, select it. - (select-window sum-win) - ;; if summary is not on the frame, switch to it. - (if (and wl-stay-folder-window - (or wl-draft-resume-folder-window fld-win)) - (wl-folder-select-buffer sum-buf) - (switch-to-buffer sum-buf))))))) + (delete-window)) + ;; stay folder window if required + (when wl-stay-folder-window + (if (setq fld-buf (get-buffer wl-folder-buffer-name)) + (if (setq fld-win (get-buffer-window fld-buf)) + (select-window fld-win) + (if wl-draft-resume-folder-window ;; resume folder window + (switch-to-buffer fld-buf))))) + (if (buffer-live-p sum-buf) + (if (setq sum-win (get-buffer-window sum-buf t)) + ;; if Summary is on the frame, select it. + (select-window sum-win) + ;; if summary is not on the frame, switch to it. + (if (and wl-stay-folder-window + (or wl-draft-resume-folder-window fld-win)) + (wl-folder-select-buffer sum-buf) + (switch-to-buffer sum-buf)))))))) (defun wl-draft-delete (editing-buffer) "kill the editing draft buffer and delete the file corresponds to it." @@ -788,14 +820,18 @@ text was killed." (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 (re-search-forward ": *" eol t))) - (if (or (not eoh) (equal here eoh)) - (goto-char bol) - (goto-char eoh))) + (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 () @@ -988,7 +1024,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) @@ -1064,7 +1103,7 @@ 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 @@ -1244,7 +1283,17 @@ 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? ")) + (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)) (let ((send-mail-function 'wl-draft-raw-send) (editing-buffer (current-buffer)) (sending-buffer (wl-draft-generate-clone-buffer @@ -1293,45 +1342,37 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (defun wl-draft-do-mime-bcc (field-body) "Send MIME-Bcc (Encapsulated blind carbon copy)." - (let ((orig-subj (std11-field-body "subject")) + (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)) - buffer) - (when (and (not wl-draft-doing-mime-bcc) ; To avoid infinite loop. - (not (zerop (length field-body)))) - (with-current-buffer (setq buffer (generate-new-buffer - " *temporary buffer for mime bcc*")) - (insert-buffer draft-buffer)) - (unwind-protect + 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) - (with-temp-buffer - (let ((wl-draft-doing-mime-bcc t) - mail-citation-hook - mail-yank-hooks - wl-draft-add-references - wl-draft-add-in-reply-to - wl-draft-cite-function) - ;; To work wl-draft-create-contents. - (setq major-mode 'wl-draft-mode) - (wl-draft-create-contents - (append `((To . ,recipient) - (From . ,wl-from) - (Subject . ,(concat "A blind carbon copy (" - orig-subj - ")"))) - (wl-draft-default-headers))) - (wl-draft-insert-required-fields) - (wl-draft-insert-mail-header-separator) - (goto-char (point-max)) - (insert (or wl-draft-mime-bcc-body - "This is a blind carbon copy.") - "\n") - (mime-edit-insert-tag "message" "rfc822") - (let ((mail-reply-buffer buffer)) - (wl-draft-yank-from-mail-reply-buffer nil)) - (mime-edit-translate-buffer) - (wl-draft-raw-send)))) - (kill-buffer buffer))))) + (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)))))))) ;; Derived from `message-save-drafts' in T-gnus. (defun wl-draft-save () @@ -1436,26 +1477,34 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (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))) (defun wl-draft-do-fcc (header-end &optional fcc-list) (let ((send-mail-buffer (current-buffer)) @@ -1513,10 +1562,6 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" 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 @@ -1537,13 +1582,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (let (buf-name header-alist-internal) (setq buf-name - (wl-draft-create-buffer - (or - (eq this-command 'wl-draft) - (eq this-command 'wl-summary-write) - (eq this-command 'wl-summary-write-current-folder) - (eq this-command 'wl-folder-write-current-folder)) - parent-folder)) + (wl-draft-create-buffer parent-folder)) (unless (cdr (assq 'From header-alist)) (setq header-alist @@ -1585,11 +1624,16 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (goto-char (point-max)))) buf-name)) -(defun wl-draft-create-buffer (&optional full parent-folder) +(defun wl-draft-create-buffer (&optional parent-folder) (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) (parent-folder (or parent-folder (wl-summary-buffer-folder-name))) (summary-buf (wl-summary-get-buffer parent-folder)) - buf-name file-name num change-major-mode-hook) + (reply-or-forward + (or (eq this-command 'wl-summary-reply) + (eq this-command 'wl-summary-forward) + (eq this-command 'wl-summary-target-mark-forward) + (eq this-command 'wl-summary-target-mark-reply-with-citation))) + buf-name file-name num change-major-mode-hook) (if (not (elmo-folder-message-file-p draft-folder)) (error "%s folder cannot be used for draft folder" wl-draft-folder)) (setq num (elmo-max-of-list @@ -1603,16 +1647,43 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (elmo-message-file-name (wl-folder-get-elmo-folder wl-draft-folder) num)))) + ;; switch-buffer according to draft buffer style. (if wl-draft-use-frame (switch-to-buffer-other-frame buf-name) - (switch-to-buffer buf-name)) + (if reply-or-forward + (case wl-draft-reply-buffer-style + (split + (split-window-vertically) + (other-window 1) + (switch-to-buffer buf-name)) + (keep + (switch-to-buffer buf-name)) + (full + (delete-other-windows) + (switch-to-buffer buf-name)) + (t + (if (functionp wl-draft-reply-buffer-style) + (funcall wl-draft-reply-buffer-style buf-name) + (error "Invalid value for wl-draft-reply-buffer-style")))) + (case wl-draft-buffer-style + (split + (when (eq major-mode 'wl-summary-mode) + (wl-summary-toggle-disp-msg 'off)) + (split-window-vertically) + (other-window 1) + (switch-to-buffer buf-name)) + (keep + (switch-to-buffer buf-name)) + (full + (delete-other-windows) + (switch-to-buffer buf-name)) + (t (if (functionp wl-draft-buffer-style) + (funcall wl-draft-buffer-style buf-name) + (error "Invalid value for wl-draft-buffer-style")))))) (set-buffer buf-name) (if (not (string-match (regexp-quote wl-draft-folder) (buffer-name))) (rename-buffer (concat wl-draft-folder "/" (int-to-string num)))) - (if (or (eq wl-draft-reply-buffer-style 'full) - full) - (delete-other-windows)) (auto-save-mode -1) (wl-draft-mode) (make-local-variable 'truncate-partial-width-windows) @@ -1622,7 +1693,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (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)) @@ -1677,7 +1748,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (error "wl-draft-create-header must be use in wl-draft-mode.")) (let (change-major-mode-hook) (wl-draft-editor-mode) - (add-hook 'local-write-file-hooks 'wl-draft-save) + (when wl-draft-write-file-function + (add-hook 'local-write-file-hooks wl-draft-write-file-function)) (wl-draft-overload-functions) (wl-highlight-headers 'for-draft) (wl-draft-save) @@ -1775,7 +1847,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (progn (insert mail-header-separator "\n") (1- (point))) - 'category 'mail-header-separator))) + 'category 'mail-header-separator) + (point))) ;;;;;;;;;;;;;;;; @@ -1833,10 +1906,15 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (setq local-variables (cdr local-variables))) (current-buffer)))) +(defun wl-draft-remove-text-plain-tag () + "Remove text/plain tag of mime-edit." + (if (looking-at "^--\\[\\[text/plain\\]\\]$") + (delete-region (point-at-bol)(1+ (point-at-eol))))) + (defun wl-draft-reedit (number) (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) (wl-draft-reedit t) - buffer file-name change-major-mode-hook) + buffer file-name change-major-mode-hook body-top) (setq file-name (elmo-message-file-name draft-folder number)) (unless (file-exists-p file-name) (error "File %s does not exist" file-name)) @@ -1849,15 +1927,28 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (switch-to-buffer buffer)) (set-buffer buffer)) (setq buffer (get-buffer-create (number-to-string number))) + ;; switch-buffer according to draft buffer style. (if wl-draft-use-frame (switch-to-buffer-other-frame buffer) - (switch-to-buffer buffer)) + (case wl-draft-buffer-style + (split + (split-window-vertically) + (other-window 1) + (switch-to-buffer buffer)) + (keep + (switch-to-buffer buffer)) + (full + (delete-other-windows) + (switch-to-buffer buffer)) + (t (if (functionp wl-draft-buffer-style) + (funcall wl-draft-buffer-style buffer) + (error "Invalid value for wl-draft-buffer-style"))))) (set-buffer buffer) (insert-file-contents-as-binary file-name) (let((mime-edit-again-ignored-field-regexp "^\\(Content-.*\\|Mime-Version\\):")) (wl-draft-decode-message-in-buffer)) - (wl-draft-insert-mail-header-separator) + (setq body-top (wl-draft-insert-mail-header-separator)) (if (not (string-match (regexp-quote wl-draft-folder) (buffer-name))) (rename-buffer (concat wl-draft-folder "/" (buffer-name)))) @@ -1874,8 +1965,10 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (goto-char (point-min)) (wl-draft-overload-functions) (wl-draft-editor-mode) - (add-hook 'local-write-file-hooks 'wl-draft-save) + (when wl-draft-write-file-function + (add-hook 'local-write-file-hooks wl-draft-write-file-function)) (wl-highlight-headers 'for-draft) + (goto-char body-top) (run-hooks 'wl-draft-reedit-hook) (goto-char (point-max)) buffer))) @@ -1897,34 +1990,41 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (beginning-of-line) (goto-char (point-max)))))) +(defsubst wl-draft-config-sub-eval-insert (content &optional newline) + (let (content-value) + (when (and content + (stringp (setq content-value (eval content)))) + (insert content-value) + (if newline (insert "\n"))))) + (defun wl-draft-config-sub-body (content) (wl-draft-body-goto-top) (delete-region (point) (point-max)) - (if content (insert (eval content)))) + (wl-draft-config-sub-eval-insert content)) (defun wl-draft-config-sub-top (content) (wl-draft-body-goto-top) - (if content (insert (eval content)))) + (wl-draft-config-sub-eval-insert content)) (defun wl-draft-config-sub-bottom (content) (wl-draft-body-goto-bottom) - (if content (insert (eval content)))) + (wl-draft-config-sub-eval-insert content)) (defun wl-draft-config-sub-header (content) (wl-draft-config-body-goto-header) - (if content (insert (concat (eval content) "\n")))) + (wl-draft-config-sub-eval-insert content 'newline)) (defun wl-draft-config-sub-header-top (content) (goto-char (point-min)) - (if content (insert (concat (eval content) "\n")))) + (wl-draft-config-sub-eval-insert content 'newline)) (defun wl-draft-config-sub-part-top (content) (goto-char (mime-edit-content-beginning)) - (if content (insert (concat (eval content) "\n")))) + (wl-draft-config-sub-eval-insert content 'newline)) (defun wl-draft-config-sub-part-bottom (content) (goto-char (mime-edit-content-end)) - (if content (insert (concat (eval content) "\n")))) + (wl-draft-config-sub-eval-insert content 'newline)) (defsubst wl-draft-config-sub-file (content) (let ((coding-system-for-read wl-cs-autoconv) @@ -2009,7 +2109,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (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)) @@ -2281,11 +2382,13 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (defun wl-draft-highlight-and-recenter (&optional n) (interactive "P") - (if wl-highlight-body-too - (let ((beg (point-min)) - (end (point-max))) - (put-text-property beg end 'face nil) - (wl-highlight-message beg end t))) + (when wl-highlight-body-too + (let ((modified (buffer-modified-p))) + (unwind-protect + (progn + (put-text-property (point-min) (point-max) 'face nil) + (wl-highlight-message (point-min) (point-max) t)) + (set-buffer-modified-p modified)))) (recenter n)) ;;;; user-agent support by Sen Nagata @@ -2337,16 +2440,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)