(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)
(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)
(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
(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)
(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)
(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)
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))
(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
- (mime-header-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))
- eword-lexical-analyzer
to mail-followup-to cc subject in-reply-to references newsgroups
- from to-alist cc-alist)
- (setq eword-lexical-analyzer mime-header-lexical-analyzer)
+ 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))))
",")))
(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"))
;; 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)
(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")
(save-restriction
(narrow-to-region (point)(point))
(insert
- (save-excursion
- (set-buffer mail-reply-buffer)
- (if decode-it
- (decode-mime-charset-region (point-min) (point-max)
- wl-mime-charset))
+ (with-current-buffer mail-reply-buffer
+ (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
(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."
(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..
(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)
(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
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)))
(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
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))))
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
(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))))
(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
(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-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.
(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)
(let ((session (elmo-pop3-get-session
(list 'pop3
(or wl-pop-before-smtp-user
- elmo-default-pop3-user)
+ elmo-pop3-default-user)
(or wl-pop-before-smtp-authenticate-type
- elmo-default-pop3-authenticate-type)
+ elmo-pop3-default-authenticate-type)
(or wl-pop-before-smtp-server
- elmo-default-pop3-server)
+ elmo-pop3-default-server)
(or wl-pop-before-smtp-port
- elmo-default-pop3-port)
+ elmo-pop3-default-port)
(or wl-pop-before-smtp-stream-type
- elmo-default-pop3-stream-type)))))
+ elmo-pop3-default-stream-type)))))
(when session (elmo-network-close-session session)))
(error))
(wl-draft-send-mail-with-smtp))
(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))
(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)
(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 ()
(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...")
(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 ()
(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)
(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))
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)))))
(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-load-profile)
+ (elmo-init)
+ (wl-folder-init))
+ (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))
(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)
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
(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))
(1- (point)))
'category 'mail-header-separator)
(and body (insert body)))
- (if wl-on-nemacs
- (push-mark (point) t)
- (push-mark (point) t t))
+ (push-mark (point) t t)
(as-binary-output-file
(write-region (point-min)(point-max) wl-draft-buffer-file-name
nil t))
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")))))
(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))
(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))
+ (push-mark (point) t t)
(write-region (point-min)(point-max) wl-draft-buffer-file-name
nil t)
(wl-draft-overload-functions)
(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)))
(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)
(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)
(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
(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))
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))
(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)
(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
(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)