X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-draft.el;h=c30d60ff59f9b211946497afda5493e7150bf20a;hb=c238906d0488b2afd5ddbfec7139d6b35adb2c72;hp=a52f558f90ef1503f08b0e9cbe1ece61aecec740;hpb=652af84d9c5abaeb3c5fc29693d21dd3813dd1bc;p=elisp%2Fwanderlust.git diff --git a/wl/wl-draft.el b/wl/wl-draft.el index a52f558..c30d60f 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -1,4 +1,4 @@ -;;; wl-draft.el -- Message draft mode for Wanderlust. +;;; wl-draft.el --- Message draft mode for Wanderlust. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Copyright (C) 1998,1999,2000 Masahiro MURATA @@ -26,10 +26,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'sendmail) (require 'wl-template) @@ -49,9 +49,11 @@ (defalias-maybe 'wl-init 'ignore) (defalias-maybe 'wl-draft-mode 'ignore)) +(eval-and-compile + (autoload 'wl-addrmgr "wl-addrmgr")) + (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) @@ -64,25 +66,30 @@ (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) (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-config-sub-func-alist - '((body . wl-draft-config-sub-body) - (top . wl-draft-config-sub-top) - (bottom . wl-draft-config-sub-bottom) - (header . wl-draft-config-sub-header) - (body-file . wl-draft-config-sub-body-file) - (top-file . wl-draft-config-sub-top-file) - (bottom-file . wl-draft-config-sub-bottom-file) - (header-file . wl-draft-config-sub-header-file) - (template . wl-draft-config-sub-template) - (x-face . wl-draft-config-sub-x-face))) + '((body . wl-draft-config-sub-body) + (top . wl-draft-config-sub-top) + (bottom . wl-draft-config-sub-bottom) + (header . wl-draft-config-sub-header) + (header-top . wl-draft-config-sub-header-top) + (header-bottom . wl-draft-config-sub-header) + (part-top . wl-draft-config-sub-part-top) + (part-bottom . wl-draft-config-sub-part-bottom) + (body-file . wl-draft-config-sub-body-file) + (top-file . wl-draft-config-sub-top-file) + (bottom-file . wl-draft-config-sub-bottom-file) + (header-file . wl-draft-config-sub-header-file) + (template . wl-draft-config-sub-template) + (x-face . wl-draft-config-sub-x-face))) (make-variable-buffer-local 'wl-draft-buffer-file-name) (make-variable-buffer-local 'wl-draft-buffer-cur-summary-buffer) @@ -91,6 +98,7 @@ (make-variable-buffer-local 'wl-sent-message-via) (make-variable-buffer-local 'wl-draft-fcc-list) (make-variable-buffer-local 'wl-draft-reply-buffer) +(make-variable-buffer-local 'wl-draft-parent-folder) (defmacro wl-smtp-extension-bind (&rest body) (` (let* ((smtp-sasl-mechanisms @@ -100,14 +108,14 @@ 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? (string-match "^\\([^@]*\\)@\\([^@]*\\)" wl-smtp-posting-user)) (setq smtp-sasl-user-name (match-string 1 wl-smtp-posting-user) - smtp-sasl-properties (list 'realm + 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)) @@ -251,7 +259,7 @@ (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 lines. Shamelessly copied from Gnus." (if (string-match wl-subject-prefix-regexp subject) (substring subject (match-end 0)) subject)) @@ -273,7 +281,9 @@ 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 - from to-alist cc-alist decoder) + from 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))) (catch 'done @@ -321,14 +331,14 @@ Reply to author if WITH-ARG is non-nil." (setq decoder (mime-find-field-decoder 'Subject 'plain)) (setq subject (if (and subject decoder) (funcall decoder subject) subject)) - (setq to-alist + (setq to-alist (mapcar (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 + (setq cc-alist (mapcar (lambda (addr) (setq decoder (mime-find-field-decoder 'Cc 'plain)) @@ -337,7 +347,7 @@ Reply to author if WITH-ARG is non-nil." cc))) (and wl-reply-subject-prefix (setq subject (concat wl-reply-subject-prefix - (wl-draft-strip-subject-re + (wl-draft-strip-subject-re (or subject ""))))) (setq in-reply-to (std11-field-body "Message-Id")) (setq references (nconc @@ -353,10 +363,18 @@ Reply to author if WITH-ARG is non-nil." (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) - newsgroups (if newsgroups (mapconcat 'identity newsgroups ","))) + (with-temp-buffer ; to keep raw buffer unibyte. + (elmo-set-buffer-multibyte default-enable-multibyte-characters) + (setq newsgroups (wl-parse newsgroups + "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)") + newsgroups (wl-delete-duplicates newsgroups) + newsgroups + (if newsgroups + (mapconcat + (lambda (grp) + (setq decoder (mime-find-field-decoder 'Newsgroups 'plain)) + (if decoder (funcall decoder grp) grp)) + newsgroups ",")))) (setq to (wl-delete-duplicates to nil t)) (setq cc (wl-delete-duplicates (append (wl-delete-duplicates cc nil t) @@ -391,32 +409,36 @@ Reply to author if WITH-ARG is non-nil." (mapconcat 'identity references "\n\t"))) (wl-draft to subject in-reply-to cc references newsgroups mail-followup-to - nil nil nil nil summary-buf) + nil nil nil nil summary-buf nil parent-folder) (setq wl-draft-reply-buffer buf)) (run-hooks 'wl-reply-hook)) (defun wl-draft-add-references () + (wl-draft-add-in-reply-to "References")) + +(defun wl-draft-add-in-reply-to (&optional alt-field) (let* ((mes-id (save-excursion - (set-buffer mail-reply-buffer) - (std11-field-body "message-id"))) - (ref (std11-field-body "References")) - (ref-list nil) (st nil)) + (set-buffer mail-reply-buffer) + (std11-field-body "message-id"))) + (field (or alt-field "In-Reply-To")) + (ref (std11-field-body field)) + (ref-list nil) (st nil)) (when (and mes-id ref) (while (string-match "<[^>]+>" ref st) - (setq ref-list - (cons (substring ref (match-beginning 0) (setq st (match-end 0))) - ref-list))) + (setq ref-list + (cons (substring ref (match-beginning 0) (setq st (match-end 0))) + ref-list))) (when (and ref-list (member mes-id ref-list)) (setq mes-id nil))) (when mes-id (save-excursion - (when (mail-position-on-field "References") - (forward-line) - (while (looking-at "^[ \t]") - (forward-line)) - (setq mes-id (concat "\t" mes-id "\n"))) - (insert mes-id)) + (when (mail-position-on-field field) + (forward-line) + (while (looking-at "^[ \t]") + (forward-line)) + (setq mes-id (concat "\t" mes-id "\n"))) + (insert mes-id)) t))) (defun wl-draft-yank-from-mail-reply-buffer (decode-it @@ -425,8 +447,7 @@ Reply to author if WITH-ARG is non-nil." (save-restriction (narrow-to-region (point)(point)) (insert - (save-excursion - (set-buffer mail-reply-buffer) + (with-current-buffer mail-reply-buffer (when decode-it (decode-mime-charset-region (point-min) (point-max) wl-mime-charset)) @@ -436,16 +457,17 @@ Reply to author if WITH-ARG is non-nil." (goto-char (point-min)) (wl-draft-delete-fields ignored-fields)) (goto-char (point-max)) - (push-mark) + (push-mark (point) nil t) (goto-char (point-min))) (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) - (when (and wl-draft-add-references - (wl-draft-add-references)) + (when (if wl-draft-add-references + (wl-draft-add-references) + (if wl-draft-add-in-reply-to + (wl-draft-add-in-reply-to))) (wl-highlight-headers 'for-draft)) ; highlight when added References: (when wl-highlight-body-too (wl-highlight-body-region beg (point-max))))) @@ -472,6 +494,7 @@ Reply to author if WITH-ARG is non-nil." (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.. @@ -491,9 +514,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) @@ -509,6 +531,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 @@ -530,8 +558,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))) @@ -540,15 +570,22 @@ Reply to author if WITH-ARG is non-nil." (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 (zerop - (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-add-references wl-draft-add-in-reply-to + 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 @@ -564,11 +601,14 @@ 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-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)))) @@ -586,19 +626,14 @@ Reply to author if WITH-ARG is non-nil." message-buf (buffer-live-p message-buf)) (progn - (save-excursion - (set-buffer summary-buf) - (setq num - (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))) + (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))) (setq cite-title (format "At %s,\n%s wrote:" (or date "some time ago") (wl-summary-from-func-internal @@ -683,7 +718,7 @@ Reply to author if WITH-ARG is non-nil." (when (and (or (eq major-mode 'wl-draft-mode) (eq major-mode 'mail-mode)) (or force-kill - (y-or-n-p "Kill Current Draft?"))) + (y-or-n-p "Kill Current Draft? "))) (let ((cur-buf (current-buffer))) (wl-draft-hide cur-buf) (wl-draft-delete cur-buf))) @@ -724,9 +759,8 @@ Reply to author if WITH-ARG is non-nil." (defun wl-draft-write-sendlog (status proto server to id) "Write send log file, if `wl-draft-sendlog' is non-nil." (when wl-draft-sendlog - (save-excursion - (let* ((tmp-buf (get-buffer-create " *wl-draft-sendlog*")) - (filename (expand-file-name wl-draft-sendlog-filename + (with-temp-buffer + (let* ((filename (expand-file-name wl-draft-sendlog-filename elmo-msgdb-dir)) (filesize (nth 7 (file-attributes filename))) (server (if server (concat " server=" server) "")) @@ -744,18 +778,15 @@ Reply to author if WITH-ARG is non-nil." "")) (id (if id (concat " id=" id) "")) (time (wl-sendlog-time))) - (set-buffer tmp-buf) - (erase-buffer) (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 (> filesize wl-draft-sendlog-max-size)) (rename-file filename (concat filename ".old") t)) (if (file-writable-p filename) - (write-region (point-min) (point-max) - filename t 'no-msg) - (message (format "%s is not writable." filename))) - (kill-buffer tmp-buf))))) + (write-region-as-binary (point-min) (point-max) + filename t 'no-msg) + (message (format "%s is not writable." filename))))))) (defun wl-draft-get-header-delimiter (&optional delete) ;; If DELETE is non-nil, replace the header delimiter with a blank line @@ -790,10 +821,10 @@ to find out how to use this." (0 (progn (wl-draft-set-sent-message 'mail 'sent) (wl-draft-write-sendlog 'ok 'qmail nil (list to) id))) - (1 (error "qmail-inject reported permanent failure")) - (111 (error "qmail-inject reported transient failure")) + (1 (error "`qmail-inject' reported permanent failure")) + (111 (error "`qmail-inject' reported transient failure")) ;; should never happen - (t (error "qmail-inject reported unknown failure")))))) + (t (error "`qmail-inject' reported unknown failure")))))) (defun wl-draft-parse-msg-id-list-string (string) "Get msg-id list from STRING." @@ -804,6 +835,22 @@ to find out how to use this." msg-id-list)))) (nreverse msg-id-list))) +(defun wl-draft-std11-parse-addresses (lal) + (let ((ret (std11-parse-address lal))) + (if ret + (let ((dest (list (car ret)))) + (setq lal (cdr ret)) + (while (and (setq ret (std11-parse-ascii-token lal)) + (string-equal (cdr (assq 'specials (car ret))) ",") + (setq ret (std11-parse-address (cdr ret))) + ) + (setq dest (cons (car ret) dest)) + (setq lal (cdr ret))) + (while (eq 'spaces (car (car lal))) + (setq lal (cdr lal))) + (if lal (error "Error while parsing address")) + (nreverse dest))))) + (defun wl-draft-parse-mailbox-list (field &optional remove-group-list) "Get mailbox list of FIELD from current buffer. The buffer is expected to be narrowed to just the headers of the message. @@ -823,7 +870,7 @@ from current buffer." (skip-chars-backward "\n") (setq seq (std11-lexical-analyze (buffer-substring-no-properties beg (point)))) - (setq addresses (std11-parse-addresses seq)) + (setq addresses (wl-draft-std11-parse-addresses seq)) (while addresses (cond ((eq (car (car addresses)) 'group) (setq has-group-list t) @@ -851,7 +898,7 @@ 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 '("to" "cc" "bcc")) (resent-fields '("resent-to" "resent-cc" "resent-bcc")) (case-fold-search t) addrs recipients) @@ -949,17 +996,18 @@ non-nil." (require 'elmo-pop3) (condition-case () (let ((session (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))))) + (luna-make-entity + 'elmo-pop3-folder + :user (or wl-pop-before-smtp-user + elmo-pop3-default-user) + :server (or wl-pop-before-smtp-server + elmo-pop3-default-server) + :port (or wl-pop-before-smtp-port + elmo-pop3-default-port) + :auth (or wl-pop-before-smtp-authenticate-type + elmo-pop3-default-authenticate-type) + :stream-type (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)) @@ -1019,11 +1067,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)) @@ -1032,11 +1080,12 @@ 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 (elmo-file-cache-get-path id) + nil))) ;; If one unplugged, append queue. (when (and unplugged-via wl-sent-message-modified) @@ -1081,14 +1130,14 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'." (defun wl-draft-send (&optional kill-when-done mes-string) "Send current draft message. -If optional argument is non-nil, current draft buffer is killed" +If KILL-WHEN-DONE is non-nil, current draft buffer is killed" (interactive) ;; Don't call this explicitly. ;; Added to 'wl-draft-send-hook (by teranisi) ;; (wl-draft-config-exec) (run-hooks 'wl-draft-send-hook) (when (or (not wl-interactive-send) - (y-or-n-p "Send current draft. OK?")) + (y-or-n-p "Do you really want to send current draft? ")) (let ((send-mail-function 'wl-draft-raw-send) (editing-buffer (current-buffer)) (sending-buffer (wl-draft-generate-clone-buffer @@ -1106,7 +1155,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 () @@ -1114,9 +1163,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...") @@ -1154,7 +1203,7 @@ If optional argument is non-nil, current draft buffer is killed" (let ((editing-buffer (current-buffer))) (wl-draft-hide editing-buffer) (kill-buffer editing-buffer))) - + (defun wl-draft-send-and-exit () "Send current draft message and kill it." (interactive) @@ -1197,7 +1246,7 @@ If optional argument is non-nil, current draft buffer is killed" (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")) + (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) @@ -1210,7 +1259,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)) @@ -1220,7 +1270,7 @@ If optional argument is non-nil, current draft buffer is killed" (tembuf (generate-new-buffer " fcc output")) (case-fold-search t) beg end) - (or (markerp header-end) (error "header-end must be a marker")) + (or (markerp header-end) (error "HEADER-END must be a marker")) (save-excursion (unless fcc-list (setq fcc-list (wl-draft-get-fcc-list header-end))) @@ -1237,13 +1287,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))) + (not wl-fcc-force-as-read)) (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))))) @@ -1278,29 +1329,33 @@ 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 parent-folder) "Write and send mail/news message with Wanderlust." (interactive) - (unless (featurep 'wl) - (require 'wl)) + (require 'wl) (unless wl-init - (wl-load-profile)) - (wl-init 'wl-draft) ;; returns immediately if already initialized. + (wl-load-profile) + (wl-folder-init) + (elmo-init) + (wl-plugged-init t)) + (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)) @@ -1311,13 +1366,17 @@ 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) + (make-local-variable 'truncate-partial-width-windows) + (setq truncate-partial-width-windows nil) + (setq truncate-lines wl-draft-truncate-lines) (setq wl-sent-message-via nil) - (if (stringp wl-from) - (insert "From: " wl-from "\n")) + (setq wl-draft-parent-folder parent-folder) + (if (stringp (or from wl-from)) + (insert "From: " (or from wl-from) "\n")) (and (or (interactive-p) (eq this-command 'wl-summary-write) to) @@ -1332,8 +1391,7 @@ 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")) @@ -1376,9 +1434,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)) @@ -1391,11 +1446,11 @@ If optional argument is non-nil, current draft buffer is killed" (run-hooks 'wl-mail-setup-hook)) (wl-user-agent-compose-internal) ;; user-agent (cond ((eq this-command 'wl-summary-write-current-newsgroup) - (mail-position-on-field "Subject")) - ((and (interactive-p) (null to)) - (mail-position-on-field "To")) - (t - (goto-char (point-max)))) + (mail-position-on-field "Subject")) + ((and (interactive-p) (null to)) + (mail-position-on-field "To")) + (t + (goto-char (point-max)))) (setq wl-draft-buffer-cur-summary-buffer (or summary-buf (get-buffer wl-summary-buffer-name))) @@ -1418,26 +1473,26 @@ 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-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-default-nntp-server - elmo-default-nntp-port)) - (elmo-nntp-post elmo-default-nntp-server (current-buffer)) + (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-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 - (std11-field-body "Newsgroups") - (std11-field-body "Message-ID"))))) + (wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server + (std11-field-body "Newsgroups") + (std11-field-body "Message-ID"))))) (defun wl-draft-generate-clone-buffer (name &optional local-variables) - "generate clone of current buffer named NAME." + "Generate clone of current buffer named NAME." (let ((editing-buffer (current-buffer))) (save-excursion (set-buffer (generate-new-buffer name)) @@ -1456,14 +1511,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)) @@ -1482,9 +1533,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) @@ -1529,6 +1577,18 @@ If optional argument is non-nil, current draft buffer is killed" (wl-draft-config-body-goto-header) (if content (insert (concat (eval content) "\n")))) +(defun wl-draft-config-sub-header-top (content) + (goto-char (point-min)) + (if content (insert (concat (eval content) "\n")))) + +(defun wl-draft-config-sub-part-top (content) + (goto-char (mime-edit-content-beginning)) + (if content (insert (concat (eval content) "\n")))) + +(defun wl-draft-config-sub-part-bottom (content) + (goto-char (mime-edit-content-end)) + (if content (insert (concat (eval content) "\n")))) + (defsubst wl-draft-config-sub-file (content) (let ((coding-system-for-read wl-cs-autoconv) (file (expand-file-name (eval content)))) @@ -1576,26 +1636,24 @@ If optional argument is non-nil, current draft buffer is killed" (while clist (setq config (car clist)) (cond + ((functionp config) + (funcall config)) ((consp config) (let ((field (car config)) (content (cdr config)) ret-val) - (cond - ((stringp field) - (wl-draft-replace-field field (eval content) t)) - ((setq ret-val (wl-draft-config-sub-func field content)) + (cond + ((stringp field) + (wl-draft-replace-field field (eval content) t)) + ((setq ret-val (wl-draft-config-sub-func field content)) (if (cdr ret-val) ;; for wl-draft-config-sub-template (wl-append local-variables (cdr ret-val)))) - ((boundp field) ;; variable - (make-local-variable field) - (set field (eval content)) - (wl-append local-variables (list field))) - (t - (error "%s: not variable" field))))) - ((or (functionp config) - (and (symbolp config) - (fboundp config))) - (funcall config)) + ((boundp field) ;; variable + (make-local-variable field) + (set field (eval content)) + (wl-append local-variables (list field))) + (t + (error "%s: not variable" field))))) (t (error "%s: not supported type" config))) (setq clist (cdr clist))) @@ -1696,7 +1754,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) @@ -1721,7 +1780,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) @@ -1755,15 +1815,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 @@ -1775,11 +1832,14 @@ 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 (progn + (elmo-folder-open-internal queue-folder) + (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)) @@ -1795,7 +1855,7 @@ If optional argument is non-nil, current draft buffer is killed" (setq msgs2 (cdr msgs2))) (when (> (setq len (length msgs)) 0) (if (elmo-y-or-n-p (format - "%d message(s) are in the sending queue. Send now?" + "%d message(s) are in the sending queue. Send now? " len) (not elmo-dop-flush-confirm) t) (progn @@ -1810,11 +1870,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)) @@ -1824,14 +1886,15 @@ 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) (message "%d message(s) are sent." performed))) (message "%d message(s) are remained to be sent." len)) + (elmo-folder-close queue-folder) len))) (defun wl-jump-to-draft-buffer (&optional arg) @@ -1842,10 +1905,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 @@ -1865,7 +1926,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) @@ -1900,11 +1962,11 @@ If optional argument is non-nil, current draft buffer is killed" "Insert HEADER-NAME w/ value HEADER-VALUE into a message." ;; it seems like overriding existing headers is acceptable -- should ;; we provide an option? - + ;; plan was: unfold header (might be folded), remove existing value, insert ;; new value ;; wl doesn't seem to fold header lines yet anyway :-) - + (let ((kill-whole-line t) end-of-line) (mail-position-on-field (capitalize header-name)) @@ -1940,8 +2002,8 @@ been implemented yet. Partial support for SWITCH-FUNCTION now supported." ;; protect these -- to and subject get bound at some point, so it looks ;; to be necessary to protect the values used w/in (let ((wl-user-agent-headers-and-body-alist other-headers) - (wl-draft-use-frame (eq switch-function 'switch-to-buffer-other-frame)) - (wl-draft-reply-buffer-style 'split)) + (wl-draft-use-frame (eq switch-function 'switch-to-buffer-other-frame)) + (wl-draft-reply-buffer-style 'split)) (when (eq switch-function 'switch-to-buffer-other-window) (when (one-window-p t) (if (window-minibuffer-p) (other-window 1))