X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=7a3f01a7f27988c49819d8381bed952eb7288c2b;hb=8b003dd16e3d4a1f0d29b5fcd0f57a2ee294f967;hp=9edf607e9cf89218f71e78f621325f0d736ed87d;hpb=b9b9d404a0912f6ee172f2adfe249823af297bcd;p=elisp%2Fwanderlust.git diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 9edf607..7a3f01a 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -41,10 +41,6 @@ (defvar x-face-add-x-face-version-header) (defvar mail-reply-buffer) (defvar mail-from-style) -(defvar smtp-authenticate-type) -(defvar smtp-authenticate-user) -(defvar smtp-authenticate-passphrase) -(defvar smtp-connection-type) (eval-when-compile (require 'elmo-pop3) @@ -54,8 +50,7 @@ (defalias-maybe 'wl-draft-mode 'ignore)) (defvar wl-draft-buf-name "Draft") -(defvar wl-caesar-region-func nil) -(defvar wl-draft-cite-func 'wl-default-draft-cite) +(defvar wl-draft-cite-function 'wl-default-draft-cite) (defvar wl-draft-buffer-file-name nil) (defvar wl-draft-field-completion-list nil) (defvar wl-draft-verbose-send t) @@ -68,7 +63,7 @@ (defvar wl-draft-sendlog-filename "sendlog") (defvar wl-draft-queue-save-filename "qinfo") (defvar wl-draft-config-save-filename "config") -(defvar wl-draft-queue-flush-send-func 'wl-draft-dispatch-message) +(defvar wl-draft-queue-flush-send-function 'wl-draft-dispatch-message) (defvar wl-sent-message-via nil) (defvar wl-sent-message-modified nil) (defvar wl-draft-fcc-list nil) @@ -96,51 +91,32 @@ (make-variable-buffer-local 'wl-draft-fcc-list) (make-variable-buffer-local 'wl-draft-reply-buffer) -;;; SMTP binding by Daiki Ueno -(defvar wl-smtp-features - '(((smtp-authenticate-type - (if wl-smtp-authenticate-type - (intern (downcase (format "%s" wl-smtp-authenticate-type))))) - ((smtp-authenticate-user wl-smtp-posting-user) - ((smtp-authenticate-passphrase - (elmo-get-passwd - (format "%s@%s" - smtp-authenticate-user - smtp-server)))))) - (smtp-connection-type)) - "Additional SMTP features.") - -(eval-when-compile - (defun wl-smtp-parse-extension (exts parents) - (let (bindings binding feature) - (dolist (ext exts) - (setq feature (if (listp (car ext)) (caar ext) (car ext)) - binding - (` ((, feature) - (or (, (if (listp (car ext)) - (cadar ext) - (let ((wl-feature - (intern - (concat "wl-" (symbol-name feature))))) - (if (boundp wl-feature) - wl-feature)))) - (and (boundp '(, feature)) (, feature)))))) - (when parents - (setcdr binding (list (append '(and) parents (cdr binding))))) - (setq bindings - (nconc bindings (list binding) - (wl-smtp-parse-extension - (cdr ext) (cons feature parents))))) - bindings))) - (defmacro wl-smtp-extension-bind (&rest body) - "Return a `let' form that binds all variables of SMTP extension. -After this is done, BODY will be executed in the scope -of the `let' form. - -The variables bound and their default values are described by -the `wl-smtp-features' variable." - (` (let* (, (wl-smtp-parse-extension wl-smtp-features nil)) + (` (let* ((smtp-sasl-mechanisms + (if wl-smtp-authenticate-type + (mapcar 'upcase + (if (listp wl-smtp-authenticate-type) + wl-smtp-authenticate-type + (list wl-smtp-authenticate-type))))) + (smtp-use-sasl (and smtp-sasl-mechanisms t)) + (smtp-use-starttls wl-smtp-connection-type) + smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase) + (if (and (string= (car smtp-sasl-mechanisms) "DIGEST-MD5") + ;; sendmail bug? + (string-match "^\\([^@]*\\)@\\([^@]*\\)" + wl-smtp-posting-user)) + (setq smtp-sasl-user-name (match-string 1 wl-smtp-posting-user) + smtp-sasl-properties (list 'realm + (match-string 2 wl-smtp-posting-user))) + (setq smtp-sasl-user-name wl-smtp-posting-user + smtp-sasl-properties nil)) + (setq sasl-read-passphrase + (function + (lambda (prompt) + (elmo-get-passwd + (format "%s@%s" + smtp-sasl-user-name + smtp-server))))) (,@ body)))) (defun wl-draft-insert-date-field () @@ -155,7 +131,7 @@ the `wl-smtp-features' variable." (fullname (user-full-name))) (cond ((eq mail-from-style 'angles) (insert "From: " fullname) - (let ((fullname-start (+ (point-min) 6)) + (let ((fullname-start (+ (point-min) (length "From: "))) (fullname-end (point-marker))) (goto-char fullname-start) ;; Look for a character that cannot appear unquoted @@ -191,11 +167,11 @@ the `wl-smtp-features' variable." (replace-match "\\1(\\3)" t) (goto-char fullname-start)))) (insert ")\n")) - ((null mail-from-style) + ((not mail-from-style) (insert "From: " login "\n"))))) (defun wl-draft-insert-x-face-field () - "Insert x-face header." + "Insert X-Face header." (interactive) (if (not (file-exists-p wl-x-face-file)) (error "File %s does not exist" wl-x-face-file) @@ -203,21 +179,21 @@ the `wl-smtp-features' variable." (search-forward mail-header-separator nil t) (beginning-of-line) (wl-draft-insert-x-face-field-here) - (run-hooks 'wl-draft-insert-x-face-field-hook) ; highlight it if you want. - )) + (run-hooks 'wl-draft-insert-x-face-field-hook))) ; highlight it if you want. (defun wl-draft-insert-x-face-field-here () - "Insert x-face field at point." + "Insert X-Face field at point." (let ((x-face-string (elmo-get-file-string wl-x-face-file))) - (if (string-match "^[ \t]*" x-face-string) - (setq x-face-string (substring x-face-string (match-end 0)))) + (when (string-match "^[ \t]*" x-face-string) + (setq x-face-string (substring x-face-string (match-end 0)))) (insert "X-Face: " x-face-string)) - (if (not (= (preceding-char) ?\n)) - (insert ?\n)) - (and (fboundp 'x-face-insert-version-header) ; x-face.el... - (boundp 'x-face-add-x-face-version-header) - x-face-add-x-face-version-header - (x-face-insert-version-header))) + (when (not (= (preceding-char) ?\n)) ; for chomped (choped) x-face-string + (insert ?\n)) + ;; Insert X-Face-Version: field + (when (and (fboundp 'x-face-insert-version-header) + (boundp 'x-face-add-x-face-version-header) + x-face-add-x-face-version-header) + (x-face-insert-version-header))) (defun wl-draft-setup () (let ((field wl-draft-fields) @@ -248,16 +224,12 @@ the `wl-smtp-features' variable." (defun wl-draft-delete-myself-from-cc (to cc) (let ((myself (or wl-user-mail-address-list (list (wl-address-header-extract-address wl-from))))) - (if wl-draft-always-delete-myself - (elmo-list-delete myself cc) - (if (elmo-list-member myself cc) - (if (elmo-list-member (append to cc) - (mapcar 'downcase wl-subscribed-mailing-list)) - ;; member list is contained in recipients. - (elmo-list-delete myself cc) - cc - ) - cc)))) + (cond (wl-draft-always-delete-myself ; always-delete option + (elmo-list-delete myself cc)) + ((elmo-list-member (append to cc) ; subscribed mailing-list + (mapcar 'downcase wl-subscribed-mailing-list)) + (elmo-list-delete myself cc)) + (t cc)))) (defun wl-draft-forward (original-subject summary-buf) (let (references) @@ -269,8 +241,8 @@ the `wl-smtp-features' variable." references (mapconcat 'identity references " ") references (wl-draft-parse-msg-id-list-string references) references (wl-delete-duplicates references) - references (if references - (mapconcat 'identity references "\n\t")))) + references (when references + (mapconcat 'identity references "\n\t")))) (wl-draft "" (concat "Forward: " original-subject) nil nil references nil nil nil nil nil nil summary-buf)) (goto-char (point-max)) @@ -283,27 +255,26 @@ the `wl-smtp-features' variable." (substring subject (match-end 0)) subject)) -(defun wl-draft-reply (buf no-arg summary-buf) - "" +(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) + "Reply to BUF buffer message. +Reply to author if WITH-ARG is non-nil." ;;;(save-excursion (let (r-list - (eword-lexical-analyzer '(eword-analyze-quoted-string - eword-analyze-domain-literal - eword-analyze-comment - eword-analyze-spaces - eword-analyze-special - eword-analyze-encoded-word - eword-analyze-atom)) to mail-followup-to cc subject in-reply-to references newsgroups - from to-alist cc-alist) + from to-alist cc-alist decoder) (set-buffer buf) - (setq from (wl-address-header-extract-address (std11-field-body "From"))) - (setq r-list - (if (wl-address-user-mail-address-p from) - (if no-arg wl-draft-reply-myself-without-argument-list - wl-draft-reply-myself-with-argument-list) - (if no-arg wl-draft-reply-without-argument-list - wl-draft-reply-with-argument-list))) + (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg))) (catch 'done (while r-list (when (let ((condition (car (car r-list)))) @@ -339,42 +310,34 @@ the `wl-smtp-features' variable." ","))) (throw 'done nil)) (setq r-list (cdr r-list))) - (error "No match field: check your `wl-draft-reply-without-argument-list'")) + (error "No match field: check your `%s'" + (symbol-name (wl-draft-reply-list-symbol with-arg)))) (setq subject (std11-field-body "Subject")) (setq to (wl-parse-addresses to) cc (wl-parse-addresses cc)) (with-temp-buffer ; to keep raw buffer unibyte. (elmo-set-buffer-multibyte default-enable-multibyte-characters) - (setq subject (or (and subject - (eword-decode-string - (decode-mime-charset-string - subject - wl-mime-charset))))) + (setq decoder (mime-find-field-decoder 'Subject 'plain)) + (setq subject (if (and subject decoder) + (funcall decoder subject) subject)) (setq to-alist (mapcar - '(lambda (addr) - (setq addr (eword-extract-address-components addr)) - (cons (nth 1 addr) - (if (nth 0 addr) - (concat - (wl-address-quote-specials (nth 0 addr)) - " <" (nth 1 addr) ">") - (nth 1 addr)))) + (lambda (addr) + (setq decoder (mime-find-field-decoder 'To 'plain)) + (cons (nth 1 (std11-extract-address-components addr)) + (if decoder (funcall decoder addr) addr))) to)) (setq cc-alist (mapcar - '(lambda (addr) - (setq addr (eword-extract-address-components addr)) - (cons (nth 1 addr) - (if (nth 0 addr) - (concat - (wl-address-quote-specials (nth 0 addr)) - " <" (nth 1 addr) ">") - (nth 1 addr)))) + (lambda (addr) + (setq decoder (mime-find-field-decoder 'Cc 'plain)) + (cons (nth 1 (std11-extract-address-components addr)) + (if decoder (funcall decoder addr) addr))) cc))) - (and subject wl-reply-subject-prefix + (and wl-reply-subject-prefix (setq subject (concat wl-reply-subject-prefix - (wl-draft-strip-subject-re subject)))) + (wl-draft-strip-subject-re + (or subject ""))))) (setq in-reply-to (std11-field-body "Message-Id")) (setq references (nconc (std11-field-bodies '("References" "In-Reply-To")) @@ -385,12 +348,10 @@ the `wl-smtp-features' variable." ;; and myself is contained in cc, ;; delete myself from cc. (setq cc (wl-draft-delete-myself-from-cc to cc)) - (if wl-insert-mail-followup-to - (progn - (setq mail-followup-to - (wl-draft-make-mail-followup-to (append to cc))) - (setq mail-followup-to (wl-delete-duplicates mail-followup-to - nil t)))) + (when wl-insert-mail-followup-to + (setq mail-followup-to + (wl-draft-make-mail-followup-to (append to cc))) + (setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t))) (setq newsgroups (wl-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)") newsgroups (wl-delete-duplicates newsgroups) @@ -444,9 +405,9 @@ the `wl-smtp-features' variable." (setq ref-list (cons (substring ref (match-beginning 0) (setq st (match-end 0))) ref-list))) - (if (and ref-list - (member mes-id ref-list)) - (setq mes-id nil))) + (when (and ref-list + (member mes-id ref-list)) + (setq mes-id nil))) (when mes-id (save-excursion (when (mail-position-on-field "References") @@ -465,9 +426,9 @@ the `wl-smtp-features' variable." (insert (save-excursion (set-buffer mail-reply-buffer) - (if decode-it - (decode-mime-charset-region (point-min) (point-max) - wl-mime-charset)) + (when decode-it + (decode-mime-charset-region (point-min) (point-max) + wl-mime-charset)) (buffer-substring-no-properties (point-min) (point-max)))) (when ignored-fields @@ -479,22 +440,22 @@ the `wl-smtp-features' variable." (let ((beg (point))) (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) (mail-yank-hooks (run-hooks 'mail-yank-hooks)) - (t (and wl-draft-cite-func - (funcall wl-draft-cite-func)))) ; default cite + (wl-draft-cite-function (funcall wl-draft-cite-function))) ; default cite (run-hooks 'wl-draft-cited-hook) - (and wl-draft-add-references - (if (wl-draft-add-references) - (wl-highlight-headers 'for-draft))) - (if wl-highlight-body-too - (wl-highlight-body-region beg (point-max))))) + (when (and wl-draft-add-references + (wl-draft-add-references)) + (wl-highlight-headers 'for-draft)) ; highlight when added References: + (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? " - (if (wl-message-mail-p) - (if (wl-message-news-p) "Mail and News" "Mail") - "News")))) + (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." @@ -528,9 +489,8 @@ the `wl-smtp-features' variable." (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 - body-beg buffer-read-only - ) + content-type content-transfer-encoding from + body-beg buffer-read-only) (set-buffer tmp-buf) (erase-buffer) (insert string) @@ -546,6 +506,12 @@ the `wl-smtp-features' variable." (decode-mime-charset-string subject wl-mime-charset)))) + (setq from (std11-field-body "From") + from (and from + (eword-decode-string + (decode-mime-charset-string + from + wl-mime-charset)))) (setq in-reply-to (std11-field-body "In-Reply-To")) (setq cc (std11-field-body "Cc")) (setq cc (and cc @@ -567,8 +533,10 @@ the `wl-smtp-features' variable." mail-followup-to content-type content-transfer-encoding (buffer-substring (point) (point-max)) - 'edit-again - )) + 'edit-again nil + (if (member (nth 1 (std11-extract-address-components from)) + wl-user-mail-address-list) + from))) (and to (mail-position-on-field "To")) (delete-other-windows) (kill-buffer tmp-buf))) @@ -577,16 +545,21 @@ the `wl-smtp-features' variable." (defun wl-draft-insert-current-message (dummy) (interactive) - (let ((mail-reply-buffer (wl-message-get-original-buffer)) + (let (original-buffer + mail-reply-buffer mail-citation-hook mail-yank-hooks - wl-draft-add-references wl-draft-cite-func) - (if (eq 0 - (save-excursion - (set-buffer mail-reply-buffer) - (buffer-size))) - (error "No current message") - (wl-draft-yank-from-mail-reply-buffer nil - wl-ignored-forwarded-headers)))) + wl-draft-add-references wl-draft-cite-function) + (with-current-buffer wl-draft-buffer-cur-summary-buffer + (with-current-buffer wl-message-buffer + (setq original-buffer (wl-message-get-original-buffer)) + (if (zerop + (with-current-buffer original-buffer + (buffer-size))) + (error "No current message")))) + (setq mail-reply-buffer original-buffer) + (wl-draft-yank-from-mail-reply-buffer + nil + wl-ignored-forwarded-headers))) (defun wl-draft-insert-get-message (dummy) (let ((fld (completing-read @@ -602,11 +575,14 @@ the `wl-smtp-features' variable." num)))) (mail-reply-buffer (get-buffer-create "*wl-draft-insert-get-message*")) mail-citation-hook mail-yank-hooks - wl-draft-cite-func) + wl-draft-cite-function) (unwind-protect (progn - (save-excursion - (elmo-read-msg-with-cache fld number mail-reply-buffer nil)) + (elmo-message-fetch (wl-folder-get-elmo-folder fld) + number + ;; No cache. + (elmo-make-fetch-strategy 'entire) + nil mail-reply-buffer) (wl-draft-yank-from-mail-reply-buffer nil)) (kill-buffer mail-reply-buffer)))) @@ -619,6 +595,7 @@ the `wl-smtp-features' variable." (summary-buf wl-current-summary-buffer) (message-buf (get-buffer (wl-current-message-buffer))) from date cite-title num entity) + (setq date (std11-fetch-field "date")) (if (and summary-buf (buffer-live-p summary-buf) message-buf @@ -630,13 +607,9 @@ the `wl-smtp-features' variable." (save-excursion (set-buffer message-buf) wl-message-buffer-cur-number)) - (setq entity (assoc (cdr (assq num - (elmo-msgdb-get-number-alist - wl-summary-buffer-msgdb))) - (elmo-msgdb-get-overview - wl-summary-buffer-msgdb))) - (setq from (elmo-msgdb-overview-entity-get-from entity)) - (setq date (elmo-msgdb-overview-entity-get-date entity))) + (setq entity (elmo-msgdb-overview-get-entity + num (wl-summary-buffer-msgdb))) + (setq from (elmo-msgdb-overview-entity-get-from entity))) (setq cite-title (format "At %s,\n%s wrote:" (or date "some time ago") (wl-summary-from-func-internal @@ -709,7 +682,7 @@ the `wl-smtp-features' variable." (let ((msg (and wl-draft-buffer-file-name (string-match "[0-9]+$" wl-draft-buffer-file-name) (string-to-int - (elmo-match-string 0 wl-draft-buffer-file-name))))) + (match-string 0 wl-draft-buffer-file-name))))) (wl-draft-config-info-operation msg 'delete)))) (set-buffer-modified-p nil) ; force kill (kill-buffer editing-buffer)))) @@ -728,11 +701,11 @@ the `wl-smtp-features' variable." (message ""))) (defun wl-draft-fcc () - "Add a new FCC field, with file name completion." + "Add a new Fcc field, with file name completion." (interactive) - (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. + (or (mail-position-on-field "fcc" t) ;Put new field after exiting Fcc. (mail-position-on-field "to")) - (insert "\nFCC: ")) + (insert "\nFcc: ")) ;; function for wl-sent-message-via @@ -835,20 +808,11 @@ to find out how to use this." (defun wl-draft-parse-msg-id-list-string (string) "Get msg-id list from STRING." - (let ((parsed (std11-parse-msg-ids-string string)) - tokens msg-id msg-id-list) - (while parsed - (setq msg-id nil) - (when (eq (car (car parsed)) 'msg-id) - (setq tokens (cdr (car parsed))) - (while tokens - (if (or (eq (car (car tokens)) 'atom) - (eq (car (car tokens)) 'specials)) - (setq msg-id (concat msg-id (cdr (car tokens))))) - (setq tokens (cdr tokens)))) - (if msg-id (setq msg-id-list (cons (concat "<" msg-id ">") - msg-id-list))) - (setq parsed (cdr parsed))) + (let (msg-id-list) + (dolist (parsed-id (std11-parse-msg-ids-string string)) + (when (eq (car parsed-id) 'msg-id) + (setq msg-id-list (cons (std11-msg-id-string parsed-id) + msg-id-list)))) (nreverse msg-id-list))) (defun wl-draft-parse-mailbox-list (field &optional remove-group-list) @@ -979,12 +943,12 @@ non-nil." (as-binary-process (when recipients (wl-smtp-extension-bind - (let ((err (smtp-via-smtp sender recipients - (current-buffer)))) - (when (not (eq err t)) - (wl-draft-write-sendlog 'failed 'smtp smtp-server - recipients id) - (error "Sending failed; SMTP protocol error:%s" err)))) + (condition-case err + (smtp-send-buffer sender recipients (current-buffer)) + (error + (wl-draft-write-sendlog 'failed 'smtp smtp-server + recipients id) + (signal (car err) (cdr err))))) (wl-draft-set-sent-message 'mail 'sent) (wl-draft-write-sendlog 'ok 'smtp smtp-server recipients id))))) @@ -995,18 +959,19 @@ non-nil." "Send the prepared message buffer with POP-before-SMTP." (require 'elmo-pop3) (condition-case () - (elmo-pop3-get-session - (list 'pop3 - (or wl-pop-before-smtp-user - elmo-default-pop3-user) - (or wl-pop-before-smtp-authenticate-type - elmo-default-pop3-authenticate-type) - (or wl-pop-before-smtp-server - elmo-default-pop3-server) - (or wl-pop-before-smtp-port - elmo-default-pop3-port) - (or wl-pop-before-smtp-stream-type - elmo-default-pop3-stream-type))) + (let ((session (elmo-pop3-get-session + (list 'pop3 + (or wl-pop-before-smtp-user + elmo-pop3-default-user) + (or wl-pop-before-smtp-authenticate-type + elmo-pop3-default-authenticate-type) + (or wl-pop-before-smtp-server + elmo-pop3-default-server) + (or wl-pop-before-smtp-port + elmo-pop3-default-port) + (or wl-pop-before-smtp-stream-type + elmo-pop3-default-stream-type))))) + (when session (elmo-network-close-session session))) (error)) (wl-draft-send-mail-with-smtp)) @@ -1065,11 +1030,11 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'." (progn (if (and (wl-message-mail-p) (not (wl-draft-sent-message-p 'mail))) - (funcall wl-draft-send-mail-func)) + (funcall wl-draft-send-mail-function)) (if (and (wl-message-news-p) (not (wl-draft-sent-message-p 'news)) (not (wl-message-field-exists-p "Resent-to"))) - (funcall wl-draft-send-news-func))) + (funcall wl-draft-send-news-function))) ;; (let* ((status (wl-draft-sent-message-results)) (unplugged-via (car status)) @@ -1078,11 +1043,11 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'." (if (and sent-via wl-draft-fcc-list) (progn (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")) - (elmo-enable-disconnected-operation t)) - (elmo-cache-save id nil nil nil)))) + (setq wl-draft-fcc-list nil))) + (if wl-draft-use-cache + (let ((id (std11-field-body "Message-ID")) + (elmo-enable-disconnected-operation t)) + (elmo-file-cache-save id nil))) ;; If one unplugged, append queue. (when (and unplugged-via wl-sent-message-modified) @@ -1152,7 +1117,7 @@ If optional argument is non-nil, current draft buffer is killed" (run-hooks 'mail-send-hook) ; translate buffer (if wl-draft-verbose-send (message (or mes-string "Sending..."))) - (funcall wl-draft-send-func editing-buffer kill-when-done) + (funcall wl-draft-send-function editing-buffer kill-when-done) ;; Now perform actions on successful sending. (while mail-send-actions (condition-case () @@ -1160,9 +1125,9 @@ If optional argument 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 (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...") @@ -1178,7 +1143,7 @@ If optional argument is non-nil, current draft buffer is killed" (wl-draft-config-info-operation (and (string-match "[0-9]+$" wl-draft-buffer-file-name) (string-to-int - (elmo-match-string 0 wl-draft-buffer-file-name))) + (match-string 0 wl-draft-buffer-file-name))) 'save)) (defun wl-draft-mimic-kill-buffer () @@ -1246,7 +1211,7 @@ If optional argument is non-nil, current draft buffer is killed" (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) + (while (re-search-forward "^Fcc:[ \t]*" header-end t) (setq fcc-list (cons (buffer-substring-no-properties (point) @@ -1256,7 +1221,8 @@ If optional argument is non-nil, current draft buffer is killed" (point))) fcc-list)) (save-match-data - (wl-folder-confirm-existence (eword-decode-string (car fcc-list)))) + (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)) @@ -1283,13 +1249,14 @@ If optional argument is non-nil, current draft buffer is killed" cache-saved) (while fcc-list (unless (or cache-saved - (elmo-folder-plugged-p (car fcc-list))) - (elmo-cache-save id nil nil nil) ;; for disconnected operation + (elmo-folder-plugged-p + (wl-folder-get-elmo-folder (car fcc-list)))) + (elmo-file-cache-save id nil) ;; for disconnected operation (setq cache-saved t)) - (if (elmo-append-msg (eword-decode-string (car fcc-list)) - (buffer-substring - (point-min) (point-max)) - id) + (if (elmo-folder-append-buffer + (wl-folder-get-elmo-folder + (eword-decode-string (car fcc-list))) + id) (wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id) (wl-draft-write-sendlog 'failed 'fcc nil (car fcc-list) id)) (setq fcc-list (cdr fcc-list))))) @@ -1324,29 +1291,31 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft (&optional to subject in-reply-to cc references newsgroups mail-followup-to content-type content-transfer-encoding - body edit-again summary-buf) + body edit-again summary-buf from) "Write and send mail/news message with Wanderlust." (interactive) (unless (featurep 'wl) (require 'wl)) (unless wl-init (wl-load-profile)) - (wl-init 'wl-draft) ;; returns immediately if already initialized. + (wl-init) ;; returns immediately if already initialized. (if (interactive-p) - (setq summary-buf (wl-summary-get-buffer wl-summary-buffer-folder-name))) - (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder)) + (setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name)))) + (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) buf-name file-name num wl-demo change-major-mode-hook) - (if (not (eq (car draft-folder-spec) 'localdir)) + (if (not (elmo-folder-message-file-p draft-folder)) (error "%s folder cannot be used for draft folder" wl-draft-folder)) - (setq num (elmo-max-of-list (or (elmo-list-folder wl-draft-folder) '(0)))) + (setq num (elmo-max-of-list + (or (elmo-folder-list-messages draft-folder) '(0)))) (setq num (+ 1 num)) ;; To get unused buffer name. (while (get-buffer (concat wl-draft-folder "/" (int-to-string num))) (setq num (+ 1 num))) (setq buf-name (find-file-noselect (setq file-name - (elmo-get-msg-filename wl-draft-folder - num)))) + (elmo-message-file-name + (wl-folder-get-elmo-folder wl-draft-folder) + num)))) (if wl-draft-use-frame (switch-to-buffer-other-frame buf-name) (switch-to-buffer buf-name)) @@ -1357,13 +1326,13 @@ If optional argument is non-nil, current draft buffer is killed" (if (or (eq wl-draft-reply-buffer-style 'full) (eq this-command 'wl-draft) (eq this-command 'wl-summary-write) - (eq this-command 'wl-summary-write-current-newsgroup)) + (eq this-command 'wl-summary-write-current-folder)) (delete-other-windows)) (auto-save-mode -1) (wl-draft-mode) (setq wl-sent-message-via nil) - (if (stringp wl-from) - (insert "From: " wl-from "\n")) + (if (stringp (or from wl-from)) + (insert "From: " (or from wl-from) "\n")) (and (or (interactive-p) (eq this-command 'wl-summary-write) to) @@ -1378,15 +1347,13 @@ If optional argument is non-nil, current draft buffer is killed" wl-from) "\n")) (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n")) (and references (insert "References: " references "\n")) - (insert (funcall wl-generate-mailer-string-func) - "\n") + (insert (funcall wl-generate-mailer-string-function) "\n") (setq wl-draft-buffer-file-name file-name) (if mail-default-reply-to (insert "Reply-To: " mail-default-reply-to "\n")) - (if (or wl-bcc mail-self-blind) - (insert "Bcc: " (or wl-bcc (user-login-name)) "\n")) - (if wl-fcc - (insert "FCC: " (if (functionp wl-fcc) (funcall wl-fcc) wl-fcc) "\n")) + (wl-draft-insert-ccs "Bcc: " (or wl-bcc + (and mail-self-blind (user-login-name)))) + (wl-draft-insert-ccs "Fcc: " wl-fcc) (if wl-organization (insert "Organization: " wl-organization "\n")) (and wl-auto-insert-x-face @@ -1402,7 +1369,7 @@ If optional argument is non-nil, current draft buffer is killed" (when content-type (insert "Content-type: " content-type "\n")) (when content-transfer-encoding - (insert "Content-Transfer-encoding: " content-transfer-encoding "\n")) + (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n")) (if (or content-type content-transfer-encoding) (insert "\n")) (and body (insert body)) @@ -1448,23 +1415,38 @@ If optional argument is non-nil, current draft buffer is killed" wl-summary-buffer-name))) buf-name)) +(defsubst wl-draft-insert-ccs (str cc) + (let ((field + (if (functionp cc) + (funcall cc) + cc))) + (if (and field + (null (and wl-draft-delete-myself-from-bcc-fcc + (elmo-list-member + (mapcar 'wl-address-header-extract-address + (append + (wl-parse-addresses (std11-field-body "To")) + (wl-parse-addresses (std11-field-body "Cc")))) + (mapcar 'downcase wl-subscribed-mailing-list))))) + (insert str field "\n")))) + (defun wl-draft-elmo-nntp-send () (let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook) - (elmo-default-nntp-user - (or wl-nntp-posting-user elmo-default-nntp-user)) - (elmo-default-nntp-server - (or wl-nntp-posting-server elmo-default-nntp-server)) - (elmo-default-nntp-port - (or wl-nntp-posting-port elmo-default-nntp-port)) - (elmo-default-nntp-stream-type - (or wl-nntp-posting-stream-type elmo-default-nntp-stream-type))) - (if (not (elmo-plugged-p elmo-default-nntp-server elmo-default-nntp-port)) + (elmo-nntp-default-user + (or wl-nntp-posting-user elmo-nntp-default-user)) + (elmo-nntp-default-server + (or wl-nntp-posting-server elmo-nntp-default-server)) + (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))) + (if (not (elmo-plugged-p elmo-nntp-default-server elmo-nntp-default-port)) (wl-draft-set-sent-message 'news 'unplugged - (cons elmo-default-nntp-server - elmo-default-nntp-port)) - (elmo-nntp-post elmo-default-nntp-server (current-buffer)) + (cons elmo-nntp-default-server + elmo-nntp-default-port)) + (elmo-nntp-post elmo-nntp-default-server (current-buffer)) (wl-draft-set-sent-message 'news 'sent) - (wl-draft-write-sendlog 'ok 'nntp elmo-default-nntp-server + (wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server (std11-field-body "Newsgroups") (std11-field-body "Message-ID"))))) @@ -1488,14 +1470,10 @@ If optional argument is non-nil, current draft buffer is killed" (current-buffer)))) (defun wl-draft-reedit (number) - (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder)) + (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) (wl-draft-reedit t) buf-name file-name change-major-mode-hook) - (setq file-name (expand-file-name - (int-to-string number) - (expand-file-name - (nth 1 draft-folder-spec) - elmo-localdir-folder-path))) + (setq file-name (elmo-message-file-name draft-folder number)) (unless (file-exists-p file-name) (error "File %s does not exist" file-name)) (setq buf-name (find-file-noselect file-name)) @@ -1728,7 +1706,8 @@ If optional argument is non-nil, current draft buffer is killed" (insert (concat field ": " content "\n")))))))) (defun wl-draft-config-info-operation (msg operation) - (let* ((msgdb-dir (elmo-msgdb-expand-path wl-draft-folder)) + (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-folder-get-elmo-folder + wl-draft-folder))) (filename (expand-file-name (format "%s-%d" wl-draft-config-save-filename msg) @@ -1753,7 +1732,8 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft-queue-info-operation (msg operation &optional add-sent-message-via) - (let* ((msgdb-dir (elmo-msgdb-expand-path wl-queue-folder)) + (let* ((msgdb-dir (elmo-folder-msgdb-path + (wl-folder-get-elmo-folder wl-queue-folder))) (filename (expand-file-name (format "%s-%d" wl-draft-queue-save-filename msg) @@ -1787,15 +1767,12 @@ If optional argument is non-nil, current draft buffer is killed" (if wl-draft-verbose-send (message "Queuing...")) (let ((send-buffer (current-buffer)) + (folder (wl-folder-get-elmo-folder wl-queue-folder)) (message-id (std11-field-body "Message-ID"))) - (if (elmo-append-msg wl-queue-folder - (buffer-substring (point-min) (point-max)) - message-id) + (if (elmo-folder-append-buffer folder t) (progn - (if message-id - (elmo-dop-lock-message message-id)) (wl-draft-queue-info-operation - (car (elmo-max-of-folder wl-queue-folder)) + (car (elmo-folder-status folder)) 'save wl-sent-message-via) (wl-draft-write-sendlog 'ok 'queue nil wl-queue-folder message-id) (when wl-draft-verbose-send @@ -1807,11 +1784,12 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft-queue-flush () "Flush draft queue." (interactive) - (let ((msgs2 (elmo-list-folder wl-queue-folder)) - (i 0) - (performed 0) - (wl-draft-queue-flushing t) - msgs failure len buffer msgid sent-via) + (let* ((queue-folder (wl-folder-get-elmo-folder wl-queue-folder)) + (msgs2 (elmo-folder-list-messages queue-folder)) + (i 0) + (performed 0) + (wl-draft-queue-flushing t) + msgs failure len buffer msgid sent-via) ;; get plugged send message (while msgs2 (setq sent-via (wl-draft-queue-info-operation (car msgs2) 'get-sent-via)) @@ -1842,11 +1820,13 @@ If optional argument is non-nil, current draft buffer is killed" failure nil) (setq wl-sent-message-via nil) (wl-draft-queue-info-operation (car msgs) 'load) - (elmo-read-msg-no-cache wl-queue-folder (car msgs) - (current-buffer)) + (elmo-message-fetch queue-folder + (car msgs) + (elmo-make-fetch-strategy 'entire) + nil (current-buffer)) (condition-case err (setq failure (funcall - wl-draft-queue-flush-send-func + wl-draft-queue-flush-send-function (format "Sending (%d/%d)..." i len))) ;;; (wl-draft-raw-send nil nil ;;; (format "Sending (%d/%d)..." i len)) @@ -1856,9 +1836,9 @@ If optional argument is non-nil, current draft buffer is killed" (quit (setq failure t))) (unless failure - (elmo-delete-msgs wl-queue-folder (cons (car msgs) nil)) + (elmo-folder-delete-messages + queue-folder (cons (car msgs) nil)) (wl-draft-queue-info-operation (car msgs) 'delete) - (elmo-dop-unlock-message (std11-field-body "Message-ID")) (setq performed (+ 1 performed))) (setq msgs (cdr msgs))) (kill-buffer buffer) @@ -1874,10 +1854,8 @@ If optional argument is non-nil, current draft buffer is killed" (let ((bufs (buffer-list)) (draft-regexp (concat "^" (regexp-quote - (expand-file-name - (nth 1 (elmo-folder-get-spec wl-draft-folder)) - (expand-file-name - elmo-localdir-folder-path))))) + (elmo-localdir-folder-directory-internal + (wl-folder-get-elmo-folder wl-draft-folder))))) buf draft-bufs) (while bufs (if (and @@ -1897,7 +1875,8 @@ If optional argument is non-nil, current draft buffer is killed" (switch-to-buffer buf)))))) (defun wl-jump-to-draft-folder () - (let ((msgs (reverse (elmo-list-folder wl-draft-folder))) + (let ((msgs (reverse (elmo-folder-list-messages (wl-folder-get-elmo-folder + wl-draft-folder)))) (mybuf (buffer-name)) msg buf) (if (not msgs)