;;; Code:
;;
-
+(require 'elmo)
(require 'sendmail)
(require 'wl-template)
(require 'emu)
(condition-case nil (require 'timezone) (error nil))
(require 'std11)
+(require 'eword-encode)
(require 'wl-vars)
(defvar x-face-add-x-face-version-header)
(defvar mail-from-style)
(eval-when-compile
+ (require 'cl)
+ (require 'static)
(require 'elmo-pop3)
(defalias-maybe 'x-face-insert 'ignore)
(defalias-maybe 'x-face-insert-version-header 'ignore)
(eval-and-compile
(autoload 'wl-addrmgr "wl-addrmgr"))
-(defvar wl-draft-buf-name "Draft")
-(defvar wl-draft-buffer-file-name nil)
+(autoload 'open-ssl-stream "ssl")
+
+(defvar wl-draft-buffer-message-number nil)
(defvar wl-draft-field-completion-list nil)
(defvar wl-draft-verbose-send t)
(defvar wl-draft-verbose-msg nil)
((string-match \".*@domain2$\" wl-draft-parent-folder)
(\"From\" . \"user@domain2\"))))")
+(defvar wl-draft-parent-number nil)
+(defvar wl-draft-parent-flag nil)
+
+(defconst wl-draft-parent-variables
+ '(wl-draft-parent-folder
+ wl-draft-parent-number
+ wl-draft-parent-flag))
+
(defvar wl-draft-config-sub-func-alist
'((body . wl-draft-config-sub-body)
(top . wl-draft-config-sub-top)
(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-message-number)
(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-draft-fcc-list)
(make-variable-buffer-local 'wl-draft-reply-buffer)
(make-variable-buffer-local 'wl-draft-parent-folder)
+(make-variable-buffer-local 'wl-draft-parent-number)
+(make-variable-buffer-local 'wl-draft-parent-flag)
+
+(defvar wl-draft-folder-internal nil
+ "Internal variable for caching `opened' draft 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
- (if wl-smtp-authenticate-type
- (mapcar 'upcase
- (if (listp wl-smtp-authenticate-type)
- wl-smtp-authenticate-type
- (list wl-smtp-authenticate-type)))))
- (smtp-use-sasl (and smtp-sasl-mechanisms t))
- (smtp-use-starttls (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
- (match-string 2 wl-smtp-posting-user)))
- (setq smtp-sasl-user-name wl-smtp-posting-user
- smtp-sasl-properties nil))
- (setq sasl-read-passphrase
- (function
- (lambda (prompt)
- (elmo-get-passwd
- (wl-smtp-password-key
- smtp-sasl-user-name
- (car smtp-sasl-mechanisms)
- smtp-server)))))
- (,@ body))))
+ `(let* ((smtp-sasl-mechanisms
+ (if wl-smtp-authenticate-type
+ (mapcar 'upcase
+ (if (listp wl-smtp-authenticate-type)
+ wl-smtp-authenticate-type
+ (list wl-smtp-authenticate-type)))))
+ (smtp-use-sasl (and smtp-sasl-mechanisms t))
+ (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
+ (smtp-open-connection-function
+ (if (eq wl-smtp-connection-type 'ssl)
+ #'open-ssl-stream
+ smtp-open-connection-function))
+ smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
+ (setq smtp-sasl-user-name wl-smtp-posting-user
+ smtp-sasl-properties (when wl-smtp-authenticate-realm
+ (list 'realm
+ wl-smtp-authenticate-realm)))
+ (setq sasl-read-passphrase
+ (function
+ (lambda (prompt)
+ (elmo-get-passwd
+ (wl-smtp-password-key
+ smtp-sasl-user-name
+ (car smtp-sasl-mechanisms)
+ smtp-server)))))
+ ,@body))
(defun wl-draft-insert-date-field ()
"Insert Date field."
(list (concat wl-draft-mime-bcc-field-name ":")))))))
(defun wl-draft-make-mail-followup-to (recipients)
- (if (elmo-list-member
- (or wl-user-mail-address-list
- (list (wl-address-header-extract-address wl-from)))
- recipients)
- (let ((rlist (elmo-list-delete
- (or wl-user-mail-address-list
- (list (wl-address-header-extract-address wl-from)))
- recipients
- (lambda (elem list)
- (elmo-delete-if
- (lambda (item) (string= (downcase elem)
- (downcase item)))
- list)))))
- (if (elmo-list-member rlist (mapcar 'downcase
- wl-subscribed-mailing-list))
- rlist
- (append rlist (list (wl-address-header-extract-address
- wl-from)))))
- recipients))
+ (let ((rlist (wl-address-delete-user-mail-addresses recipients)))
+ (if (elmo-list-member rlist (mapcar 'downcase
+ wl-subscribed-mailing-list))
+ rlist
+ (append rlist (list (wl-address-header-extract-address
+ wl-from))))))
(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)))))
- (cond (wl-draft-always-delete-myself ; always-delete option
- (elmo-list-delete myself cc
- (lambda (elem list)
- (elmo-delete-if
- (lambda (item) (string= (downcase elem)
- (downcase item)))
- list))))
- ((elmo-list-member (append to cc) ; subscribed mailing-list
- (mapcar 'downcase wl-subscribed-mailing-list))
- (elmo-list-delete myself cc
- (lambda (elem list)
- (elmo-delete-if
- (lambda (item) (string= (downcase elem)
- (downcase item)))
- list))))
- (t cc))))
-
-(defun wl-draft-forward (original-subject summary-buf)
- (let (references parent-folder)
+ (cond (wl-draft-always-delete-myself ; always-delete option
+ (wl-address-delete-user-mail-addresses cc))
+ ((elmo-list-member (append to cc) ; subscribed mailing-list
+ (mapcar 'downcase wl-subscribed-mailing-list))
+ (wl-address-delete-user-mail-addresses cc))
+ (t cc)))
+
+(defsubst wl-draft-strip-subject-regexp (subject regexp)
+ "Remove REGEXP from SUBJECT string."
+ (if (string-match regexp subject)
+ (substring subject (match-end 0))
+ subject))
+
+(defun wl-draft-forward-make-subject (original-subject)
+ "Generate subject string for forwarding."
+ (cond ((functionp wl-forward-subject-prefix)
+ (concat (funcall wl-forward-subject-prefix)
+ original-subject))
+ ((stringp wl-forward-subject-prefix)
+ (concat wl-forward-subject-prefix
+ (wl-draft-strip-subject-regexp
+ (or original-subject "")
+ wl-subject-forward-prefix-regexp)))
+ (t original-subject)))
+
+(defun wl-draft-reply-make-subject (original-subject)
+ "Generate subject string for replying."
+ (cond ((functionp wl-reply-subject-prefix)
+ (concat (funcall wl-reply-subject-prefix)
+ original-subject))
+ ((stringp wl-reply-subject-prefix)
+ (concat wl-reply-subject-prefix
+ (wl-draft-strip-subject-regexp
+ (or original-subject "")
+ wl-subject-re-prefix-regexp)))
+ (t original-subject)))
+
+(defun wl-draft-forward (original-subject summary-buf &optional number)
+ (let (references parent-folder subject)
(with-current-buffer summary-buf
(setq parent-folder (wl-summary-buffer-folder-name)))
+ (let ((decoder (mime-find-field-decoder 'Subject 'plain)))
+ (setq subject (if (and original-subject decoder)
+ (funcall decoder original-subject) original-subject)))
(with-current-buffer (wl-message-get-original-buffer)
+ (setq subject (wl-draft-forward-make-subject subject))
(setq references (nconc
(std11-field-bodies '("References" "In-Reply-To"))
(list (std11-field-body "Message-Id"))))
(get-buffer-window summary-buf)
(select-window (get-buffer-window summary-buf)))
(wl-draft (list (cons 'To "")
- (cons 'Subject
- (concat wl-forward-subject-prefix original-subject))
+ (cons 'Subject subject)
(cons 'References references))
- nil nil nil nil parent-folder))
+ nil nil nil nil parent-folder number))
(goto-char (point-max))
(wl-draft-insert-message)
- (mail-position-on-field "To"))
-
-(defun wl-draft-strip-subject-re (subject)
- "Remove \"Re:\" from SUBJECT string. Shamelessly copied from Gnus."
- (if (string-match wl-subject-prefix-regexp subject)
- (substring subject (match-end 0))
- subject))
+ (mail-position-on-field "To")
+ (setq wl-draft-config-variables
+ (append wl-draft-parent-variables
+ wl-draft-config-variables))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
+ (run-hooks 'wl-draft-forward-hook))
(defun wl-draft-self-reply-p ()
"Return t when From address in the current message is user's self one or not."
(wl-address-user-mail-address-p (or (elmo-field-body "From") "")))
-(defun wl-draft-reply (buf with-arg summary-buf)
- "Reply to BUF buffer message.
-Reply to author if WITH-ARG is non-nil."
+(defun wl-draft-find-reply-headers (rule-symbol)
+ (let ((rule-list (symbol-value rule-symbol))
+ condition-match-p result)
+ (setq condition-match-p
+ (lambda (condition)
+ (cond ((stringp condition)
+ (std11-field-body condition))
+ ((functionp condition)
+ (funcall condition))
+ ((consp condition)
+ (and (funcall condition-match-p (car condition))
+ (funcall condition-match-p (cdr condition))))
+ ((null condition))
+ (t
+ (error "Unkown condition in `%s'" rule-symbol)))))
+ (while (and (null result) rule-list)
+ (let ((rule (car rule-list)))
+ (when (funcall condition-match-p (car rule))
+ (setq result (cdr rule)))
+ (setq rule-list (cdr rule-list))))
+ result))
+
+(defun wl-draft-reply (buf with-arg summary-buf &optional number)
+ "Create draft for replying to the message in buffer BUF.
+Recipients are prepared along `wl-draft-reply-without-argument-list',
+or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
;;;(save-excursion
- (let (r-list
+ (let ((rule-list (if with-arg
+ 'wl-draft-reply-with-argument-list
+ 'wl-draft-reply-without-argument-list))
+ reply-headers
to mail-followup-to cc subject in-reply-to references newsgroups
to-alist cc-alist decoder parent-folder)
(when (buffer-live-p summary-buf)
(with-current-buffer summary-buf
(setq parent-folder (wl-summary-buffer-folder-name))))
(set-buffer (or buf mime-mother-buffer))
- (setq r-list (if with-arg wl-draft-reply-with-argument-list
- wl-draft-reply-without-argument-list))
- (catch 'done
- (while r-list
- (when (let ((condition (car (car r-list))))
- (cond ((stringp condition)
- (std11-field-body condition))
- ((listp condition)
- (catch 'done
- (while condition
- (cond
- ((stringp (car condition))
- (or (std11-field-body (car condition))
- (throw 'done nil)))
- ((symbolp (car condition))
- (or (funcall (car condition))
- (throw 'done nil)))
- (t
- (debug)))
- (setq condition (cdr condition)))
- t))
- ((symbolp condition)
- (funcall condition))))
- (let ((r-to-list (nth 0 (cdr (car r-list))))
- (r-cc-list (nth 1 (cdr (car r-list))))
- (r-ng-list (nth 2 (cdr (car r-list)))))
- (when (and (member "Followup-To" r-ng-list)
- (string= (std11-field-body "Followup-To") "poster"))
- (setq r-to-list (cons "From" r-to-list))
- (setq r-ng-list (delete "Followup-To"
- (copy-sequence r-ng-list))))
- (if (and r-to-list (symbolp r-to-list))
- (setq to (wl-concat-list (funcall r-to-list) ","))
- (setq to (wl-concat-list (cons to
- (elmo-multiple-fields-body-list
- r-to-list))
- ",")))
- (if (and r-cc-list (symbolp r-cc-list))
- (setq cc (wl-concat-list (funcall r-to-list) ","))
- (setq cc (wl-concat-list (cons cc
- (elmo-multiple-fields-body-list
- r-cc-list))
- ",")))
- (if (and r-ng-list (symbolp r-ng-list))
- (setq newsgroups (wl-concat-list (funcall r-ng-list) ","))
- (setq newsgroups (wl-concat-list (cons newsgroups
- (std11-field-bodies
- r-ng-list))
- ","))))
- (throw 'done nil))
- (setq r-list (cdr r-list)))
- (error "No match field: check your `wl-draft-reply-%s-argument-list'"
- (if with-arg "with" "without")))
+ (setq reply-headers
+ (or (wl-draft-find-reply-headers rule-list)
+ (error "No match field: check your `%s'" rule-list)))
+ (let ((r-to-list (nth 0 reply-headers))
+ (r-cc-list (nth 1 reply-headers))
+ (r-ng-list (nth 2 reply-headers)))
+ (setq to (wl-concat-list
+ (nconc
+ (if (functionp r-to-list)
+ (funcall r-to-list)
+ (elmo-multiple-fields-body-list r-to-list))
+ (and (member "Followup-To" r-ng-list)
+ (string= (std11-field-body "Followup-To") "poster")
+ (progn
+ (setq r-ng-list (delete "Followup-To"
+ (copy-sequence r-ng-list)))
+ (elmo-multiple-fields-body-list '("From")))))
+ ","))
+ (setq cc (wl-concat-list
+ (if (functionp r-cc-list)
+ (funcall r-cc-list)
+ (elmo-multiple-fields-body-list r-cc-list))
+ ","))
+ (setq newsgroups (wl-concat-list
+ (if (functionp r-ng-list)
+ (funcall r-ng-list)
+ (std11-field-bodies r-ng-list))
+ ",")))
(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)
+ (set-buffer-multibyte default-enable-multibyte-characters)
(setq decoder (mime-find-field-decoder 'Subject 'plain))
(setq subject (if (and subject decoder)
(funcall decoder subject) subject))
(cons (nth 1 (std11-extract-address-components addr))
(if decoder (funcall decoder addr) addr)))
cc)))
- (and wl-reply-subject-prefix
- (setq subject (concat wl-reply-subject-prefix
- (wl-draft-strip-subject-re
- (or subject "")))))
+ (setq subject (wl-draft-reply-make-subject subject))
(setq in-reply-to (std11-field-body "Message-Id"))
(setq references (nconc
(std11-field-bodies '("References" "In-Reply-To"))
(wl-draft-make-mail-followup-to (append to cc)))
(setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
(with-temp-buffer ; to keep raw buffer unibyte.
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq newsgroups (wl-parse newsgroups
+ (set-buffer-multibyte default-enable-multibyte-characters)
+ (setq newsgroups (elmo-parse newsgroups
"[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
newsgroups (wl-delete-duplicates newsgroups)
newsgroups
to (copy-sequence to))
t t))
(and to (setq to (mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr to-alist)) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr to-alist)) addr)
+ addr))
to ",\n\t")))
(and cc (setq cc (mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr cc-alist)) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr cc-alist)) addr)
+ addr))
cc ",\n\t")))
(and mail-followup-to
(setq mail-followup-to
(mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr (append to-alist cc-alist))) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr (append to-alist cc-alist))) addr)
+ addr))
mail-followup-to ",\n\t")))
(and (null to) (setq to cc cc nil))
(setq references (delq nil references)
(cons 'In-Reply-To in-reply-to)
(cons 'References references)
(cons 'Mail-Followup-To mail-followup-to))
- nil nil nil nil parent-folder)
+ nil nil nil nil parent-folder number)
(setq wl-draft-reply-buffer buf)
- (run-hooks 'wl-reply-hook)))
+ (setq wl-draft-config-variables
+ (append wl-draft-parent-variables
+ wl-draft-config-variables))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save))
+ (run-hooks 'wl-draft-reply-hook))
(defun wl-draft-reply-position (position)
(cond ((eq position 'body)
(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)
+ (let* ((mes-id (with-current-buffer mail-reply-buffer
(std11-field-body "message-id")))
(field (or alt-field "In-Reply-To"))
(ref (std11-field-body field))
(save-restriction
(narrow-to-region (point)(point))
(insert
- (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))))
+ (string-as-multibyte
+ (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
(goto-char (point-min))
(wl-draft-delete-fields ignored-fields))
(set-buffer
(wl-draft (list
(cons 'From
- (if (member
- (nth 1 (std11-extract-address-components from))
- wl-user-mail-address-list)
- from))
+ (if (wl-address-user-mail-address-p from) from))
(cons 'To to)
(cons 'Cc cc)
(cons 'Subject subject)
mail-citation-hook mail-yank-hooks
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)))
+ (if (and wl-draft-buffer-cur-summary-buffer
+ (with-current-buffer wl-draft-buffer-cur-summary-buffer
+ (and wl-message-buffer
+ (with-current-buffer wl-message-buffer
+ (setq original-buffer (wl-message-get-original-buffer))
+ (not (zerop (with-current-buffer original-buffer
+ (buffer-size))))))))
+ (progn
+ (setq mail-reply-buffer original-buffer)
+ (wl-draft-yank-from-mail-reply-buffer
+ nil
+ wl-ignored-forwarded-headers))
+ (when (string= (mime-make-tag "message" "rfc822")
+ (buffer-substring-no-properties (point-at-bol 0)(point-at-eol 0)))
+ (delete-region (point-at-bol 0) (1+ (point-at-eol 0))))
+ (error "No current message"))))
(defun wl-draft-insert-get-message (dummy)
(let ((fld (completing-read
(wl-folder-get-entity-with-petname)
wl-folder-entity-hashtb)
nil nil wl-default-spec
- 'wl-read-folder-hist))
+ 'wl-read-folder-history))
(number (call-interactively
(function (lambda (num)
(interactive "nNumber: ")
wl-draft-cite-function)
(unwind-protect
(progn
- (elmo-message-fetch (wl-folder-get-elmo-folder fld)
- number
- ;; No cache.
- (elmo-make-fetch-strategy 'entire)
- nil mail-reply-buffer)
+ (with-current-buffer mail-reply-buffer
+ (erase-buffer)
+ (elmo-message-fetch (wl-folder-get-elmo-folder fld)
+ number
+ ;; No cache.
+ (elmo-make-fetch-strategy 'entire)))
(wl-draft-yank-from-mail-reply-buffer nil))
(kill-buffer mail-reply-buffer))))
(defun wl-default-draft-cite ()
(let ((mail-yank-ignored-headers "[^:]+:")
(mail-yank-prefix "> ")
- (summary-buf wl-current-summary-buffer)
- (message-buf (get-buffer (wl-current-message-buffer)))
- from date cite-title num entity)
- (if (and summary-buf
- (buffer-live-p summary-buf)
- message-buf
- (buffer-live-p message-buf))
- (progn
- (with-current-buffer summary-buf
- (let ((elmo-mime-charset wl-summary-buffer-mime-charset))
- (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")
- (if wl-default-draft-cite-decorate-author
- (funcall wl-summary-from-function
- (or from "you"))
- (or from "you"))))))
- (and cite-title
- (insert cite-title "\n"))
+ date from cite-title)
+ (save-restriction
+ (if (< (mark t) (point))
+ (exchange-point-and-mark))
+ (narrow-to-region (point)(point-max))
+ (setq date (std11-field-body "date")
+ from (std11-field-body "from")))
+ (when (or date from)
+ (insert (format "At %s,\n%s wrote:\n"
+ (or date "some time ago")
+ (if wl-default-draft-cite-decorate-author
+ (funcall wl-summary-from-function
+ (or from "you"))
+ (or from "you")))))
(mail-indent-citation)))
(defvar wl-draft-buffer nil "Draft buffer to yank content.")
"Yank original message."
(interactive "P")
(if arg
- (let (buf mail-reply-buffer)
- (elmo-set-work-buf
- (yank)
- (setq buf (current-buffer)))
- (setq mail-reply-buffer buf)
- (wl-draft-yank-from-mail-reply-buffer nil))
+ (let ((draft-buffer (current-buffer))
+ mail-reply-buffer)
+ (with-temp-buffer
+ (insert "\n")
+ (yank)
+ (setq mail-reply-buffer (current-buffer))
+ (with-current-buffer draft-buffer
+ (wl-draft-yank-from-mail-reply-buffer nil))))
(wl-draft-yank-current-message-entity)))
(defun wl-draft-hide (editing-buffer)
"Hide the editing draft buffer if possible."
(when (and editing-buffer
- (buffer-live-p editing-buffer))
- (set-buffer editing-buffer)
+ (buffer-live-p editing-buffer)
+ (get-buffer-window editing-buffer))
+ (select-window (get-buffer-window editing-buffer))
(let ((sum-buf wl-draft-buffer-cur-summary-buffer)
fld-buf sum-win fld-win)
(if (and wl-draft-use-frame
(defun wl-draft-delete (editing-buffer)
"Kill the editing draft buffer and delete the file corresponds to it."
- (save-excursion
- (when editing-buffer
- (set-buffer editing-buffer)
- (if wl-draft-buffer-file-name
- (progn
- (if (file-exists-p wl-draft-buffer-file-name)
- (delete-file wl-draft-buffer-file-name))
- (let ((msg (and wl-draft-buffer-file-name
- (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))))
- (wl-draft-config-info-operation msg 'delete))))
+ (when editing-buffer
+ (with-current-buffer editing-buffer
+ (when wl-draft-buffer-message-number
+ (elmo-folder-delete-messages (wl-draft-get-folder)
+ (list
+ wl-draft-buffer-message-number))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number
+ 'delete))
(set-buffer-modified-p nil) ; force kill
(kill-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? ")))
+ (yes-or-no-p "Kill Current Draft? ")))
(let ((cur-buf (current-buffer)))
+ (run-hooks 'wl-draft-kill-pre-hook)
(wl-draft-hide cur-buf)
(wl-draft-delete cur-buf)))
(message "")))
;; function for wl-sent-message-via
(defmacro wl-draft-sent-message-p (type)
- (` (eq (nth 1 (assq (, type) wl-sent-message-via)) 'sent)))
+ `(eq (nth 1 (assq ,type wl-sent-message-via)) 'sent))
(defmacro wl-draft-set-sent-message (type result &optional server-port)
- (` (let ((element (assq (, type) wl-sent-message-via)))
- (if element
- (unless (eq (nth 1 element) (, result))
- (setcdr element (list (, result) (, server-port)))
- (setq wl-sent-message-modified t))
- (push (list (, type) (, result) (, server-port)) wl-sent-message-via)
- (setq wl-sent-message-modified t)))))
+ `(let ((element (assq ,type wl-sent-message-via)))
+ (if element
+ (unless (eq (nth 1 element) ,result)
+ (setcdr element (list ,result ,server-port))
+ (setq wl-sent-message-modified t))
+ (push (list ,type ,result ,server-port) wl-sent-message-via)
+ (setq wl-sent-message-modified t))))
(defun wl-draft-sent-message-results ()
(let ((results wl-sent-message-via)
(concat " to="
(mapconcat
'identity
- (mapcar '(lambda(x) (format "<%s>" x)) to)
+ (mapcar (lambda (x) (format "<%s>" x)) to)
","))))
""))
(id (if id (concat " id=" id) ""))
(newline))
(run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(if mail-interactive
- (save-excursion
- (set-buffer errbuf)
+ (with-current-buffer errbuf
(erase-buffer)))
(wl-draft-delete-field "bcc" delimline)
(wl-draft-delete-field "resent-bcc" delimline)
smtp-sasl-user-name
(car smtp-sasl-mechanisms)
smtp-server)))
+ (signal (car err) (cdr err)))
+ (quit
+ (wl-draft-write-sendlog 'uncertain 'smtp smtp-server
+ recipients id)
(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)
- (let ((session
+ (let ((folder
(luna-make-entity
'elmo-pop3-folder
:user (or wl-pop-before-smtp-user
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))))
+ :stream-type (elmo-get-network-stream-type
+ (or wl-pop-before-smtp-stream-type
+ elmo-pop3-default-stream-type))))
+ session)
(condition-case error
(progn
- (elmo-pop3-get-session session)
+ (setq session (elmo-pop3-get-session folder))
(when session (elmo-network-close-session session)))
(error
- (elmo-network-close-session session)
(unless (string= (nth 1 error) "Unplugged")
- (signal (car error)(cdr error))))))
+ (signal (car error) (cdr error))))))
(wl-draft-send-mail-with-smtp))
(defun wl-draft-insert-required-fields (&optional force-msgid)
(defun wl-draft-normal-send-func (editing-buffer kill-when-done)
"Send the message in the current buffer."
(save-restriction
- (std11-narrow-to-header mail-header-separator)
+ (narrow-to-region (goto-char (point-min))
+ (if (re-search-forward
+ (concat
+ "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (match-beginning 0)
+ (point-max)))
(wl-draft-insert-required-fields)
- ;; Delete null fields.
- (goto-char (point-min))
- (while (re-search-forward "^[^ \t\n:]+:[ \t]*\n" nil t)
- (replace-match ""))
;; 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
+ (while (progn (goto-char (point-min))
+ (re-search-forward "\n[ \t]*\n\n*" nil t))
+ (replace-match "\n"))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[^ \t\n:]+:[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n"
+ nil t)
+ (when (string= "" (match-string 1))
+ (replace-match ""))))
+;;; (run-hooks 'wl-mail-send-pre-hook) ; X-PGP-Sig, Cancel-Lock
(wl-draft-dispatch-message)
(when kill-when-done
;; hide editing-buffer.
"Send the message in the current buffer. Not modified the header fields."
(let (delimline mime-bcc)
(if (and wl-draft-verbose-send mes-string)
- (message mes-string))
+ (message "%s" mes-string))
;; get fcc folders.
(setq delimline (wl-draft-get-header-delimiter t))
(unless wl-draft-fcc-list
(setq wl-draft-verbose-msg
(format "Sending%s and Queuing%s..."
sent-via unplugged-via))
- (message (concat wl-draft-verbose-msg "done")))
+ (message "%sdone" wl-draft-verbose-msg))
(if mes-string
- (message (concat mes-string
- (if sent-via "done" "failed")))))))))
+ (message "%s%s"
+ mes-string
+ (if sent-via "done" "failed"))))))))
(not wl-sent-message-modified)) ;; return value
(defun wl-draft-raw-send (&optional kill-when-done force-pre-hook mes-string)
(setq locals (cdr locals)))
result))
+(defcustom wl-draft-send-confirm-with-preview t
+ "*Non-nil to invoke preview through confirmation of sending.
+This variable is valid when `wl-interactive-send' has non-nil value."
+ :type 'boolean
+ :group 'wl-draft)
+
(defun wl-draft-send-confirm ()
- (let (result answer)
- (save-excursion
- (goto-char (point-min))
- (message "Send current draft? <y/n/p(review)> ")
- (setq answer (let ((cursor-in-echo-area t)) (read-char))))
- (cond
- ((or (eq answer (string-to-char "y"))
- (eq answer (string-to-char "Y"))
- (eq answer (string-to-char " ")))
- (setq result t))
- ((or (eq answer (string-to-char "p"))
- (eq answer (string-to-char "P")))
- (wl-draft-preview-message)))
- result))
+ (unwind-protect
+ (condition-case nil
+ (progn
+ (when wl-draft-send-confirm-with-preview
+ (let (wl-draft-send-hook
+ (pgg-decrypt-automatically nil))
+ (wl-draft-preview-message)))
+ (save-excursion
+ (goto-char (point-min)) ; to show recipients in header
+ (funcall
+ (if (functionp wl-draft-send-confirm-type)
+ wl-draft-send-confirm-type
+ (lambda (prompt)
+ (wl-y-or-n-p-with-scroll
+ prompt
+ (eq wl-draft-send-confirm-type 'scroll-by-SPC/BS))))
+ "Send current draft? ")))
+ (quit nil))
+ (when (and wl-draft-send-confirm-with-preview
+ (eq major-mode 'mime-view-mode))
+ (wl-mime-quit-preview))))
(defun wl-draft-send (&optional kill-when-done mes-string)
"Send current draft message.
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)
+;;; 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)
(wl-draft-send-confirm))
" *wl-draft-sending-buffer*"
(append wl-draft-config-variables
(wl-draft-clone-local-variables))))
+ (parent-flag wl-draft-parent-flag)
+ (parent-number wl-draft-parent-number)
+ (parent-folder wl-draft-parent-folder)
(wl-draft-verbose-msg nil)
err)
(unwind-protect
- (save-excursion (set-buffer sending-buffer)
+ (with-current-buffer sending-buffer
(if (and (not (wl-message-mail-p))
(not (wl-message-news-p)))
(error "No recipient is specified"))
- (expand-abbrev) ; for mail-abbrevs
+ (expand-abbrev) ; for mail-abbrevs
(let ((mime-header-encode-method-alist
(append
'((wl-draft-eword-encode-address-list
)
;;
(if wl-draft-verbose-send
- (message (or mes-string "Sending...")))
+ (message "%s" (or mes-string "Sending...")))
+ ;; Set flag before send-function because
+ ;; there's no need to change current mailbox at this time.
+ ;; If flag is set after send-function, the current mailbox
+ ;; might changed by Fcc.
+ ;; It causes a huge loss in the IMAP folder.
+ (when (and parent-flag parent-number
+ (not (eq (length parent-folder) 0)))
+ (condition-case nil
+ (wl-folder-set-persistent-mark
+ parent-folder parent-number parent-flag)
+ (error
+ (message "Set mark (%s) failed" (symbol-name parent-flag)))))
(funcall wl-draft-send-function editing-buffer kill-when-done)
;; Now perform actions on successful sending.
(while mail-send-actions
(error))
(setq mail-send-actions (cdr mail-send-actions)))
(if wl-draft-verbose-send
- (message (concat (or wl-draft-verbose-msg
- mes-string "Sending...")
- "done"))))
+ (message "%sdone"
+ (or wl-draft-verbose-msg
+ mes-string
+ "Sending..."))))
;; kill sending buffer, anyway.
(and (buffer-live-p sending-buffer)
(kill-buffer sending-buffer))))))
"This is a blind carbon copy.")
"\n")
(mime-edit-insert-tag "message" "rfc822")
- (insert-buffer draft-buffer)
+ (insert-buffer-substring draft-buffer)
(let (wl-interactive-send)
(wl-draft-send 'kill-when-done))))))))
-;; Derived from `message-save-drafts' in T-gnus.
(defun wl-draft-save ()
"Save current draft."
(interactive)
(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
+ (message "Saving...")
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max)))
+ next-number)
+ (when wl-draft-buffer-message-number
+ (elmo-folder-delete-messages (wl-draft-get-folder)
+ (list wl-draft-buffer-message-number))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number
+ 'delete))
+ (elmo-folder-check (wl-draft-get-folder))
+ ;; If no header separator, insert it.
+ (with-temp-buffer
(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))
- (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"))))
+ (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))))
+ (append
+ '((eword-encode-unstructured-field-body
+ . (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From)))
+ (if (boundp 'mime-header-encode-method-alist)
+ (symbol-value 'mime-header-encode-method-alist)))))
(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))
+ (wl-draft-get-header-delimiter t)
+ (setq next-number
+ (elmo-folder-next-message-number (wl-draft-get-folder)))
+ (elmo-folder-append-buffer (wl-draft-get-folder)))
+ (elmo-folder-check (wl-draft-get-folder))
+ (elmo-folder-commit (wl-draft-get-folder))
+ (setq wl-draft-buffer-message-number next-number)
+ (rename-buffer (format "%s/%d" wl-draft-folder next-number) t)
+ (setq buffer-file-name (buffer-name))
+ (set-buffer-modified-p nil)
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
+ (message "Saving...done")))
(message "(No changes need to be saved)")))
(defun wl-draft-mimic-kill-buffer ()
(progn (forward-line 1) (point)))))
fcc-list)))
+(defcustom wl-draft-fcc-append-read-folder-history t
+ "Non-nil to append fcc'ed folder to `wl-read-folder-history'."
+ :type 'boolean
+ :group 'wl-draft)
+
(defun wl-draft-do-fcc (header-end &optional fcc-list)
(let ((send-mail-buffer (current-buffer))
- (tembuf (generate-new-buffer " fcc output"))
(case-fold-search t)
beg end)
(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)))
- (set-buffer tembuf)
- (erase-buffer)
+ (unless fcc-list
+ (setq fcc-list (wl-draft-get-fcc-list header-end)))
+ (with-temp-buffer
;; insert just the headers to avoid moving the gap more than
;; necessary (the message body could be arbitrarily huge.)
(insert-buffer-substring send-mail-buffer 1 header-end)
(goto-char (point-max))
(insert-buffer-substring send-mail-buffer header-end)
(let ((id (std11-field-body "Message-ID"))
- (elmo-enable-disconnected-operation t)
- cache-saved)
+ (elmo-enable-disconnected-operation t))
(while fcc-list
- (unless (or cache-saved
- (elmo-folder-plugged-p
- (wl-folder-get-elmo-folder (car fcc-list))))
- (elmo-file-cache-save id nil) ;; for disconnected operation
- (setq cache-saved t))
(if (elmo-folder-append-buffer
(wl-folder-get-elmo-folder
(eword-decode-string (car fcc-list)))
- (not wl-fcc-force-as-read))
+ (and wl-fcc-force-as-read '(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)))))
- (kill-buffer tembuf)))
+ (if (and wl-draft-fcc-append-read-folder-history
+ (boundp 'wl-read-folder-history))
+ (or (equal (car fcc-list) (car wl-read-folder-history))
+ (setq wl-read-folder-history
+ (append (list (car fcc-list)) wl-read-folder-history))))
+ (setq fcc-list (cdr fcc-list)))))))
(defun wl-draft-on-field-p ()
(if (< (point)
(defun wl-draft (&optional header-alist
content-type content-transfer-encoding
body edit-again
- parent-folder)
+ parent-folder
+ parent-number)
"Write and send mail/news message with Wanderlust."
(interactive)
(require 'wl)
(let (wl-demo)
(wl-init)) ; returns immediately if already initialized.
-
- (let (buf-name header-alist-internal)
- (setq buf-name
- (wl-draft-create-buffer parent-folder))
-
+ (wl-start-save-drafts)
+ (let (buffer header-alist-internal)
+ (setq buffer (wl-draft-create-buffer parent-folder parent-number))
(unless (cdr (assq 'From header-alist))
(setq header-alist
(append (list (cons 'From wl-from)) header-alist)))
(if (interactive-p)
(run-hooks 'wl-mail-setup-hook))
(goto-char (point-min))
+ (setq buffer-undo-list nil)
(wl-user-agent-compose-internal) ;; user-agent
(cond ((and
(interactive-p)
(mail-position-on-field "To"))
(t
(goto-char (point-max))))
- buf-name))
+ buffer))
-(defun wl-draft-create-buffer (&optional parent-folder)
- (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
- (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
- (summary-buf (wl-summary-get-buffer parent-folder))
+(defun wl-draft-create-buffer (&optional parent-folder parent-number)
+ (let* ((draft-folder (wl-draft-get-folder))
(reply-or-forward
(or (eq this-command 'wl-summary-reply)
+ (eq this-command 'wl-summary-reply-with-citation)
(eq this-command 'wl-summary-forward)
(eq this-command 'wl-summary-target-mark-forward)
(eq this-command 'wl-summary-target-mark-reply-with-citation)))
- 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-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-message-file-name
- (wl-folder-get-elmo-folder wl-draft-folder)
- num))))
+ (buffer (generate-new-buffer "*draft*"))) ; Just for initial name.
+ (set-buffer buffer)
;; switch-buffer according to draft buffer style.
(if wl-draft-use-frame
- (switch-to-buffer-other-frame buf-name)
+ (switch-to-buffer-other-frame buffer)
(if reply-or-forward
(case wl-draft-reply-buffer-style
(split
(split-window-vertically)
(other-window 1)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(keep
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(full
(delete-other-windows)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(t
(if (functionp wl-draft-reply-buffer-style)
- (funcall wl-draft-reply-buffer-style buf-name)
+ (funcall wl-draft-reply-buffer-style buffer)
(error "Invalid value for wl-draft-reply-buffer-style"))))
(case wl-draft-buffer-style
(split
(wl-summary-toggle-disp-msg 'off))
(split-window-vertically)
(other-window 1)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(keep
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(full
(delete-other-windows)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(t (if (functionp wl-draft-buffer-style)
- (funcall wl-draft-buffer-style buf-name)
+ (funcall wl-draft-buffer-style buffer)
(error "Invalid value for wl-draft-buffer-style"))))))
- (set-buffer buf-name)
- (if (not (string-match (regexp-quote wl-draft-folder)
- (buffer-name)))
- (rename-buffer (concat wl-draft-folder "/" (int-to-string num))))
(auto-save-mode -1)
- (wl-draft-mode)
+ (let (change-major-mode-hook)
+ (wl-draft-mode))
+ (set-buffer-multibyte t) ; draft buffer is always multibyte.
(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)
(setq wl-draft-config-exec-flag t)
(setq wl-draft-parent-folder (or parent-folder ""))
+ (setq wl-draft-parent-number parent-number)
(or (eq this-command 'wl-folder-write-current-folder)
- (setq wl-draft-buffer-cur-summary-buffer summary-buf))
- buf-name))
+ (setq wl-draft-buffer-cur-summary-buffer
+ (wl-summary-get-buffer parent-folder)))
+ buffer))
(defun wl-draft-create-contents (header-alist)
"header-alist' sample
(error "`wl-draft-create-header' must be use in wl-draft-mode"))
(let (change-major-mode-hook)
(wl-draft-editor-mode)
+ (static-when (boundp 'auto-save-file-name-transforms)
+ (make-local-variable 'auto-save-file-name-transforms)
+ (setq auto-save-file-name-transforms
+ (cons (list (concat (regexp-quote wl-draft-folder)
+ "/\\([0-9]+\\)")
+ (concat (expand-file-name
+ "auto-save-"
+ (elmo-folder-msgdb-path
+ (wl-draft-get-folder)))
+ "\\1"))
+ auto-save-file-name-transforms)))
(when wl-draft-write-file-function
(add-hook 'local-write-file-hooks wl-draft-write-file-function))
(wl-draft-overload-functions)
field
nil)))
-(defsubst wl-draft-default-headers ()
+(defun wl-draft-default-headers ()
(list
(cons 'Mail-Reply-To (and wl-insert-mail-reply-to
(wl-address-header-extract-address
(defun wl-draft-generate-clone-buffer (name &optional local-variables)
"Generate clone of current buffer named NAME."
(let ((editing-buffer (current-buffer)))
- (save-excursion
- (set-buffer (generate-new-buffer name))
+ (with-current-buffer (generate-new-buffer name)
(erase-buffer)
(wl-draft-mode)
(wl-draft-editor-mode)
- (insert-buffer editing-buffer)
+ (insert-buffer-substring editing-buffer)
(message "")
(while local-variables
(make-local-variable (car local-variables))
(set (car local-variables)
- (save-excursion
- (set-buffer editing-buffer)
+ (with-current-buffer editing-buffer
(symbol-value (car local-variables))))
(setq local-variables (cdr local-variables)))
(current-buffer))))
(delete-region (point-at-bol)(1+ (point-at-eol)))))
(defun wl-draft-reedit (number)
- (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+ (let ((draft-folder (wl-draft-get-folder))
(wl-draft-reedit t)
- buffer file-name change-major-mode-hook body-top)
- (setq file-name (elmo-message-file-name draft-folder number))
- (unless (file-exists-p file-name)
- (error "File %s does not exist" file-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)))
- ;; switch-buffer according to draft buffer style.
- (if wl-draft-use-frame
- (switch-to-buffer-other-frame buffer)
- (case wl-draft-buffer-style
- (split
- (split-window-vertically)
- (other-window 1)
- (switch-to-buffer buffer))
- (keep
- (switch-to-buffer buffer))
- (full
- (delete-other-windows)
- (switch-to-buffer buffer))
- (t (if (functionp wl-draft-buffer-style)
- (funcall wl-draft-buffer-style buffer)
- (error "Invalid value for wl-draft-buffer-style")))))
- (set-buffer buffer)
- (insert-file-contents-as-binary file-name)
- (elmo-delete-cr-buffer)
- (let((mime-edit-again-ignored-field-regexp
- "^\\(Content-.*\\|Mime-Version\\):"))
- (wl-draft-decode-message-in-buffer))
- (setq body-top (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)
- (when wl-draft-write-file-function
- (add-hook 'local-write-file-hooks wl-draft-write-file-function))
- (wl-highlight-headers 'for-draft)
- (goto-char body-top)
- (run-hooks 'wl-draft-reedit-hook)
- (goto-char (point-max))
- buffer)))
+ (num 0)
+ buffer change-major-mode-hook body-top)
+ (setq buffer (get-buffer-create (format "%s/%d" wl-draft-folder
+ number)))
+ (if wl-draft-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ (set-buffer buffer)
+ (elmo-message-fetch draft-folder number (elmo-make-fetch-strategy 'entire))
+ (elmo-delete-cr-buffer)
+ (let ((mime-edit-again-ignored-field-regexp
+ "^\\(Content-.*\\|Mime-Version\\):"))
+ (wl-draft-decode-message-in-buffer))
+ (setq body-top (wl-draft-insert-mail-header-separator))
+ (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)
+ (setq wl-sent-message-queued nil)
+ (wl-draft-config-info-operation number 'load)
+ (goto-char (point-min))
+ (wl-draft-overload-functions)
+ (wl-draft-editor-mode)
+ (static-when (boundp 'auto-save-file-name-transforms)
+ (make-local-variable 'auto-save-file-name-transforms)
+ (setq auto-save-file-name-transforms
+ (cons (list (concat (regexp-quote wl-draft-folder)
+ "/\\([0-9]+\\)")
+ (concat (expand-file-name
+ "auto-save-"
+ (elmo-folder-msgdb-path
+ (wl-draft-get-folder)))
+ "\\1"))
+ auto-save-file-name-transforms)))
+ (setq buffer-file-name (buffer-name)
+ wl-draft-buffer-message-number number)
+ (unless wl-draft-parent-folder
+ (setq wl-draft-parent-folder ""))
+ (when wl-draft-write-file-function
+ (add-hook 'local-write-file-hooks wl-draft-write-file-function))
+ (wl-highlight-headers 'for-draft)
+ (goto-char body-top)
+ (run-hooks 'wl-draft-reedit-hook)
+ (goto-char (point-max))
+ buffer))
-(defmacro wl-draft-body-goto-top ()
- (` (progn
- (goto-char (point-min))
- (if (re-search-forward mail-header-separator nil t)
- (forward-char 1)
- (goto-char (point-max))))))
+(defun wl-draft-body-goto-top ()
+ (goto-char (point-min))
+ (if (re-search-forward mail-header-separator nil t)
+ (forward-char 1)
+ (goto-char (point-max))))
-(defmacro wl-draft-body-goto-bottom ()
- (` (goto-char (point-max))))
+(defun wl-draft-body-goto-bottom ()
+ (goto-char (point-max)))
-(defmacro wl-draft-config-body-goto-header ()
- (` (progn
- (goto-char (point-min))
- (if (re-search-forward mail-header-separator nil t)
- (beginning-of-line)
- (goto-char (point-max))))))
+(defun wl-draft-config-body-goto-header ()
+ (goto-char (point-min))
+ (if (re-search-forward mail-header-separator nil t)
+ (beginning-of-line)
+ (goto-char (point-max))))
(defsubst wl-draft-config-sub-eval-insert (content &optional newline)
(let (content-value)
((eq key 'reply)
(when (and
reply-buf
- (save-excursion
- (set-buffer reply-buf)
+ (with-current-buffer reply-buf
(save-restriction
(std11-narrow-to-header)
(goto-char (point-min))
(setq found t)))
(if (and found wl-draft-config-matchone)
(throw 'done t))
- (setq alist (cdr alist))))
- (if found
- (setq wl-draft-config-exec-flag nil))
- (run-hooks 'wl-draft-config-exec-hook)
- (put-text-property (point-min)(point-max) 'face nil)
- (wl-highlight-message (point-min)(point-max) t)
- (setq wl-draft-config-variables
- (elmo-uniq-list local-variables))))))
+ (setq alist (cdr alist)))))
+ (if found
+ (setq wl-draft-config-exec-flag nil))
+ (run-hooks 'wl-draft-config-exec-hook)
+ (put-text-property (point-min)(point-max) 'face nil)
+ (wl-highlight-message (point-min)(point-max) t)
+ (setq wl-draft-config-variables
+ (elmo-uniq-list local-variables)))))
(defun wl-draft-replace-field (field content &optional add)
(save-excursion
(goto-char (point-max))
(insert (concat field ": " content "\n"))))))))
+(defsubst wl-draft-config-info-filename (number msgdb-dir)
+ (expand-file-name
+ (format "%s-%d" wl-draft-config-save-filename number)
+ msgdb-dir))
+
(defun wl-draft-config-info-operation (msg operation)
- (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)
- msgdb-dir))
+ (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-draft-get-folder)))
+ (filename (wl-draft-config-info-filename msg msgdb-dir))
element alist variable)
(cond
((eq operation 'save)
(let ((send-buffer (current-buffer))
(folder (wl-folder-get-elmo-folder wl-queue-folder))
(message-id (std11-field-body "Message-ID")))
- (if (elmo-folder-append-buffer folder t)
+ (if (elmo-folder-append-buffer folder)
(progn
(wl-draft-queue-info-operation
(car (elmo-folder-status folder))
(wl-draft-queue-info-operation (car msgs) 'load)
(elmo-message-fetch queue-folder
(car msgs)
- (elmo-make-fetch-strategy 'entire)
- nil (current-buffer))
+ (elmo-make-fetch-strategy 'entire))
(condition-case err
(setq failure (funcall
wl-draft-queue-flush-send-function
(switch-to-buffer buf))))))
(defun wl-jump-to-draft-folder ()
- (let ((msgs (reverse (elmo-folder-list-messages (wl-folder-get-elmo-folder
- wl-draft-folder))))
+ (let ((msgs (reverse (elmo-folder-list-messages (wl-draft-get-folder))))
(mybuf (buffer-name))
msg buf)
(if (not msgs)
(message "No draft message exist.")
(if (string-match (concat "^" wl-draft-folder "/") mybuf)
(setq msg (cadr (memq
- (string-to-int (substring mybuf (match-end 0)))
+ (string-to-number (substring mybuf (match-end 0)))
msgs))))
(or msg (setq msg (car msgs)))
(if (setq buf (get-buffer (format "%s/%d" wl-draft-folder msg)))
(put-text-property (point-min) (point-max) 'face nil)
(wl-highlight-message (point-min) (point-max) t))
(set-buffer-modified-p modified))))
+ (static-when (featurep 'xemacs)
+ ;; Cope with one of many XEmacs bugs that `recenter' takes
+ ;; a long time if there are a lot of invisible text lines.
+ (redraw-frame))
(recenter n))
+;; insert element from history
+(defvar wl-draft-current-history-position nil)
+(defvar wl-draft-history-backup-word "")
+
+(defun wl-draft-previous-history-element (n)
+ (interactive "p")
+ (let (bol history beg end prev new)
+ (when (and (not (wl-draft-on-field-p))
+ (< (point)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n") nil 0)
+ (point)))
+ (save-excursion
+ (beginning-of-line)
+ (while (and (looking-at "^[ \t]")
+ (not (= (point) (point-min))))
+ (forward-line -1))
+ (cond
+ ((looking-at wl-folder-complete-header-regexp)
+ (and (boundp 'wl-read-folder-history)
+ (setq history wl-read-folder-history)))
+;;; ((looking-at wl-address-complete-header-regexp)
+;;; (setq history .....))
+ (t
+ nil)))
+ (eolp))
+ (setq bol (save-excursion (beginning-of-line) (point)))
+ (cond ((and (or (eq last-command 'wl-draft-previous-history-element)
+ (eq last-command 'wl-draft-next-history-element))
+ wl-draft-current-history-position)
+ (setq end (point))
+ (or (search-backward-regexp ",[ \t]*\\(.*\\)" bol t)
+ (search-backward-regexp "^[ \t]\\(.*\\)" bol t)
+ (search-backward-regexp "^[^ \t]*: \\(.*\\)" bol t))
+ (setq prev (match-string 1))
+ (goto-char (match-beginning 1))
+ (setq beg (point))
+ (if (cond ((< n 0)
+ (>= (+ n wl-draft-current-history-position) 0))
+ ((> n 0)
+ (<= (+ n wl-draft-current-history-position)
+ (length history))))
+ (progn
+ (setq wl-draft-current-history-position
+ (+ n wl-draft-current-history-position))
+ (setq new
+ (nth wl-draft-current-history-position
+ (append (list wl-draft-history-backup-word)
+ history)))
+ (delete-region beg end)
+ (insert new))
+ (goto-char end)
+ (cond ((< n 0)
+ (message "End of history; no next item"))
+ ((> n 0)
+ (message "Beginning of history; no preceding item")))))
+ ((and (> n 0)
+ (save-excursion
+ (or (search-backward-regexp ",[ \t]*\\(.*\\)" bol t)
+ (search-backward-regexp "^[ \t]\\(.*\\)" bol t)
+ (search-backward-regexp "^[^ \t]*: \\(.*\\)" bol t)))
+ (car history))
+ (setq wl-draft-current-history-position 1)
+ (setq wl-draft-history-backup-word (match-string 1))
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (car history)))
+ (t
+ (setq wl-draft-current-history-position nil))))))
+
+(defun wl-draft-next-history-element (n)
+ (interactive "p")
+ (wl-draft-previous-history-element (- n)))
+
;;;; user-agent support by Sen Nagata
;; this appears to be necessarily global...
(goto-char (point-min))
(search-forward mail-header-separator)
(forward-line 1)
- (insert body-text))
+ (insert body-text)
+ (or (bolp) (insert "\n")))
;;;###autoload
(defun wl-user-agent-compose (&optional to subject other-headers continue
;; 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-buffer-style switch-function))
+ (wl-draft-buffer-style switch-function)
+ tem)
(if to
- (if (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
- 'ignore-case)
- (setcdr
- (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
- 'ignore-case)
- to)
+ (if (setq tem (wl-string-match-assoc
+ "\\`to\\'"
+ wl-user-agent-headers-and-body-alist
+ 'ignore-case))
+ (setcdr tem to)
(setq wl-user-agent-headers-and-body-alist
(cons (cons "to" to)
wl-user-agent-headers-and-body-alist))))
(if subject
- (if (wl-string-match-assoc "subject"
- wl-user-agent-headers-and-body-alist
- 'ignore-case)
- (setcdr
- (wl-string-match-assoc "subject"
- wl-user-agent-headers-and-body-alist
- 'ignore-case)
- subject)
+ (if (setq tem (wl-string-match-assoc
+ "\\`subject\\'"
+ wl-user-agent-headers-and-body-alist
+ 'ignore-case))
+ (setcdr tem subject)
(setq wl-user-agent-headers-and-body-alist
(cons (cons "subject" subject)
wl-user-agent-headers-and-body-alist))))
;; highlight headers (from wl-draft in wl-draft.el)
(wl-highlight-headers 'for-draft)
;; insert body
- (if (wl-string-match-assoc "body" wl-user-agent-headers-and-body-alist
- 'ignore-case)
- (wl-user-agent-insert-body
- (cdr (wl-string-match-assoc
- "body"
- wl-user-agent-headers-and-body-alist 'ignore-case)))))
+ (let ((body (wl-string-match-assoc "\\`body\\'"
+ wl-user-agent-headers-and-body-alist
+ 'ignore-case)))
+ (if body
+ (wl-user-agent-insert-body (cdr body)))))
t))
+(defun wl-draft-setup-parent-flag (flag)
+ "Setup a FLAG for parent message."
+ (when (and (> (length wl-draft-parent-folder) 0)
+ wl-draft-parent-number)
+ (setq wl-draft-parent-flag flag)
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)))
+
+(defun wl-draft-buffer-change-number (old-number new-number)
+ (when (eq wl-draft-buffer-message-number old-number)
+ (setq wl-draft-buffer-message-number new-number)
+ (rename-buffer (format "%s/%d" wl-draft-folder new-number) t)
+ (setq buffer-file-name (buffer-name))
+ (set-buffer-modified-p nil)))
+
+(defun wl-draft-rename-saved-config (old-number new-number)
+ (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-draft-get-folder)))
+ (old-name (wl-draft-config-info-filename old-number msgdb-dir))
+ (new-name (wl-draft-config-info-filename new-number msgdb-dir)))
+ (when (file-exists-p old-name)
+ (rename-file old-name new-name 'ok-if-already-exists))))
+
(require 'product)
(product-provide (provide 'wl-draft) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff