;;; wl-draft.el -- Message draft mode for Wanderlust.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Keywords: mail, net news
-;; Time-stamp: <2000-03-22 19:12:26 teranisi>
;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
(require 'sendmail)
(require 'wl-template)
(require 'emu)
-(if (module-installed-p 'timezone)
- (require 'timezone))
+(condition-case nil (require 'timezone) (error nil))
(require 'std11)
(require 'wl-vars)
+(defvar x-face-add-x-face-version-header)
+(defvar mail-reply-buffer)
+(defvar mail-from-style)
+
(eval-when-compile
- (require 'smtp)
(require 'elmo-pop3)
- (mapcar
- (function
- (lambda (symbol)
- (unless (boundp symbol)
- (set (make-local-variable symbol) nil))))
- '(x-face-add-x-face-version-header
- mail-reply-buffer
- mail-from-style
- smtp-authenticate-type
- smtp-authenticate-user
- smtp-authenticate-passphrase
- smtp-connection-type
- ))
- (defun-maybe x-face-insert (a))
- (defun-maybe x-face-insert-version-header ())
- (defun-maybe wl-init (&optional a))
- (defun-maybe wl-draft-mode ()))
+ (defalias-maybe 'x-face-insert 'ignore)
+ (defalias-maybe 'x-face-insert-version-header 'ignore)
+ (defalias-maybe 'wl-init 'ignore)
+ (defalias-maybe 'wl-draft-mode 'ignore))
(defvar wl-draft-buf-name "Draft")
(defvar wl-caesar-region-func nil)
(make-variable-buffer-local 'wl-draft-fcc-list)
(make-variable-buffer-local 'wl-draft-reply-buffer)
-;;; SMTP binding by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-(defvar wl-smtp-features
- '(((smtp-authenticate-type
- (if wl-smtp-authenticate-type
- (intern (downcase (format "%s" wl-smtp-authenticate-type)))))
- ((smtp-authenticate-user wl-smtp-posting-user)
- ((smtp-authenticate-passphrase
- (elmo-get-passwd
- (format "%s@%s"
- smtp-authenticate-user
- smtp-server))))))
- (smtp-connection-type))
- "Additional SMTP features.")
-
-(eval-when-compile
- (defun wl-smtp-parse-extension (exts parents)
- (let (bindings binding feature)
- (dolist (ext exts)
- (setq feature (if (listp (car ext)) (caar ext) (car ext))
- binding
- (` ((, feature)
- (or (, (if (listp (car ext))
- (cadar ext)
- (let ((wl-feature
- (intern
- (concat "wl-" (symbol-name feature)))))
- (if (boundp wl-feature)
- wl-feature))))
- (and (boundp '(, feature)) (, feature))))))
- (when parents
- (setcdr binding (list (append '(and) parents (cdr binding)))))
- (setq bindings
- (nconc bindings (list binding)
- (wl-smtp-parse-extension
- (cdr ext) (cons feature parents)))))
- bindings)))
-
(defmacro wl-smtp-extension-bind (&rest body)
- "Return a `let' form that binds all variables of SMTP extension.
-After this is done, BODY will be executed in the scope
-of the `let' form.
-
-The variables bound and their default values are described by
-the `wl-smtp-features' variable."
- (` (let* (, (wl-smtp-parse-extension wl-smtp-features nil))
+ (` (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
+ (format "%s@%s"
+ smtp-sasl-user-name
+ smtp-server)))))
(,@ body))))
(defun wl-draft-insert-date-field ()
+ "Insert Date field."
(insert "Date: " (wl-make-date-string) "\n"))
(defun wl-draft-insert-from-field ()
+ "Insert From field."
;; Put the "From:" field in unless for some odd reason
;; they put one in themselves.
(let* ((login (or user-mail-address (user-login-name)))
(fullname (user-full-name)))
(cond ((eq mail-from-style 'angles)
(insert "From: " fullname)
- (let ((fullname-start (+ (point-min) 6))
+ (let ((fullname-start (+ (point-min) (length "From: ")))
(fullname-end (point-marker)))
(goto-char fullname-start)
;; Look for a character that cannot appear unquoted
;; ... then undo escaping of matching parentheses,
;; including matching nested parentheses.
(goto-char fullname-start)
- (while (re-search-forward
+ (while (re-search-forward
"\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
fullname-end 1)
(replace-match "\\1(\\3)" t)
(goto-char fullname-start))))
(insert ")\n"))
- ((null mail-from-style)
+ ((not mail-from-style)
(insert "From: " login "\n")))))
(defun wl-draft-insert-x-face-field ()
- "Insert x-face header."
+ "Insert X-Face header."
(interactive)
- (if (not (file-exists-p wl-x-face-file))
- (error "File %s does not exist" wl-x-face-file)
- (beginning-of-buffer)
- (search-forward mail-header-separator nil t)
- (beginning-of-line)
- (wl-draft-insert-x-face-field-here)
- (run-hooks 'wl-draft-insert-x-face-field-hook) ; highlight it if you want.
- ))
+ (unless (file-exists-p wl-x-face-file)
+ (error "File %s does not exist" wl-x-face-file))
+ (beginning-of-buffer)
+ (search-forward mail-header-separator nil t)
+ (beginning-of-line)
+ (wl-draft-insert-x-face-field-here)
+ (run-hooks 'wl-draft-insert-x-face-field-hook)) ; highlight it if you want.
(defun wl-draft-insert-x-face-field-here ()
- "insert x-face field at point."
+ "Insert X-Face field at point."
(let ((x-face-string (elmo-get-file-string wl-x-face-file)))
- (if (string-match "^[ \t]*" x-face-string)
- (setq x-face-string (substring x-face-string (match-end 0))))
+ (when (string-match "^[ \t]*" x-face-string)
+ (setq x-face-string (substring x-face-string (match-end 0))))
(insert "X-Face: " x-face-string))
- (if (not (= (preceding-char) ?\n))
- (insert ?\n))
- (and (fboundp 'x-face-insert-version-header) ; x-face.el...
- (boundp 'x-face-add-x-face-version-header)
- x-face-add-x-face-version-header
- (x-face-insert-version-header)))
+ (when (not (= (preceding-char) ?\n)) ; for chomped (choped) x-face-string
+ (insert ?\n))
+ ;; Insert X-Face-Version: field
+ (when (and (fboundp 'x-face-insert-version-header)
+ (boundp 'x-face-add-x-face-version-header)
+ x-face-add-x-face-version-header)
+ (x-face-insert-version-header)))
(defun wl-draft-setup ()
(let ((field wl-draft-fields)
(setq wl-draft-field-completion-list ret-val)))
(defun wl-draft-make-mail-followup-to (recipients)
- (if (elmo-list-member
+ (if (elmo-list-member
(or wl-user-mail-address-list
(list (wl-address-header-extract-address wl-from)))
recipients)
- (let ((rlist (elmo-list-delete
+ (let ((rlist (elmo-list-delete
(or wl-user-mail-address-list
(list (wl-address-header-extract-address wl-from)))
(copy-sequence recipients))))
- (if (elmo-list-member rlist (mapcar 'downcase
+ (if (elmo-list-member rlist (mapcar 'downcase
wl-subscribed-mailing-list))
rlist
- (append rlist (list (wl-address-header-extract-address
+ (append rlist (list (wl-address-header-extract-address
wl-from)))))
recipients))
(defun wl-draft-delete-myself-from-cc (to cc)
(let ((myself (or wl-user-mail-address-list
(list (wl-address-header-extract-address wl-from)))))
- (if wl-draft-always-delete-myself
- (elmo-list-delete myself cc)
- (if (elmo-list-member myself cc)
- (if (elmo-list-member (append to cc)
- (mapcar 'downcase wl-subscribed-mailing-list))
- ;; member list is contained in recipients.
- (elmo-list-delete myself cc)
- cc
- )
- cc))))
+ (cond (wl-draft-always-delete-myself ; always-delete option
+ (elmo-list-delete myself cc))
+ ((elmo-list-member (append to cc) ; subscribed mailing-list
+ (mapcar 'downcase wl-subscribed-mailing-list))
+ (elmo-list-delete myself cc))
+ (t cc))))
(defun wl-draft-forward (original-subject summary-buf)
- (wl-draft "" (concat "Forward: " original-subject)
- nil nil nil nil nil nil nil nil summary-buf)
+ (let (references)
+ (with-current-buffer (wl-message-get-original-buffer)
+ (setq references (nconc
+ (std11-field-bodies '("References" "In-Reply-To"))
+ (list (std11-field-body "Message-Id"))))
+ (setq references (delq nil references)
+ references (mapconcat 'identity references " ")
+ references (wl-draft-parse-msg-id-list-string references)
+ references (wl-delete-duplicates references)
+ references (when references
+ (mapconcat 'identity references "\n\t"))))
+ (wl-draft "" (concat "Forward: " original-subject)
+ nil nil references nil nil nil nil nil nil summary-buf))
(goto-char (point-max))
(wl-draft-insert-message)
(mail-position-on-field "To"))
-(defun wl-draft-reply (buf no-arg summary-buf)
-; (save-excursion
- (let ((r-list (if no-arg wl-draft-reply-without-argument-list
- wl-draft-reply-with-argument-list))
+(defun wl-draft-strip-subject-re (subject)
+ "Remove \"Re:\" from subject lines. Shamelessly copied from Gnus"
+ (if (string-match wl-subject-prefix-regexp subject)
+ (substring subject (match-end 0))
+ subject))
+
+(defun wl-draft-reply-list-symbol (with-arg)
+ "Return symbol `wl-draft-reply-*-argument-list' match condition.
+Check WITH-ARG and From: field."
+ (if (wl-address-user-mail-address-p (or (elmo-field-body "From") ""))
+ (if with-arg
+ 'wl-draft-reply-myself-with-argument-list
+ 'wl-draft-reply-myself-without-argument-list)
+ (if with-arg
+ 'wl-draft-reply-with-argument-list
+ 'wl-draft-reply-without-argument-list)))
+
+(defun wl-draft-reply (buf with-arg summary-buf)
+ "Reply to BUF buffer message.
+Reply to author if WITH-ARG is non-nil."
+;;;(save-excursion
+ (let (r-list
to mail-followup-to cc subject in-reply-to references newsgroups
- from)
+ from to-alist cc-alist decoder)
(set-buffer buf)
- (if (wl-address-user-mail-address-p
- (setq from
- (wl-address-header-extract-address (std11-field-body "From"))))
- (setq to (mapconcat 'identity (elmo-multiple-field-body "To") ",")
- cc (mapconcat 'identity (elmo-multiple-field-body "Cc") ",")
- newsgroups (or (std11-field-body "Newsgroups") ""))
- (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
- (if (not (std11-field-body (car condition)))
- (throw 'done nil))
- (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))))
- (setq to (wl-concat-list (cons to
- (elmo-multiple-fields-body-list
- r-to-list))
- ","))
- (setq cc (wl-concat-list (cons cc
- (elmo-multiple-fields-body-list
- r-cc-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-without-argument-list'")))
+ (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
+ (catch 'done
+ (while r-list
+ (when (let ((condition (car (car r-list))))
+ (cond ((stringp condition)
+ (std11-field-body condition))
+ ((listp condition)
+ (catch 'done
+ (while condition
+ (if (not (std11-field-body (car condition)))
+ (throw 'done nil))
+ (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))))
+ (setq to (wl-concat-list (cons to
+ (elmo-multiple-fields-body-list
+ r-to-list))
+ ","))
+ (setq cc (wl-concat-list (cons cc
+ (elmo-multiple-fields-body-list
+ r-cc-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 `%s'"
+ (symbol-name (wl-draft-reply-list-symbol with-arg))))
(setq subject (std11-field-body "Subject"))
- (with-temp-buffer ; to keep raw buffer unibyte.
+ (setq to (wl-parse-addresses to)
+ cc (wl-parse-addresses cc))
+ (with-temp-buffer ; to keep raw buffer unibyte.
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq subject (or (and subject
- (eword-decode-string
- (decode-mime-charset-string
- subject
- wl-mime-charset))))))
- (and subject wl-reply-subject-prefix
- (let ((case-fold-search t))
- (not
- (equal
- (string-match (regexp-quote wl-reply-subject-prefix)
- subject)
- 0)))
- (setq subject (concat wl-reply-subject-prefix subject)))
- (and (setq in-reply-to (std11-field-body "Message-Id"))
- (setq in-reply-to
- (format "In your message of \"%s\"\n\t%s"
- (or (std11-field-body "Date") "some time ago")
- in-reply-to)))
+ (setq decoder (mime-find-field-decoder 'Subject 'plain))
+ (setq subject (if (and subject decoder)
+ (funcall decoder subject) subject))
+ (setq to-alist
+ (mapcar
+ (lambda (addr)
+ (setq decoder (mime-find-field-decoder 'To 'plain))
+ (cons (nth 1 (std11-extract-address-components addr))
+ (if decoder (funcall decoder addr) addr)))
+ to))
+ (setq cc-alist
+ (mapcar
+ (lambda (addr)
+ (setq decoder (mime-find-field-decoder 'Cc 'plain))
+ (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 in-reply-to (std11-field-body "Message-Id"))
(setq references (nconc
(std11-field-bodies '("References" "In-Reply-To"))
(list in-reply-to)))
- (setq to (wl-parse-addresses to)
- cc (wl-parse-addresses cc))
- (setq to (mapcar '(lambda (addr)
- (wl-address-header-extract-address
- addr)) to))
- (setq cc (mapcar '(lambda (addr)
- (wl-address-header-extract-address
- addr)) cc))
+ (setq to (delq nil (mapcar 'car to-alist)))
+ (setq cc (delq nil (mapcar 'car cc-alist)))
;; if subscribed mailing list is contained in cc or to
;; and myself is contained in cc,
;; delete myself from cc.
(setq cc (wl-draft-delete-myself-from-cc to cc))
- (if wl-insert-mail-followup-to
- (progn
- (setq mail-followup-to
- (wl-draft-make-mail-followup-to (append to cc)))
- (setq mail-followup-to (wl-delete-duplicates mail-followup-to
- nil t))))
- (setq newsgroups (wl-parse newsgroups
+ (when wl-insert-mail-followup-to
+ (setq mail-followup-to
+ (wl-draft-make-mail-followup-to (append to cc)))
+ (setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
+ (setq newsgroups (wl-parse newsgroups
"[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
newsgroups (wl-delete-duplicates newsgroups)
newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
(setq to (wl-delete-duplicates to nil t))
- (setq cc (wl-delete-duplicates
+ (setq cc (wl-delete-duplicates
(append (wl-delete-duplicates cc nil t)
to (copy-sequence to))
t t))
- (and to (setq to (mapconcat 'identity to ",\n\t")))
- (and cc (setq cc (mapconcat 'identity cc ",\n\t")))
- (and mail-followup-to (setq mail-followup-to
- (mapconcat 'identity
- mail-followup-to ",\n\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))
+ 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))
+ 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))
+ mail-followup-to ",\n\t")))
(and (null to) (setq to cc cc nil))
(setq references (delq nil references)
references (mapconcat 'identity references " ")
- references (wl-parse references "[^<]*\\(<[^>]+>\\)")
+ references (wl-draft-parse-msg-id-list-string references)
references (wl-delete-duplicates references)
- references (if references
+ references (if references
(mapconcat 'identity references "\n\t")))
(wl-draft
to subject in-reply-to cc references newsgroups mail-followup-to
- nil nil nil summary-buf)
+ nil nil nil nil summary-buf)
(setq wl-draft-reply-buffer buf))
(run-hooks 'wl-reply-hook))
+(defun wl-draft-add-references ()
+ (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))
+ (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)))
+ (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))
+ t)))
+
(defun wl-draft-yank-from-mail-reply-buffer (decode-it
&optional ignored-fields)
(interactive)
(save-restriction
- (current-buffer)
(narrow-to-region (point)(point))
- (insert
+ (insert
(save-excursion
(set-buffer mail-reply-buffer)
- (if decode-it
- (decode-mime-charset-region (point-min) (point-max)
- wl-mime-charset))
- (buffer-substring-no-properties
+ (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))
(t (and wl-draft-cite-func
(funcall wl-draft-cite-func)))) ; default cite
(run-hooks 'wl-draft-cited-hook)
- (if wl-highlight-body-too
- (wl-highlight-body-region beg (point-max)))))
+ (when (and wl-draft-add-references
+ (wl-draft-add-references))
+ (wl-highlight-headers 'for-draft)) ; highlight when added References:
+ (when wl-highlight-body-too
+ (wl-highlight-body-region beg (point-max)))))
(defun wl-draft-confirm ()
+ "Confirm send message."
(interactive)
- (y-or-n-p (format "Send current draft as %s? "
- (if (wl-message-mail-p)
- (if (wl-message-news-p) "Mail and News" "Mail")
- "News"))))
-
-(defun wl-message-news-p ()
- (std11-field-body "Newsgroups"))
+ (y-or-n-p
+ (cond ((and (wl-message-mail-p) (wl-message-news-p))
+ "Send current draft as Mail and News? ")
+ ((wl-message-mail-p) "Send current draft as Mail? ")
+ ((wl-message-news-p) "Send current draft as News? "))))
(defun wl-message-field-exists-p (field)
+ "If FIELD exist and FIELD value is not empty, return non-nil."
(let ((value (std11-field-body field)))
(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")
- ;;(wl-message-field-exists-p "Fcc") ; This may be needed..
+;;; This may be needed..
+;;; (wl-message-field-exists-p "Fcc")
))
(defun wl-draft-open-file (&optional file)
- (interactive) ; "*fFile to edit: ")
- (wl-draft-edit-string (elmo-get-file-string
+ "Open FILE for edit."
+ (interactive)
+;;;(interactive "*fFile to edit: ")
+ (wl-draft-edit-string (elmo-get-file-string
(or file
- (read-file-name "File to edit: "
+ (read-file-name "File to edit: "
(or wl-tmp-dir "~/"))))))
(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
- 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
(setq references (std11-field-body "References"))
(setq newsgroups (std11-field-body "Newsgroups"))
(setq mail-followup-to (std11-field-body "Mail-Followup-To"))
- (setq content-type (std11-field-body "Content-Type"))
+ (setq content-type (std11-field-body "Content-Type"))
+ (setq content-transfer-encoding (std11-field-body "Content-Transfer-Encoding"))
(goto-char (point-min))
(or (re-search-forward "\n\n" nil t)
(search-forward (concat mail-header-separator "\n") nil t))
(unwind-protect
(set-buffer
- (wl-draft to subject in-reply-to cc references newsgroups
+ (wl-draft to subject in-reply-to cc references newsgroups
mail-followup-to
- content-type
+ 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)))
(setq buffer-read-only nil) ;;??
- (run-hooks 'wl-mail-setup-hook))
+ (run-hooks 'wl-draft-reedit-hook))
(defun wl-draft-insert-current-message (dummy)
(interactive)
(let ((mail-reply-buffer (wl-message-get-original-buffer))
mail-citation-hook mail-yank-hooks
- wl-draft-cite-func)
- (if (eq 0
- (save-excursion
- (set-buffer mail-reply-buffer)
- (buffer-size)))
+ 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))))
(defun wl-draft-insert-get-message (dummy)
- (let ((fld (completing-read
- "Folder name: "
+ (let ((fld (completing-read
+ "Folder name: "
(if (memq 'read-folder wl-use-folder-petname)
(wl-folder-get-entity-with-petname)
wl-folder-entity-hashtb)
nil nil wl-default-spec
'wl-read-folder-hist))
- (number (call-interactively
+ (number (call-interactively
(function (lambda (num)
(interactive "nNumber: ")
num))))
message-buf
(buffer-live-p message-buf))
(progn
- (save-excursion
+ (save-excursion
(set-buffer summary-buf)
- (setq num
+ (setq num
(save-excursion
(set-buffer message-buf)
wl-message-buffer-cur-number))
- (setq entity (assoc (cdr (assq num
- (elmo-msgdb-get-number-alist
+ (setq entity (assoc (cdr (assq num
+ (elmo-msgdb-get-number-alist
wl-summary-buffer-msgdb)))
- (elmo-msgdb-get-overview
+ (elmo-msgdb-get-overview
wl-summary-buffer-msgdb)))
(setq from (elmo-msgdb-overview-entity-get-from entity))
(setq date (elmo-msgdb-overview-entity-get-date entity)))
- (setq cite-title (format "At %s,\n%s wrote:"
+ (setq cite-title (format "At %s,\n%s wrote:"
(or date "some time ago")
(wl-summary-from-func-internal
(or from "you"))))))
- (and cite-title
+ (and cite-title
(insert cite-title "\n"))
(mail-indent-citation)))
;; if Summary is on the frame, select it.
(select-window sum-win)
;; if summary is not on the frame, switch to it.
- (if (and wl-stay-folder-window
+ (if (and wl-stay-folder-window
(or wl-draft-resume-folder-window fld-win))
(wl-folder-select-buffer sum-buf)
(switch-to-buffer sum-buf)))))))
(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
- (elmo-match-string 0 wl-draft-buffer-file-name)))))
+ (string-to-int
+ (match-string 0 wl-draft-buffer-file-name)))))
(wl-draft-config-info-operation msg 'delete))))
(set-buffer-modified-p nil) ; force kill
(kill-buffer editing-buffer))))
(message "")))
(defun wl-draft-fcc ()
- "Add a new FCC field, with file name completion."
+ "Add a new Fcc field, with file name completion."
(interactive)
- (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
+ (or (mail-position-on-field "fcc" t) ;Put new field after exiting Fcc.
(mail-position-on-field "to"))
- (insert "\nFCC: "))
+ (insert "\nFcc: "))
;; function for wl-sent-message-via
(> filesize wl-draft-sendlog-max-size))
(rename-file filename (concat filename ".old") t))
(if (file-writable-p filename)
- (write-region (point-min) (point-max)
+ (write-region (point-min) (point-max)
filename t 'no-msg)
(message (format "%s is not writable." filename)))
(kill-buffer tmp-buf)))))
;; should never happen
(t (error "qmail-inject reported unknown failure"))))))
+(defun wl-draft-parse-msg-id-list-string (string)
+ "Get msg-id list from STRING."
+ (let (msg-id-list)
+ (dolist (parsed-id (std11-parse-msg-ids-string string))
+ (when (eq (car parsed-id) 'msg-id)
+ (setq msg-id-list (cons (std11-msg-id-string parsed-id)
+ msg-id-list))))
+ (nreverse msg-id-list)))
+
+(defun wl-draft-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.
+If optional argument REMOVE-GROUP-LIST is non-nil, remove group list content
+from current buffer."
+ (save-excursion
+ (let ((case-fold-search t)
+ (inhibit-read-only t)
+ addresses address
+ mailbox-list beg seq has-group-list)
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^" (regexp-quote field) "[\t ]*:")
+ nil t)
+ (setq beg (point))
+ (re-search-forward "^[^ \t]" nil 'move)
+ (beginning-of-line)
+ (skip-chars-backward "\n")
+ (setq seq (std11-lexical-analyze
+ (buffer-substring-no-properties beg (point))))
+ (setq addresses (std11-parse-addresses seq))
+ (while addresses
+ (cond ((eq (car (car addresses)) 'group)
+ (setq has-group-list t)
+ (setq mailbox-list
+ (nconc mailbox-list
+ (mapcar
+ 'std11-address-string
+ (nth 2 (car addresses))))))
+ ((eq (car (car addresses)) 'mailbox)
+ (setq address (nth 1 (car addresses)))
+ (setq mailbox-list
+ (nconc mailbox-list
+ (list
+ (std11-addr-to-string
+ (if (eq (car address) 'phrase-route-addr)
+ (nth 2 address)
+ (cdr address))))))))
+ (setq addresses (cdr addresses)))
+ (when (and remove-group-list has-group-list)
+ (delete-region beg (point))
+ (insert (wl-address-string-without-group-list-contents seq))))
+ mailbox-list)))
+
+(defun wl-draft-deduce-address-list (buffer header-start header-end)
+ "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"))
+ (resent-fields '("resent-to" "resent-cc" "resent-bcc"))
+ (case-fold-search t)
+ addrs recipients)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region header-start header-end)
+ (goto-char (point-min))
+ (save-excursion
+ (if (re-search-forward "^resent-to[\t ]*:" nil t)
+ (setq fields resent-fields)))
+ (while fields
+ (setq recipients
+ (nconc recipients
+ (wl-draft-parse-mailbox-list
+ (car fields)
+ wl-draft-remove-group-list-contents)))
+ (setq fields (cdr fields)))
+ recipients))))
+
;;
;; from Semi-gnus
;;
(concat "^" (regexp-quote mail-header-separator)
"$\\|^$") nil t)
(point-marker)))
- (recipients (smtp-deduce-address-list (current-buffer)
- (point-min) delimline))
- (smtp-server (or wl-smtp-posting-server
- (if (functionp smtp-server)
- (funcall smtp-server sender
- recipients)
- (or smtp-server "localhost"))))
+ (smtp-server
+ (or wl-smtp-posting-server
+ ;; Compatibility stuff for FLIM 1.12.5 or earlier.
+ ;; They don't accept a function as the value of `smtp-server'.
+ (if (functionp smtp-server)
+ (funcall
+ smtp-server
+ sender
+ ;; no harm..
+ (let (wl-draft-remove-group-list-contents)
+ (wl-draft-deduce-address-list
+ (current-buffer) (point-min) delimline)))
+ (or smtp-server "localhost"))))
(smtp-service (or wl-smtp-posting-port smtp-service))
(smtp-local-domain (or smtp-local-domain wl-local-domain))
- (id (std11-field-body "message-id")))
+ (id (std11-field-body "message-id"))
+ recipients)
(if (not (elmo-plugged-p smtp-server smtp-service))
(wl-draft-set-sent-message 'mail 'unplugged
(cons smtp-server smtp-service))
(unwind-protect
(save-excursion
+ ;; Instead of `smtp-deduce-address-list'.
+ (setq recipients (wl-draft-deduce-address-list
+ (current-buffer) (point-min) delimline))
+ (unless recipients (error "No recipients"))
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(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)
(if mail-interactive
(save-excursion
(set-buffer errbuf)
(as-binary-process
(when recipients
(wl-smtp-extension-bind
- (let ((err (smtp-via-smtp sender recipients
- (current-buffer))))
- (when (not (eq err t))
- (wl-draft-write-sendlog 'failed 'smtp smtp-server
- recipients id)
- (error "Sending failed; SMTP protocol error:%s" err))))
+ (condition-case err
+ (smtp-send-buffer sender recipients (current-buffer))
+ (error
+ (wl-draft-write-sendlog 'failed 'smtp smtp-server
+ recipients id)
+ (signal (car err) (cdr err)))))
(wl-draft-set-sent-message 'mail 'sent)
- (wl-draft-write-sendlog
+ (wl-draft-write-sendlog
'ok 'smtp smtp-server recipients id)))))
(if (bufferp errbuf)
(kill-buffer errbuf))))))
"Send the prepared message buffer with POP-before-SMTP."
(require 'elmo-pop3)
(condition-case ()
- (elmo-pop3-get-connection
- (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-ssl
- elmo-default-pop3-ssl)))
+ (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))
(wl-draft-send-mail-with-smtp))
(defun wl-draft-insert-required-fields (&optional force-msgid)
+ "Insert Message-ID, Date, and From field.
+If FORCE-MSGID, ignore 'wl-insert-message-id'."
;; Insert Message-Id field...
(goto-char (point-min))
(when (and (or force-msgid
(wl-draft-insert-from-field)))
(defun wl-draft-normal-send-func (editing-buffer kill-when-done)
- "Send the message in the current buffer. "
+ "Send the message in the current buffer."
(save-restriction
(std11-narrow-to-header mail-header-separator)
(wl-draft-insert-required-fields)
(wl-draft-delete editing-buffer)))
(defun wl-draft-dispatch-message (&optional mes-string)
- "Send the message in the current buffer. Not modified the header fields."
+ "Send the message in the current buffer. Not modified the header fields."
(let (delimline)
(if (and wl-draft-verbose-send mes-string)
(message mes-string))
(unplugged-via (car status))
(sent-via (nth 1 status)))
;; If one sent, process fcc folder.
- (when (and sent-via wl-draft-fcc-list)
- (wl-draft-do-fcc (wl-draft-get-header-delimiter) wl-draft-fcc-list)
- (setq wl-draft-fcc-list nil))
+ (if (and sent-via wl-draft-fcc-list)
+ (progn
+ (wl-draft-do-fcc (wl-draft-get-header-delimiter) wl-draft-fcc-list)
+ (setq wl-draft-fcc-list nil)))
+ (if wl-draft-use-cache
+ (let ((id (std11-field-body "Message-ID"))
+ (elmo-enable-disconnected-operation t))
+ (elmo-cache-save id nil nil nil)))
;; If one unplugged, append queue.
(when (and unplugged-via
wl-sent-message-modified)
(when wl-draft-verbose-send
(if (and unplugged-via sent-via);; combined message
(progn
- (setq wl-draft-verbose-msg
+ (setq wl-draft-verbose-msg
(format "Sending%s and Queuing%s..."
sent-via unplugged-via))
(message (concat wl-draft-verbose-msg "done")))
(if mes-string
(message (concat mes-string
- (if sent-via "done." "failed.")))))))))
+ (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)
(interactive)
(save-excursion
(let (wl-interactive-send
-; wl-draft-verbose-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
mail-send-hook
mail-send-actions)
(wl-draft-send kill-when-done mes-string))))
(defun wl-draft-clone-local-variables ()
(let ((locals (buffer-local-variables))
result)
- (mapcar
- (function
- (lambda (local)
- (when (and (consp local)
- (car local)
- (string-match
- wl-draft-clone-local-variable-regexp
- (symbol-name (car local))))
- (setq result (wl-append result (list (car local)))))))
- locals)
+ (while locals
+ (when (and (consp (car locals))
+ (car (car locals))
+ (string-match wl-draft-clone-local-variable-regexp
+ (symbol-name (car (car locals)))))
+ (wl-append result (list (car (car locals)))))
+ (setq locals (cdr locals)))
result))
(defun wl-draft-send (&optional kill-when-done mes-string)
- "Send current draft message.
+ "Send current draft message.
If optional argument is non-nil, current draft buffer is killed"
(interactive)
- (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)
(y-or-n-p "Send current draft. OK?"))
(let ((send-mail-function 'wl-draft-raw-send)
(editing-buffer (current-buffer))
- (sending-buffer (wl-draft-generate-clone-buffer
+ (sending-buffer (wl-draft-generate-clone-buffer
" *wl-draft-sending-buffer*"
(append wl-draft-config-variables
(wl-draft-clone-local-variables))))
(if wl-draft-verbose-send
(message (concat (or wl-draft-verbose-msg
mes-string "Sending...")
- "done."))))
+ "done"))))
;; kill sending buffer, anyway.
(and (buffer-live-p sending-buffer)
(kill-buffer sending-buffer))))))
(wl-draft-config-info-operation
(and (string-match "[0-9]+$" wl-draft-buffer-file-name)
(string-to-int
- (elmo-match-string 0 wl-draft-buffer-file-name)))
+ (match-string 0 wl-draft-buffer-file-name)))
'save))
(defun wl-draft-mimic-kill-buffer ()
(or (markerp header-end) (error "header-end must be a marker"))
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "^FCC:[ \t]*" header-end t)
+ (while (re-search-forward "^Fcc:[ \t]*" header-end t)
(setq fcc-list
(cons (buffer-substring-no-properties
(point)
(elmo-cache-save id nil nil nil) ;; for disconnected operation
(setq cache-saved t))
(if (elmo-append-msg (eword-decode-string (car fcc-list))
- (buffer-substring
+ (buffer-substring
(point-min) (point-max))
id)
(wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id)
(search-forward (concat "\n" mail-header-separator "\n") nil 0)
(point)))
(if (bolp)
- (if (bobp)
+ (if (bobp)
t
(save-excursion
(forward-line -1)
- (if (looking-at ".*,[ \t]?$") nil t)))
+ (if (or (looking-at ".*,[ \t]?$")
+ (looking-at "^[^ \t]+:[ \t]+.*:$")); group list name
+ nil t)))
(let ((pos (point)))
(save-excursion
(beginning-of-line)
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
- body edit-again summary-buf)
+ content-type content-transfer-encoding
+ body edit-again summary-buf from)
"Write and send mail/news message with Wanderlust."
(interactive)
(unless (featurep 'wl)
(require 'wl))
(unless wl-init
(wl-load-profile))
- (wl-init) ;; returns immediately if already initialized.
+ (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))
;; 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 buf-name (find-file-noselect
(setq file-name
(elmo-get-msg-filename wl-draft-folder
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))
+ (eq this-command 'wl-summary-write-current-folder))
(delete-other-windows))
(auto-save-mode -1)
(wl-draft-mode)
(setq wl-sent-message-via nil)
- (if (stringp wl-from)
- (insert "From: " wl-from "\n"))
+ (if (stringp (or from wl-from))
+ (insert "From: " (or from wl-from) "\n"))
(and (or (interactive-p)
(eq this-command 'wl-summary-write)
to)
(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: "
+ (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)
+ (insert (funcall wl-generate-mailer-string-func)
"\n")
(setq wl-draft-buffer-file-name file-name)
(if mail-default-reply-to
(insert "Reply-To: " mail-default-reply-to "\n"))
- (if (or wl-bcc mail-self-blind)
- (insert "Bcc: " (or wl-bcc (user-login-name)) "\n"))
- (if wl-fcc
- (insert "FCC: " wl-fcc "\n"))
+ (wl-draft-insert-ccs "Bcc: " (or wl-bcc
+ (and mail-self-blind (user-login-name))))
+ (wl-draft-insert-ccs "Fcc: " wl-fcc)
(if wl-organization
(insert "Organization: " wl-organization "\n"))
(and wl-auto-insert-x-face
(if edit-again
(let (start)
(setq start (point))
- (when content-type
- (insert "Content-type: " content-type "\n\n"))
+ (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))
(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))
(wl-draft-editor-mode)
(wl-draft-overload-functions)
- (let (wl-highlight-x-face-func)
- (wl-highlight-headers))
+ (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
((and (interactive-p) (null to))
(mail-position-on-field "To"))
(t
- (goto-char (point-max))))
- (setq wl-draft-config-exec-flag t)
+ (goto-char (point-max))))
(setq wl-draft-buffer-cur-summary-buffer (or summary-buf
(get-buffer
- wl-summary-buffer-name)))
+ wl-summary-buffer-name)))
buf-name))
+(defsubst wl-draft-insert-ccs (str cc)
+ (let ((field
+ (if (functionp cc)
+ (funcall cc)
+ cc)))
+ (if (and field
+ (null (and wl-draft-delete-myself-from-bcc-fcc
+ (elmo-list-member
+ (mapcar 'wl-address-header-extract-address
+ (append
+ (wl-parse-addresses (std11-field-body "To"))
+ (wl-parse-addresses (std11-field-body "Cc"))))
+ (mapcar 'downcase wl-subscribed-mailing-list)))))
+ (insert str field "\n"))))
+
(defun wl-draft-elmo-nntp-send ()
(let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook)
(elmo-default-nntp-user
(or wl-nntp-posting-server elmo-default-nntp-server))
(elmo-default-nntp-port
(or wl-nntp-posting-port elmo-default-nntp-port))
- (elmo-default-nntp-ssl
- (or wl-nntp-posting-ssl elmo-default-nntp-ssl)))
+ (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
(wl-draft-editor-mode)
(insert-buffer editing-buffer)
(message "")
- (when local-variables
- (mapcar
- (function
- (lambda (var)
- (make-local-variable var)
- (set var (save-excursion
- (set-buffer editing-buffer)
- (symbol-value var)))))
- local-variables))
+ (while local-variables
+ (make-local-variable (car local-variables))
+ (set (car local-variables)
+ (save-excursion
+ (set-buffer editing-buffer)
+ (symbol-value (car local-variables))))
+ (setq local-variables (cdr local-variables)))
(current-buffer))))
(defun wl-draft-reedit (number)
(set-buffer buf-name)
(if (not (string-match (regexp-quote wl-draft-folder)
(buffer-name)))
- (rename-buffer (concat 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)
(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)
- (let (wl-highlight-x-face-func)
- (wl-highlight-headers))
+ (wl-highlight-headers 'for-draft)
(run-hooks 'wl-draft-reedit-hook)
(goto-char (point-max))
buf-name
(wl-template-insert (eval content))))
(defun wl-draft-config-sub-x-face (content)
- (if (and (string-match "\\.xbm\\(\\.gz\\)?$" content)
+ (if (and (string-match "\\.xbm\\(\\.gz\\)?$" content)
(fboundp 'x-face-insert)) ; x-face.el is installed.
(x-face-insert content)
(wl-draft-replace-field "X-Face" (elmo-get-file-string content t) t)))
"Change headers in draft preparation time."
(interactive)
(unless wl-draft-reedit
- (let ((config-alist
+ (let ((config-alist
(or config-alist
(and (boundp 'wl-draft-prepared-config-alist)
wl-draft-prepared-config-alist) ;; For compatible.
(wl-draft-write-sendlog 'ok 'queue nil wl-queue-folder message-id)
(when wl-draft-verbose-send
(setq wl-draft-verbose-msg "Queuing...")
- (message "Queuing...done.")))
+ (message "Queuing...done")))
(wl-draft-write-sendlog 'failed 'queue nil wl-queue-folder message-id)
(error "Queuing failed"))))
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)
+ (elmo-read-msg-no-cache wl-queue-folder (car msgs)
(current-buffer))
(condition-case err
(setq failure (funcall
wl-draft-queue-flush-send-func
(format "Sending (%d/%d)..." i len)))
-;; (wl-draft-raw-send nil nil
-;; (format "Sending (%d/%d)..." i len))
+;;; (wl-draft-raw-send nil nil
+;;; (format "Sending (%d/%d)..." i len))
(error
(elmo-display-error err t)
(setq failure t))
- (quit
+ (quit
(setq failure t)))
(unless failure
(elmo-delete-msgs wl-queue-folder (cons (car msgs) nil))
Support for CONTINUE, YANK-ACTION, and SEND-ACTIONS has not
been implemented yet. Partial support for SWITCH-FUNCTION now supported."
+ (unless (featurep 'wl)
+ (require 'wl))
;; 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)
(cons (cons "to" to)
wl-user-agent-headers-and-body-alist))))
(if subject
- (if (wl-string-match-assoc "subject"
+ (if (wl-string-match-assoc "subject"
wl-user-agent-headers-and-body-alist
'ignore-case)
(setcdr
- (wl-string-match-assoc "subject"
+ (wl-string-match-assoc "subject"
wl-user-agent-headers-and-body-alist
'ignore-case)
subject)
(if wl-user-agent-compose-p
(progn
;; insert headers
- (let ((case-fold-search t))
- (mapcar
- (lambda (x)
- (let ((header-name (car x))
- (header-value (cdr x)))
- ;; skip body
- (if (not (string-match "^body$" header-name))
- (wl-user-agent-insert-header header-name header-value)
- t)))
- wl-user-agent-headers-and-body-alist))
+ (let ((headers wl-user-agent-headers-and-body-alist)
+ (case-fold-search t))
+ (while headers
+ ;; skip body
+ (if (not (string-match "^body$" (car (car headers))))
+ (wl-user-agent-insert-header
+ (car (car headers)) (cdr (car headers)))
+ t)
+ (setq headers (cdr headers))))
;; highlight headers (from wl-draft in wl-draft.el)
- (let (wl-highlight-x-face-func)
- (wl-highlight-headers))
+ (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-headers-and-body-alist 'ignore-case)))))
t))
-(provide 'wl-draft)
+(require 'product)
+(product-provide (provide 'wl-draft) (require 'wl-version))
;;; wl-draft.el ends here
projects / elisp / wanderlust.git / blobdiff