X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=bcb09bdfa5e6f80b2bf36af44c8fbb39dd63a25c;hb=000345eadd81debeb1527fb65e46109c96fc35e0;hp=0f2f3963995b36cd3cfa8a53ca58f33ad4763882;hpb=f1be1d83dc2c8dd8838972c9869ecf781c0f1501;p=elisp%2Fwanderlust.git diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 0f2f396..bcb09bd 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -73,7 +73,19 @@ (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) @@ -190,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) @@ -212,13 +224,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 +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 @@ -240,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) @@ -260,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)) @@ -275,10 +313,14 @@ (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) @@ -293,9 +335,10 @@ 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) + (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 @@ -425,6 +468,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) @@ -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) @@ -597,7 +625,6 @@ Reply to author if WITH-ARG is non-nil." (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) @@ -659,18 +686,19 @@ Reply to author if WITH-ARG is non-nil." (buffer-live-p message-buf)) (progn (with-current-buffer summary-buf - (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))) + (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")) + (funcall wl-summary-from-function + (or from "you")) (or from "you")))))) (and cite-title (insert cite-title "\n")) @@ -709,23 +737,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." @@ -773,6 +801,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) @@ -819,7 +874,7 @@ text was killed." ",")))) "")) (id (if id (concat " id=" id) "")) - (time (wl-sendlog-time))) + (time (format-time-string "%Y/%m/%d %T"))) (insert (format "%s proto=%s stat=%s%s%s%s\n" time proto status server to id)) (if (and wl-draft-sendlog-max-size filesize @@ -954,7 +1009,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) @@ -994,18 +1052,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")) @@ -1041,7 +1088,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 @@ -1082,7 +1129,7 @@ non-nil." (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 @@ -1122,7 +1169,7 @@ 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)) ;; get fcc folders. @@ -1138,7 +1185,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) @@ -1150,14 +1201,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")) @@ -1234,12 +1285,13 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (expand-abbrev) ; for mail-abbrevs (let ((mime-header-encode-method-alist (append - '((wl-draft-eword-encode-address-list + '((wl-draft-eword-encode-address-list . (To Cc Bcc Resent-To Resent-Cc Bcc Resent-Bcc))) (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..."))) (funcall wl-draft-send-function editing-buffer kill-when-done) @@ -1250,9 +1302,6 @@ 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...") @@ -1261,9 +1310,48 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (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)))))))) + +;; Derived from `message-save-drafts' in T-gnus. (defun wl-draft-save () - "Save current draft. -Derived from `message-save-drafts' in T-gnus." + "Save current draft." (interactive) (if (buffer-modified-p) (progn @@ -1305,7 +1393,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 () @@ -1358,26 +1452,34 @@ 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))) (defun wl-draft-do-fcc (header-end &optional fcc-list) (let ((send-mail-buffer (current-buffer)) @@ -1435,10 +1537,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 @@ -1487,7 +1585,8 @@ Derived from `message-save-drafts' in T-gnus." (append header-alist (list (cons 'Subject "")))))) (setq header-alist (append header-alist (wl-draft-default-headers) - (if body (list "" body)))) + wl-draft-additional-header-alist + (if body (list "" (cons 'Body body))))) (wl-draft-create-contents header-alist) (if edit-again (wl-draft-decode-body @@ -1543,7 +1642,7 @@ Derived from `message-save-drafts' in T-gnus." (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)) @@ -1555,9 +1654,9 @@ Derived from `message-save-drafts' in T-gnus." (symbol . string) ;; insert symbol-value: string (symbol . function) ;; (funcall) and if it returns string, ;; insert symbol-value: string - (symbol . nil) ;; insert nothing - (function . (arg1 arg2 ..)) ;; call function with argument - nil ;; insert nothing + (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.")) @@ -1574,9 +1673,10 @@ Derived from `message-save-drafts' in T-gnus." (setq field (car (car halist))) (setq value (cdr (car halist))) (cond - ((functionp field) (apply field value)) ((symbolp field) (cond + ((eq field 'Body) ; body + (insert value)) ((stringp value) (insert (symbol-name field) ": " value "\n")) ((functionp value) (let ((value-return (funcall value))) @@ -1585,16 +1685,6 @@ Derived from `message-save-drafts' in T-gnus." ((not value)) (t (debug)))) - ((stringp field) - (cond - ((stringp value) (insert field value "\n")) - ((functionp value) - (let ((value-return (funcall value))) - (when (stringp value-return) - (insert field value-return "\n")))) - ((not value)) - (t - (debug)))) ;; ((not field)) (t @@ -1653,7 +1743,7 @@ Derived from `message-save-drafts' in T-gnus." (if (not (= (preceding-char) ?\n)) (insert ?\n))) -(defsubst wl-draft-insert-ccs (str cc) +(defsubst wl-draft-trim-ccs (cc) (let ((field (if (functionp cc) (funcall cc) @@ -1666,29 +1756,30 @@ Derived from `message-save-drafts' in T-gnus." (wl-parse-addresses (std11-field-body "To")) (wl-parse-addresses (std11-field-body "Cc")))) (mapcar 'downcase wl-subscribed-mailing-list))))) - (insert str field "\n")))) + field + nil))) (defsubst wl-draft-default-headers () (list - (cons "Mail-Reply-To: " (and wl-insert-mail-reply-to - (wl-address-header-extract-address - wl-from))) - (cons "" wl-generate-mailer-string-function) - (cons "Reply-To: " mail-default-reply-to) - (cons 'wl-draft-insert-ccs - (list "Bcc: " (or wl-bcc - (and mail-self-blind (user-login-name))))) - (cons 'wl-draft-insert-ccs - (list "Fcc: " wl-fcc)) - (cons "Organization: " wl-organization) + (cons 'Mail-Reply-To (and wl-insert-mail-reply-to + (wl-address-header-extract-address + wl-from))) + (cons 'User-Agent wl-generate-mailer-string-function) + (cons 'Reply-To mail-default-reply-to) + (cons 'Bcc (function + (lambda () + (wl-draft-trim-ccs + (or wl-bcc (and mail-self-blind (user-login-name))))))) + (cons 'Fcc (function + (lambda () + (wl-draft-trim-ccs wl-fcc)))) + (cons 'Organization wl-organization) (and wl-auto-insert-x-face (file-exists-p wl-x-face-file) 'wl-draft-insert-x-face-field-here) ;; allow nil mail-default-headers ;; check \n at th end of line for `mail-default-headers' 'wl-draft-check-new-line -; wl-draft-default-headers -; 'wl-draft-check-new-line )) (defun wl-draft-insert-mail-header-separator (&optional delimline) @@ -1717,12 +1808,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") @@ -1768,9 +1874,23 @@ Derived from `message-save-drafts' in T-gnus." (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))) @@ -1811,34 +1931,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) @@ -1923,7 +2050,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)) @@ -2161,26 +2289,18 @@ Derived from `message-save-drafts' in T-gnus." (interactive "P") (if arg (wl-jump-to-draft-folder) - (let ((bufs (buffer-list)) - (draft-regexp (concat - "^" (regexp-quote - (elmo-localdir-folder-directory-internal - (wl-folder-get-elmo-folder wl-draft-folder))))) - buf draft-bufs) - (while bufs - (if (and - (setq buf (with-current-buffer (car bufs) - wl-draft-buffer-file-name)) - (string-match draft-regexp buf)) - (setq draft-bufs (cons (buffer-name (car bufs)) draft-bufs))) - (setq bufs (cdr bufs))) + (let ((draft-bufs (wl-collect-draft)) + buf) (cond ((null draft-bufs) (message "No draft buffer exist.")) (t (setq draft-bufs - (sort draft-bufs (function (lambda (a b) (not (string< a b)))))) - (if (setq buf (cdr (member (buffer-name) draft-bufs))) + (sort (mapcar 'buffer-name draft-bufs) + (function (lambda (a b) + (not (string< a b)))))) + (if (setq buf (cdr (member (buffer-name) + draft-bufs))) (setq buf (car buf)) (setq buf (car draft-bufs))) (switch-to-buffer buf)))))) @@ -2203,11 +2323,13 @@ 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)))) (recenter n)) ;;;; user-agent support by Sen Nagata