X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=3a6b4a9f6f8978f19488214ca65b05dd36510d4b;hb=c4307b2ed04d217b761bae0f87b5b29fcc752c2b;hp=1a3eb72e079ee0afed00c7c80479128edbbce240;hpb=3f2dfdd6ad6bf746a84d80aa3ab8a7a3ccc9df8e;p=elisp%2Fwanderlust.git diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 1a3eb72..3a6b4a9 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -50,7 +50,8 @@ (defalias-maybe 'wl-draft-mode 'ignore)) (defvar wl-draft-buf-name "Draft") -(defvar wl-draft-cite-function 'wl-default-draft-cite) +(defvar wl-caesar-region-func nil) +(defvar wl-draft-cite-func 'wl-default-draft-cite) (defvar wl-draft-buffer-file-name nil) (defvar wl-draft-field-completion-list nil) (defvar wl-draft-verbose-send t) @@ -63,7 +64,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-function 'wl-draft-dispatch-message) +(defvar wl-draft-queue-flush-send-func 'wl-draft-dispatch-message) (defvar wl-sent-message-via nil) (defvar wl-sent-message-modified nil) (defvar wl-draft-fcc-list nil) @@ -99,7 +100,7 @@ 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-use-starttls (eq wl-smtp-connection-type 'starttls)) smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase) (if (and (string= (car smtp-sasl-mechanisms) "DIGEST-MD5") ;; sendmail bug? @@ -173,13 +174,13 @@ (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) - (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. + (unless (file-exists-p wl-x-face-file) + (error "File %s does not exist" wl-x-face-file)) + (beginning-of-buffer) + (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. (defun wl-draft-insert-x-face-field-here () "Insert X-Face field at point." @@ -440,7 +441,8 @@ Reply to author if WITH-ARG is non-nil." (let ((beg (point))) (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) (mail-yank-hooks (run-hooks 'mail-yank-hooks)) - (wl-draft-cite-function (funcall wl-draft-cite-function))) ; default cite + (t (and wl-draft-cite-func + (funcall wl-draft-cite-func)))) ; default cite (run-hooks 'wl-draft-cited-hook) (when (and wl-draft-add-references (wl-draft-add-references)) @@ -451,15 +453,11 @@ Reply to author if WITH-ARG is non-nil." (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")) + (y-or-n-p + (cond ((and (wl-message-mail-p) (wl-message-news-p)) + "Send current draft as Mail and News? ") + ((wl-message-mail-p) "Send current draft as Mail? ") + ((wl-message-news-p) "Send current draft as News? ")))) (defun wl-message-field-exists-p (field) "If FIELD exist and FIELD value is not empty, return non-nil." @@ -467,9 +465,14 @@ Reply to author if WITH-ARG is non-nil." (and value (not (string= value ""))))) +(defun wl-message-news-p () + "If exist valid Newsgroups field, return non-nil." + (std11-field-body "Newsgroups")) + (defun wl-message-mail-p () "If exist To, Cc or Bcc field, return non-nil." (or (wl-message-field-exists-p "To") + (wl-message-field-exists-p "Resent-to") (wl-message-field-exists-p "Cc") (wl-message-field-exists-p "Bcc") ;;; This may be needed.. @@ -489,9 +492,8 @@ Reply to author if WITH-ARG is non-nil." (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) @@ -507,6 +509,12 @@ Reply to author if WITH-ARG is non-nil." (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 @@ -528,8 +536,10 @@ Reply to author if WITH-ARG is non-nil." 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))) @@ -538,19 +548,15 @@ Reply to author if WITH-ARG is non-nil." (defun wl-draft-insert-current-message (dummy) (interactive) - (let (mail-reply-buffer + (let ((mail-reply-buffer (wl-message-get-original-buffer)) mail-citation-hook mail-yank-hooks - wl-draft-add-references wl-draft-cite-function) - (with-current-buffer wl-draft-buffer-cur-summary-buffer - (with-current-buffer wl-message-buffer - (setq mail-reply-buffer (wl-message-get-original-buffer)))) + wl-draft-add-references wl-draft-cite-func) (if (zerop - (with-current-buffer mail-reply-buffer - (buffer-size))) + (with-current-buffer mail-reply-buffer + (buffer-size))) (error "No current message") - (wl-draft-yank-from-mail-reply-buffer - nil - wl-ignored-forwarded-headers)))) + (wl-draft-yank-from-mail-reply-buffer nil + wl-ignored-forwarded-headers)))) (defun wl-draft-insert-get-message (dummy) (let ((fld (completing-read @@ -566,14 +572,11 @@ Reply to author if WITH-ARG is non-nil." num)))) (mail-reply-buffer (get-buffer-create "*wl-draft-insert-get-message*")) mail-citation-hook mail-yank-hooks - wl-draft-cite-function) + wl-draft-cite-func) (unwind-protect (progn - (elmo-message-fetch (wl-folder-get-elmo-folder fld) - number - ;; No cache. - (elmo-make-fetch-strategy 'entire) - nil mail-reply-buffer) + (save-excursion + (elmo-read-msg-with-cache fld number mail-reply-buffer nil)) (wl-draft-yank-from-mail-reply-buffer nil)) (kill-buffer mail-reply-buffer)))) @@ -597,8 +600,11 @@ Reply to author if WITH-ARG is non-nil." (save-excursion (set-buffer message-buf) wl-message-buffer-cur-number)) - (setq entity (elmo-msgdb-overview-get-entity - num (wl-summary-buffer-msgdb))) + (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 cite-title (format "At %s,\n%s wrote:" @@ -953,15 +959,15 @@ non-nil." (let ((session (elmo-pop3-get-session (list 'pop3 (or wl-pop-before-smtp-user - elmo-pop3-default-user) + elmo-default-pop3-user) (or wl-pop-before-smtp-authenticate-type - elmo-pop3-default-authenticate-type) + elmo-default-pop3-authenticate-type) (or wl-pop-before-smtp-server - elmo-pop3-default-server) + elmo-default-pop3-server) (or wl-pop-before-smtp-port - elmo-pop3-default-port) + elmo-default-pop3-port) (or wl-pop-before-smtp-stream-type - elmo-pop3-default-stream-type))))) + elmo-default-pop3-stream-type))))) (when session (elmo-network-close-session session))) (error)) (wl-draft-send-mail-with-smtp)) @@ -1021,11 +1027,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-function)) + (funcall wl-draft-send-mail-func)) (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-function))) + (funcall wl-draft-send-news-func))) ;; (let* ((status (wl-draft-sent-message-results)) (unplugged-via (car status)) @@ -1038,7 +1044,7 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'." (if wl-draft-use-cache (let ((id (std11-field-body "Message-ID")) (elmo-enable-disconnected-operation t)) - (elmo-file-cache-save id nil))) + (elmo-cache-save id nil nil nil))) ;; If one unplugged, append queue. (when (and unplugged-via wl-sent-message-modified) @@ -1108,7 +1114,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-function editing-buffer kill-when-done) + (funcall wl-draft-send-func editing-buffer kill-when-done) ;; Now perform actions on successful sending. (while mail-send-actions (condition-case () @@ -1212,8 +1218,7 @@ If optional argument is non-nil, current draft buffer is killed" (point))) fcc-list)) (save-match-data - (wl-folder-confirm-existence - (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list))))) + (wl-folder-confirm-existence (eword-decode-string (car fcc-list)))) (delete-region (match-beginning 0) (progn (forward-line 1) (point))))) fcc-list)) @@ -1240,14 +1245,13 @@ If optional argument is non-nil, current draft buffer is killed" cache-saved) (while fcc-list (unless (or cache-saved - (elmo-folder-plugged-p - (wl-folder-get-elmo-folder (car fcc-list)))) - (elmo-file-cache-save id nil) ;; for disconnected operation + (elmo-folder-plugged-p (car fcc-list))) + (elmo-cache-save id nil nil nil) ;; for disconnected operation (setq cache-saved t)) - (if (elmo-folder-append-buffer - (wl-folder-get-elmo-folder - (eword-decode-string (car fcc-list))) - id) + (if (elmo-append-msg (eword-decode-string (car fcc-list)) + (buffer-substring + (point-min) (point-max)) + 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))))) @@ -1274,15 +1278,11 @@ If optional argument is non-nil, current draft buffer is killed" nil (if (re-search-forward ":" pos t) nil t))))))) -(defun wl-draft-random-alphabet () - (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z))) - (nth (abs (% (random) 26)) alphabet))) - ;;;###autoload (defun wl-draft (&optional 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) @@ -1291,22 +1291,20 @@ If optional argument is non-nil, current draft buffer is killed" (wl-load-profile)) (wl-init 'wl-draft) ;; returns immediately if already initialized. (if (interactive-p) - (setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name)))) - (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) + (setq summary-buf (wl-summary-get-buffer wl-summary-buffer-folder-name))) + (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder)) buf-name file-name num wl-demo change-major-mode-hook) - (if (not (elmo-folder-message-file-p draft-folder)) + (if (not (eq (car draft-folder-spec) 'localdir)) (error "%s folder cannot be used for draft folder" wl-draft-folder)) - (setq num (elmo-max-of-list - (or (elmo-folder-list-messages draft-folder) '(0)))) + (setq num (elmo-max-of-list (or (elmo-list-folder wl-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-message-file-name - (wl-folder-get-elmo-folder wl-draft-folder) - num)))) + (elmo-get-msg-filename wl-draft-folder + num)))) (if wl-draft-use-frame (switch-to-buffer-other-frame buf-name) (switch-to-buffer buf-name)) @@ -1317,13 +1315,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) @@ -1338,7 +1336,8 @@ 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-function) "\n") + (insert (funcall wl-generate-mailer-string-func) + "\n") (setq wl-draft-buffer-file-name file-name) (if mail-default-reply-to (insert "Reply-To: " mail-default-reply-to "\n")) @@ -1381,9 +1380,6 @@ If optional argument is non-nil, current draft buffer is killed" (1- (point))) 'category 'mail-header-separator) (and body (insert body))) - (if wl-on-nemacs - (push-mark (point) t) - (push-mark (point) t t)) (as-binary-output-file (write-region (point-min)(point-max) wl-draft-buffer-file-name nil t)) @@ -1423,21 +1419,21 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft-elmo-nntp-send () (let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook) - (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)) + (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)) (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)) + (cons elmo-default-nntp-server + elmo-default-nntp-port)) + (elmo-nntp-post elmo-default-nntp-server (current-buffer)) (wl-draft-set-sent-message 'news 'sent) - (wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server + (wl-draft-write-sendlog 'ok 'nntp elmo-default-nntp-server (std11-field-body "Newsgroups") (std11-field-body "Message-ID"))))) @@ -1461,10 +1457,14 @@ If optional argument is non-nil, current draft buffer is killed" (current-buffer)))) (defun wl-draft-reedit (number) - (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) + (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder)) (wl-draft-reedit t) buf-name file-name change-major-mode-hook) - (setq file-name (elmo-message-file-name draft-folder number)) + (setq file-name (expand-file-name + (int-to-string number) + (expand-file-name + (nth 1 draft-folder-spec) + elmo-localdir-folder-path))) (unless (file-exists-p file-name) (error "File %s does not exist" file-name)) (setq buf-name (find-file-noselect file-name)) @@ -1483,9 +1483,6 @@ If optional argument is non-nil, current draft buffer is killed" (goto-char (point-min)) (or (re-search-forward "\n\n" nil t) (search-forward (concat mail-header-separator "\n") nil t)) - (if wl-on-nemacs - (push-mark (point) t) - (push-mark (point) t t)) (write-region (point-min)(point-max) wl-draft-buffer-file-name nil t) (wl-draft-overload-functions) @@ -1697,8 +1694,7 @@ 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-folder-msgdb-path (wl-folder-get-elmo-folder - wl-draft-folder))) + (let* ((msgdb-dir (elmo-msgdb-expand-path wl-draft-folder)) (filename (expand-file-name (format "%s-%d" wl-draft-config-save-filename msg) @@ -1723,8 +1719,7 @@ 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-folder-msgdb-path - (wl-folder-get-elmo-folder wl-queue-folder))) + (let* ((msgdb-dir (elmo-msgdb-expand-path wl-queue-folder)) (filename (expand-file-name (format "%s-%d" wl-draft-queue-save-filename msg) @@ -1758,12 +1753,15 @@ 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-folder-append-buffer folder t) + (if (elmo-append-msg wl-queue-folder + (buffer-substring (point-min) (point-max)) + message-id) (progn + (if message-id + (elmo-dop-lock-message message-id)) (wl-draft-queue-info-operation - (car (elmo-folder-status folder)) + (car (elmo-max-of-folder wl-queue-folder)) 'save wl-sent-message-via) (wl-draft-write-sendlog 'ok 'queue nil wl-queue-folder message-id) (when wl-draft-verbose-send @@ -1775,12 +1773,11 @@ If optional argument is non-nil, current draft buffer is killed" (defun wl-draft-queue-flush () "Flush draft queue." (interactive) - (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) + (let ((msgs2 (elmo-list-folder wl-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)) @@ -1811,13 +1808,11 @@ 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-message-fetch queue-folder - (car msgs) - (elmo-make-fetch-strategy 'entire) - nil (current-buffer)) + (elmo-read-msg-no-cache wl-queue-folder (car msgs) + (current-buffer)) (condition-case err (setq failure (funcall - wl-draft-queue-flush-send-function + wl-draft-queue-flush-send-func (format "Sending (%d/%d)..." i len))) ;;; (wl-draft-raw-send nil nil ;;; (format "Sending (%d/%d)..." i len)) @@ -1827,9 +1822,9 @@ If optional argument is non-nil, current draft buffer is killed" (quit (setq failure t))) (unless failure - (elmo-folder-delete-messages - queue-folder (cons (car msgs) nil)) + (elmo-delete-msgs wl-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) @@ -1845,8 +1840,10 @@ If optional argument is non-nil, current draft buffer is killed" (let ((bufs (buffer-list)) (draft-regexp (concat "^" (regexp-quote - (elmo-localdir-folder-directory-internal - (wl-folder-get-elmo-folder wl-draft-folder))))) + (expand-file-name + (nth 1 (elmo-folder-get-spec wl-draft-folder)) + (expand-file-name + elmo-localdir-folder-path))))) buf draft-bufs) (while bufs (if (and @@ -1866,8 +1863,7 @@ 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-folder-list-messages (wl-folder-get-elmo-folder - wl-draft-folder)))) + (let ((msgs (reverse (elmo-list-folder wl-draft-folder))) (mybuf (buffer-name)) msg buf) (if (not msgs)