X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=8c5a236d74ad28604748f3a84792355e0a1e7642;hb=bd1c7daca8de303dd5766cb7831e964cfe3a03c5;hp=0c32b6cb69c88dbda6cc5d8c4ce6398777a7b54b;hpb=a962474ce9081a6a6e143894483f2dc69b2e26c4;p=elisp%2Fwanderlust.git diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 0c32b6c..8c5a236 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -73,9 +73,26 @@ (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) (top . wl-draft-config-sub-top) @@ -101,6 +118,7 @@ (make-variable-buffer-local 'wl-draft-fcc-list) (make-variable-buffer-local 'wl-draft-reply-buffer) (make-variable-buffer-local 'wl-draft-parent-folder) +(make-variable-buffer-local 'wl-draft-parent-number) (defsubst wl-smtp-password-key (user mechanism server) (format "SMTP:%s/%s@%s" @@ -143,55 +161,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) @@ -237,7 +218,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 +235,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 +265,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)) @@ -279,33 +278,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)))) @@ -314,8 +308,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) @@ -335,7 +336,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)) @@ -348,8 +349,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 +435,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,9 +446,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")) @@ -504,15 +528,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 +549,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 +609,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) @@ -660,34 +666,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 - (funcall wl-summary-from-function - (or from "you")) - (or from "you")))))) - (and cite-title - (insert cite-title "\n")) + date from cite-title) + (save-restriction + (if (< (mark t) (point)) + (exchange-point-and-mark)) + (narrow-to-region (point)(point-max)) + (setq date (std11-field-body "date") + from (std11-field-body "from"))) + (when (or date from) + (insert (format "At %s,\n%s wrote:\n" + (or date "some time ago") + (if wl-default-draft-cite-decorate-author + (funcall wl-summary-from-function + (or from "you")) + (or from "you"))))) (mail-indent-citation))) -(defvar wl-draft-buffer nil "Draft buffer to yank content") +(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) @@ -701,6 +696,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) @@ -720,26 +716,26 @@ 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) @@ -764,6 +760,23 @@ Reply to author if WITH-ARG is non-nil." (or force-kill (y-or-n-p "Kill Current Draft? "))) (let ((cur-buf (current-buffer))) + (when (and wl-draft-parent-number + (not (string= wl-draft-parent-folder ""))) + (let* ((number wl-draft-parent-number) + (folder-name wl-draft-parent-folder) + (folder (wl-folder-get-elmo-folder folder-name)) + buffer) + (if (and (setq buffer (wl-summary-get-buffer folder-name)) + (with-current-buffer buffer + (string= (wl-summary-buffer-folder-name) + folder-name))) + (with-current-buffer buffer + (elmo-folder-unmark-answered folder (list number)) + (when (wl-summary-jump-to-msg number) + (wl-summary-update-persistent-mark))) + (elmo-folder-open folder 'load-msgdb) + (elmo-folder-unmark-answered folder (list number)) + (elmo-folder-close folder)))) (wl-draft-hide cur-buf) (wl-draft-delete cur-buf))) (message ""))) @@ -788,14 +801,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 +1005,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,12 +1084,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 @@ -1126,15 +1150,24 @@ If FORCE-MSGID, insert message-id regardless of `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 @@ -1147,7 +1180,7 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'." "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 @@ -1205,10 +1238,11 @@ If FORCE-MSGID, insert message-id regardless of `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) @@ -1235,6 +1269,48 @@ If FORCE-MSGID, insert message-id regardless of `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 + (message "Send current draft?