(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)
(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)
(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
(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)
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))
(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-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-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 (wl-draft-self-reply-p)
(if with-arg
'wl-draft-reply-myself-with-argument-list
'wl-draft-reply-myself-without-argument-list)
(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)
+ (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 (symbol-value (wl-draft-reply-list-symbol with-arg)))
(catch 'done
(while r-list
((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)
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))
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)
(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"))
;;; (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)
(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))
(defun wl-draft-insert-current-message (dummy)
(insert cite-title "\n"))
(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)
(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)
(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 ()
"Get address list suitable for smtp RCPT TO:<address>.
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)
(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
(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)
(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))))))
(defun wl-draft-mime-bcc-field ()
- "Return the MIME-Bcc field body. The field is deleted."
+ "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-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))
- buffer)
- (when (not (zerop (length field-body)))
- (setq buffer (clone-buffer " *temporary buffer for mime bcc*"))
- (unwind-protect
+ (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)
- (with-temp-buffer
- (let (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)
- (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 ()
(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))
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
(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))
;; 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
(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)
(cdar condition))
(setq condition (cdr condition)))))
(unless elmo-nntp-default-function
- (error "wl-draft-nntp-send: posting-function is nil."))
+ (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
(switch-to-buffer buffer))
(set-buffer buffer)
(insert-file-contents-as-binary file-name)
+ (elmo-delete-cr-buffer)
(let((mime-edit-again-ignored-field-regexp
"^\\(Content-.*\\|Mime-Version\\):"))
- (wl-draft-decode-message-in-buffer))
+; (wl-draft-decode-message-in-buffer))
+ ;;;; From gnus-article-mime-edit-article-setup in T-gnus
+ ;;;; XXX: it is semi issue, perhaps [wl:10790]
+ (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
+ (fset 'mime-edit-decode-single-part-in-buffer
+ (lambda (&rest args)
+ (unless (let ((content-type (car args)))
+ (eq 'text (mime-content-type-primary-type
+ content-type)))
+ (setcar (cdr args) 'not-decode-text))
+ (apply ofn args)))
+ (unwind-protect
+ (wl-draft-decode-message-in-buffer)
+ (fset 'mime-edit-decode-single-part-in-buffer ofn))))
(wl-draft-insert-mail-header-separator)
(if (not (string-match (regexp-quote wl-draft-folder)
(buffer-name)))
(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)
(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))
(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))
;;;; user-agent support by Sen Nagata
projects / elisp / wanderlust.git / blobdiff