-;;; wl-draft.el -- Message draft mode for Wanderlust.
+;;; wl-draft.el --- Message draft mode for Wanderlust.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'sendmail)
(require 'wl-template)
(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-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-sent-message-queued 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)
(make-variable-buffer-local 'wl-draft-config-variables)
(make-variable-buffer-local 'wl-draft-config-exec-flag)
(make-variable-buffer-local 'wl-sent-message-via)
+(make-variable-buffer-local 'wl-sent-message-queued)
(make-variable-buffer-local 'wl-draft-fcc-list)
(make-variable-buffer-local 'wl-draft-reply-buffer)
+(make-variable-buffer-local 'wl-draft-parent-folder)
+
+(defsubst wl-smtp-password-key (user mechanism server)
+ (format "SMTP:%s/%s@%s"
+ user mechanism server))
(defmacro wl-smtp-extension-bind (&rest body)
(` (let* ((smtp-sasl-mechanisms
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))
(function
(lambda (prompt)
(elmo-get-passwd
- (format "%s@%s"
- smtp-sasl-user-name
- smtp-server)))))
+ (wl-smtp-password-key
+ smtp-sasl-user-name
+ (car smtp-sasl-mechanisms)
+ smtp-server)))))
(,@ body))))
(defun wl-draft-insert-date-field ()
(defun wl-draft-insert-x-face-field ()
"Insert X-Face header."
(interactive)
- (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.
+ (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.
(defun wl-draft-insert-x-face-field-here ()
"Insert X-Face field at point."
(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))
;;;(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
(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))
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
(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)
(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
(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))
(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)))))
(defun wl-draft-confirm ()
"Confirm send message."
(interactive)
- (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? "))))
+ (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"))
(defun wl-message-field-exists-p (field)
"If FIELD exist and FIELD value is not empty, return 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..
(wl-draft-edit-string (elmo-get-file-string
(or file
(read-file-name "File to edit: "
- (or wl-tmp-dir "~/"))))))
+ (or wl-temporary-file-directory
+ "~/"))))))
(defun wl-draft-edit-string (string)
(let ((cur-buf (current-buffer))
(tmp-buf (get-buffer-create " *wl-draft-edit-string*"))
to subject in-reply-to cc references newsgroups mail-followup-to
- content-type content-transfer-encoding
- 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 (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
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
- (or from "you"))))))
+ (if wl-default-draft-cite-decorate-author
+ (wl-summary-from-func-internal
+ (or from "you"))
+ (or from "you"))))))
(and cite-title
(insert cite-title "\n"))
(mail-indent-citation)))
(defun wl-draft-hide (editing-buffer)
"Hide the editing draft buffer if possible."
- (interactive)
(when (and editing-buffer
(buffer-live-p editing-buffer))
(set-buffer editing-buffer)
(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)))
(mail-position-on-field "to"))
(insert "\nFcc: "))
+;; Imported from message.el.
+(defun wl-draft-elide-region (b e)
+ "Elide the text in the region.
+An ellipsis (from `wl-draft-elide-ellipsis') will be inserted where the
+text was killed."
+ (interactive "r")
+ (kill-region b e)
+ (insert wl-draft-elide-ellipsis))
+
;; function for wl-sent-message-via
(defmacro wl-draft-sent-message-p (type)
(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
- elmo-msgdb-dir))
+ (with-temp-buffer
+ (let* ((filename (expand-file-name wl-draft-sendlog-filename
+ elmo-msgdb-directory))
(filesize (nth 7 (file-attributes filename)))
(server (if server (concat " server=" server) ""))
(to (if to (cond
""))
(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 "%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
(not (elmo-plugged-p)))
(wl-draft-set-sent-message 'mail 'unplugged)
;; send the message
+ (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(let ((id (std11-field-body "Message-ID"))
(to (std11-field-body "To")))
(case
(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."
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)
"Get address list suitable for smtp RCPT TO:<address>.
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)
(goto-char (1+ delimline))
(if (eval mail-mailer-swallows-blank-line)
(newline))
-;;; (run-hooks 'wl-mail-send-pre-hook)
+ (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(if mail-interactive
(save-excursion
(set-buffer errbuf)
(error
(wl-draft-write-sendlog 'failed 'smtp smtp-server
recipients id)
+ (if (/= (nth 1 err) 334)
+ (elmo-remove-passwd
+ (wl-smtp-password-key
+ smtp-sasl-user-name
+ (car smtp-sasl-mechanisms)
+ smtp-server)))
(signal (car err) (cdr err)))))
(wl-draft-set-sent-message 'mail 'sent)
(wl-draft-write-sendlog
(defun wl-draft-send-mail-with-pop-before-smtp ()
"Send the prepared message buffer with POP-before-SMTP."
(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)))))
- (when session (elmo-network-close-session session)))
- (error))
+ (let ((session
+ (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))))
+ (condition-case error
+ (progn
+ (elmo-pop3-get-session session)
+ (when session (elmo-network-close-session session)))
+ (error
+ (elmo-network-close-session session)
+ (unless (string= (nth 1 error) "Unplugged")
+ (signal (car error)(cdr error))))))
(wl-draft-send-mail-with-smtp))
(defun wl-draft-insert-required-fields (&optional force-msgid)
wl-insert-message-id)
(not (re-search-forward "^Message-ID[ \t]*:" nil t)))
(insert (concat "Message-ID: "
- (wl-draft-make-message-id-string)
+ (funcall wl-message-id-function)
"\n")))
;; Insert date field.
(goto-char (point-min))
;; ignore any blank lines in the header
(while (re-search-forward "\n\n\n*" nil t)
(replace-match "\n")))
- (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
+;;; (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(wl-draft-dispatch-message)
(when kill-when-done
;; hide editing-buffer.
(progn
(if (and (wl-message-mail-p)
(not (wl-draft-sent-message-p 'mail)))
- (funcall wl-draft-send-mail-func))
+ (if (or (not (or wl-draft-force-queuing
+ wl-draft-force-queuing-mail))
+ (memq 'mail wl-sent-message-queued))
+ (funcall wl-draft-send-mail-function)
+ (push 'mail wl-sent-message-queued)
+ (wl-draft-set-sent-message 'mail 'unplugged)))
(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)))
+ (if (or (not (or wl-draft-force-queuing
+ wl-draft-force-queuing-news))
+ (memq 'news wl-sent-message-queued))
+ (funcall wl-draft-send-news-function)
+ (push 'news wl-sent-message-queued)
+ (wl-draft-set-sent-message 'news 'unplugged))))
;;
(let* ((status (wl-draft-sent-message-results))
(unplugged-via (car status))
(if wl-draft-use-cache
(let ((id (std11-field-body "Message-ID"))
(elmo-enable-disconnected-operation t))
- (elmo-cache-save id nil nil nil)))
+ (elmo-file-cache-save (elmo-file-cache-get-path id)
+ nil)))
;; If one unplugged, append queue.
(when (and unplugged-via
wl-sent-message-modified)
(if wl-draft-enable-queuing
- (wl-draft-queue-append wl-sent-message-via)
+ (progn
+ (wl-draft-queue-append wl-sent-message-via)
+ (setq wl-sent-message-modified 'requeue))
(error "Unplugged")))
(when wl-draft-verbose-send
(if (and unplugged-via sent-via);; combined message
(let (wl-interactive-send
;;; wl-draft-verbose-send
(wl-mail-send-pre-hook (and force-pre-hook wl-mail-send-pre-hook))
-;;; wl-news-send-pre-hook
+ (wl-news-send-pre-hook (and force-pre-hook wl-news-send-pre-hook))
mail-send-hook
mail-send-actions)
(wl-draft-send kill-when-done mes-string))))
(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
(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...")
(kill-buffer sending-buffer))))))
(defun wl-draft-save ()
- "Save current draft."
+ "Save current draft.
+Derived from `message-save-drafts' in T-gnus."
(interactive)
- (save-buffer)
- (wl-draft-config-info-operation
- (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))
- 'save))
+ (if (buffer-modified-p)
+ (progn
+ (message "Saving %s..." wl-draft-buffer-file-name)
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
+ (with-temp-file wl-draft-buffer-file-name
+ (insert msg)
+ ;; If no header separator, insert it.
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (goto-char (point-min))
+ (if (re-search-forward "\n\n" nil t)
+ (replace-match (concat "\n" mail-header-separator "\n"))
+ (goto-char (point-max))
+ (insert (if (eq (char-before) ?\n) "" "\n")
+ mail-header-separator "\n"))))
+ (let ((mime-header-encode-method-alist
+ '((eword-encode-unstructured-field-body))))
+ (mime-edit-translate-buffer))
+ (wl-draft-get-header-delimiter t)))
+ (set-buffer-modified-p nil)
+ (wl-draft-config-info-operation
+ (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
+ (string-to-int
+ (match-string 0 wl-draft-buffer-file-name)))
+ 'save)
+ (message "Saving %s...done" wl-draft-buffer-file-name))
+ (message "(No changes need to be saved)")))
(defun wl-draft-mimic-kill-buffer ()
"Kill the current (draft) buffer with query."
(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)
(let ((wl-interactive-send t))
(wl-draft-send-and-exit)))
-(defun wl-draft-delete-field (field &optional delimline)
- (wl-draft-delete-fields (regexp-quote field) delimline))
+(defun wl-draft-delete-field (field &optional delimline replace)
+ (wl-draft-delete-fields (regexp-quote field) delimline replace))
-(defun wl-draft-delete-fields (regexp &optional delimline)
+(defun wl-draft-delete-fields (field &optional delimline replace)
(save-restriction
(unless delimline
+ (goto-char (point-min))
(if (search-forward "\n\n" nil t)
(setq delimline (point))
(setq delimline (point-max))))
(narrow-to-region (point-min) delimline)
(goto-char (point-min))
- (let ((regexp (concat "^" regexp ":"))
- (case-fold-search t)
- last)
+ (let ((regexp (concat "^" field ":"))
+ (case-fold-search t))
(while (not (eobp))
(if (looking-at regexp)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(goto-char (match-beginning 0))
- (point-max)))))
+ (point-max))))
+ (if replace
+ (insert (concat field ": " replace "\n"))))
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(goto-char (match-beginning 0))
(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)
(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))
(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)))
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)))))
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 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.
- (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))
- buf-name file-name num wl-demo change-major-mode-hook)
- (if (not (eq (car draft-folder-spec) 'localdir))
+ (wl-load-profile)
+ (wl-folder-init)
+ (elmo-init)
+ (wl-plugged-init t))
+ (let (wl-demo)
+ (wl-init)) ; returns immediately if already initialized.
+
+ (let (buf-name header-alist)
+ (setq buf-name
+ (wl-draft-create-buffer
+ (or
+ (eq this-command 'wl-draft)
+ (eq this-command 'wl-summary-write)
+ (eq this-command 'wl-summary-write-current-folder))
+ parent-folder summary-buf))
+ (setq header-alist
+ (list
+ (cons "From: " (or from wl-from))
+ (cons "To: " (or to
+ (and
+ (or (interactive-p)
+ (eq this-command 'wl-summary-write))
+ "")))
+ (cons "Cc: " cc)
+ (cons "Subject: " (or subject ""))
+ (cons "Newsgroups: " newsgroups)
+ (cons "Mail-Followup-To: " mail-followup-to)
+ (cons "In-Reply-To: " in-reply-to)
+ (cons "References: " references)))
+ (setq header-alist (append header-alist
+ (wl-draft-default-headers)
+ (if body (list "" body))))
+ (wl-draft-create-contents header-alist)
+ (if edit-again
+ (wl-draft-decode-body
+ content-type content-transfer-encoding))
+ (wl-draft-insert-mail-header-separator)
+ (wl-draft-prepare-edit)
+ (if (interactive-p)
+ (run-hooks 'wl-mail-setup-hook))
+
+ (goto-char (point-min))
+ (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))))
+ buf-name))
+
+(defun wl-draft-create-buffer (&optional full parent-folder summary-buf)
+ (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+ (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
+ (summary-buf (or summary-buf (wl-summary-get-buffer parent-folder)))
+ buf-name file-name num change-major-mode-hook)
+ (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))
(buffer-name)))
(rename-buffer (concat wl-draft-folder "/" (int-to-string num))))
(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))
+ full)
(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"))
- (and (or (interactive-p)
- (eq this-command 'wl-summary-write)
- to)
- (insert "To: " (or to "") "\n"))
- (and cc (insert "Cc: " (or cc "") "\n"))
- (insert "Subject: " (or subject "") "\n")
- (and newsgroups (insert "Newsgroups: " newsgroups "\n"))
- (and mail-followup-to (insert "Mail-Followup-To: " mail-followup-to "\n"))
- (and wl-insert-mail-reply-to
- (insert "Mail-Reply-To: "
- (wl-address-header-extract-address
- 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")
+ (setq wl-sent-message-queued nil)
(setq wl-draft-buffer-file-name file-name)
- (if mail-default-reply-to
- (insert "Reply-To: " mail-default-reply-to "\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
- (file-exists-p wl-x-face-file)
- (wl-draft-insert-x-face-field-here))
- (if mail-default-headers
- (insert mail-default-headers))
- (if (not (= (preceding-char) ?\n))
- (insert ?\n))
- (if edit-again
- (let (start)
- (setq start (point))
- (when content-type
- (insert "Content-type: " content-type "\n"))
- (when content-transfer-encoding
- (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
- (if (or content-type content-transfer-encoding)
- (insert "\n"))
- (and body (insert body))
- (save-restriction
- (narrow-to-region start (point))
- (and edit-again
- (wl-draft-decode-message-in-buffer))
- (widen)
- (goto-char start)
- (put-text-property (point)
- (progn
- (insert mail-header-separator "\n")
- (1- (point)))
- 'category 'mail-header-separator)))
- (put-text-property (point)
- (progn
- (insert mail-header-separator "\n")
- (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))
+ (setq wl-draft-config-exec-flag t)
+ (setq wl-draft-parent-folder parent-folder)
+ (setq wl-draft-buffer-cur-summary-buffer summary-buf)
+ buf-name))
+
+(defun wl-draft-create-contents (header-alist)
+ "header-alist' sample
+'(function ;; funcall
+ string ;; insert string
+ (string . string) ;; insert string string
+ (string . function) ;; insert string (funcall)
+ (string . nil) ;; insert nothing
+ (function . (arg1 arg2 ..)) ;; call function with argument
+ nil ;; insert nothing
+"
+ (unless (eq major-mode 'wl-draft-mode)
+ (error "wl-draft-create-header must be use in wl-draft-mode."))
+ (let ((halist header-alist)
+ field value)
+ (while halist
+ (cond
+ ;; function
+ ((functionp (car halist)) (funcall (car halist)))
+ ;; string
+ ((stringp (car halist)) (insert (car halist) "\n"))
+ ;; cons
+ ((consp (car halist))
+ (setq field (car (car halist)))
+ (setq value (cdr (car halist)))
+ (cond
+ ((functionp field) (apply field value))
+ ((stringp field)
+ (cond
+ ((stringp value) (insert field value "\n"))
+ ((functionp value) (insert field (funcall value) "\n"))
+ ((not value))
+ (t
+ (debug))))
+ ;;
+ ((not field))
+ (t
+ (debug))
+ )))
+ (setq halist (cdr halist)))))
+
+(defun wl-draft-prepare-edit ()
+ (unless (eq major-mode 'wl-draft-mode)
+ (error "wl-draft-create-header must be use in wl-draft-mode."))
+ (let (change-major-mode-hook)
(wl-draft-editor-mode)
+ (add-hook 'local-write-file-hooks 'wl-draft-save)
(wl-draft-overload-functions)
(wl-highlight-headers 'for-draft)
- (goto-char (point-min))
- (setq wl-draft-config-exec-flag t)
- (if (interactive-p)
- (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))))
- (setq wl-draft-buffer-cur-summary-buffer (or summary-buf
- (get-buffer
- wl-summary-buffer-name)))
- buf-name))
+ (wl-draft-save)
+ (clear-visited-file-modtime)))
+
+(defun wl-draft-decode-header ()
+ (save-excursion
+ (std11-narrow-to-header)
+ (wl-draft-decode-message-in-buffer)
+ (widen)))
+
+(defun wl-draft-decode-body (&optional content-type content-transfer-encoding)
+ (let ((content-type
+ (or content-type
+ (std11-field-body "content-type")))
+ (content-transfer-encoding
+ (or content-transfer-encoding
+ (std11-field-body "content-transfer-encoding")))
+ delimline)
+ (save-excursion
+ (std11-narrow-to-header)
+ (wl-draft-delete-field "content-type")
+ (wl-draft-delete-field "content-transfer-encoding")
+ (goto-char (point-max))
+ (setq delimline (point-marker))
+ (widen)
+ (narrow-to-region delimline (point-max))
+ (goto-char (point-min))
+ (when content-type
+ (insert "Content-type: " content-type "\n"))
+ (when content-transfer-encoding
+ (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
+ (wl-draft-decode-message-in-buffer)
+ (goto-char (point-min))
+ (unless (re-search-forward "^$" (point-at-eol) t)
+ (insert "\n"))
+ (widen)
+ delimline)))
+
+;;; subroutine for wl-draft-create-contents
+;;; must be used in wl-draft-mode
+(defun wl-draft-check-new-line ()
+ (if (not (= (preceding-char) ?\n))
+ (insert ?\n)))
(defsubst wl-draft-insert-ccs (str cc)
(let ((field
(mapcar 'downcase wl-subscribed-mailing-list)))))
(insert str field "\n"))))
+(defsubst wl-draft-default-headers ()
+ (list
+ (cons "Mail-Reply-To: " (and wl-insert-mail-reply-to
+ (wl-address-header-extract-address
+ wl-from)))
+ (cons "" wl-generate-mailer-string-function)
+ (cons "Reply-To: " mail-default-reply-to)
+ (cons 'wl-draft-insert-ccs
+ (list "Bcc: " (or wl-bcc
+ (and mail-self-blind (user-login-name)))))
+ (cons 'wl-draft-insert-ccs
+ (list "Fcc: " wl-fcc))
+ (cons "Organization: " wl-organization)
+ (and wl-auto-insert-x-face
+ (file-exists-p wl-x-face-file)
+ 'wl-draft-insert-x-face-field-here) ;; allow nil
+ mail-default-headers
+ ;; check \n at th end of line for `mail-default-headers'
+ 'wl-draft-check-new-line
+; wl-draft-default-headers
+; 'wl-draft-check-new-line
+ ))
+
+(defun wl-draft-insert-mail-header-separator (&optional delimline)
+ (save-excursion
+ (if delimline
+ (goto-char delimline)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (delete-backward-char 1)
+ (goto-char (point-max))))
+ (wl-draft-check-new-line)
+ (put-text-property (point)
+ (progn
+ (insert mail-header-separator "\n")
+ (1- (point)))
+ 'category 'mail-header-separator)))
+
+;;;;;;;;;;;;;;;;
+
(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))
(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)))
+ buffer file-name change-major-mode-hook)
+ (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))
- (if wl-draft-use-frame
- (switch-to-buffer-other-frame buf-name)
- (switch-to-buffer buf-name))
- (set-buffer buf-name)
- (if (not (string-match (regexp-quote wl-draft-folder)
- (buffer-name)))
- (rename-buffer (concat wl-draft-folder "/" (buffer-name))))
- (auto-save-mode -1)
- (wl-draft-mode)
- (setq wl-sent-message-via nil)
- (setq wl-draft-buffer-file-name file-name)
- (wl-draft-config-info-operation number 'load)
- (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)
- (wl-draft-editor-mode)
- (wl-highlight-headers 'for-draft)
- (run-hooks 'wl-draft-reedit-hook)
- (goto-char (point-max))
- buf-name
- ))
+ (if (setq buffer (get-buffer
+ (concat wl-draft-folder "/"
+ (number-to-string number))))
+ (progn
+ (if wl-draft-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ (set-buffer buffer))
+ (setq buffer (get-buffer-create (number-to-string number)))
+ (if wl-draft-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ (set-buffer buffer)
+ (insert-file-contents-as-binary file-name)
+ (let((mime-edit-again-ignored-field-regexp
+ "^\\(Content-.*\\|Mime-Version\\):"))
+ (wl-draft-decode-message-in-buffer))
+ (wl-draft-insert-mail-header-separator)
+ (if (not (string-match (regexp-quote wl-draft-folder)
+ (buffer-name)))
+ (rename-buffer (concat wl-draft-folder "/" (buffer-name))))
+ (auto-save-mode -1)
+ (wl-draft-mode)
+ (setq buffer-file-name file-name)
+ (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)
+ (setq wl-sent-message-queued nil)
+ (setq wl-draft-buffer-file-name file-name)
+ (wl-draft-config-info-operation number 'load)
+ (goto-char (point-min))
+ (wl-draft-overload-functions)
+ (wl-draft-editor-mode)
+ (add-hook 'local-write-file-hooks 'wl-draft-save)
+ (wl-highlight-headers 'for-draft)
+ (run-hooks 'wl-draft-reedit-hook)
+ (goto-char (point-max))
+ buffer)))
(defmacro wl-draft-body-goto-top ()
(` (progn
(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))))
(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)
wl-draft-config-variables
(list 'wl-draft-fcc-list)))))
(if add-sent-message-via
- (push 'wl-sent-message-via variables))
+ (progn
+ (push 'wl-sent-message-queued variables)
+ (push 'wl-sent-message-via variables)))
(while (setq variable (pop variables))
(when (boundp variable)
(wl-append alist
(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 (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))
(catch 'found
(while sent-via
(when (and (eq (nth 1 (car sent-via)) 'unplugged)
- (elmo-plugged-p
- (car (nth 2 (car sent-via)))
- (cdr (nth 2 (car sent-via)))))
+ (or (not (nth 2 (car sent-via)))
+ (elmo-plugged-p
+ (car (nth 2 (car sent-via)))
+ (cdr (nth 2 (car sent-via))))))
(wl-append msgs (list (car msgs2)))
(throw 'found t))
(setq sent-via (cdr sent-via))))
(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
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))
(setq failure t))
(quit
(setq failure t)))
- (unless failure
- (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)))
+ (if (eq wl-sent-message-modified 'requeue)
+ (progn
+ (elmo-folder-delete-messages
+ queue-folder (cons (car msgs) nil))
+ (wl-draft-queue-info-operation (car msgs) 'delete))
+ (unless failure
+ (elmo-folder-delete-messages
+ queue-folder (cons (car msgs) nil))
+ (wl-draft-queue-info-operation (car msgs) 'delete)
+ (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)
(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
- (setq buf (buffer-file-name (car bufs)))
+ (setq buf (with-current-buffer (car bufs)
+ wl-draft-buffer-file-name))
(string-match draft-regexp buf))
(setq draft-bufs (cons (buffer-name (car bufs)) draft-bufs)))
(setq bufs (cdr bufs)))
(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)
"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))
;; 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))
projects / elisp / wanderlust.git / blobdiff