(defvar wl-draft-reply-buffer nil)
(defvar wl-draft-forward nil)
(defvar wl-draft-parent-folder nil)
+(defvar wl-draft-doing-mime-bcc nil)
(defvar wl-draft-config-sub-func-alist
'((body . wl-draft-config-sub-body)
(make-variable-buffer-local 'wl-draft-reply-buffer)
(make-variable-buffer-local 'wl-draft-parent-folder)
-(defsubst wl-smtp-password-key (user mechnism server)
+(defsubst wl-smtp-password-key (user mechanism server)
(format "SMTP:%s/%s@%s"
- user mechnism server))
+ user mechanism server))
(defmacro wl-smtp-extension-bind (&rest body)
(` (let* ((smtp-sasl-mechanisms
(defun wl-draft-insert-x-face-field-here ()
"Insert X-Face field at point."
(let ((x-face-string (elmo-get-file-string wl-x-face-file)))
- (when (string-match "^[ \t]*" x-face-string)
+ (when (string-match "^\\(X-Face:\\)?[ \t\n]*" x-face-string)
(setq x-face-string (substring x-face-string (match-end 0))))
(insert "X-Face: " x-face-string))
(when (not (= (preceding-char) ?\n)) ; for chomped (choped) x-face-string
(defun wl-draft-setup ()
(let ((field wl-draft-fields)
- ret-val)
+ cl)
(while field
- (setq ret-val (append ret-val
- (list (cons (concat (car field) " ")
- (concat (car field) " ")))))
+ (setq cl (append cl
+ (list (cons (concat (car field) " ")
+ (concat (car field) " ")))))
(setq field (cdr field)))
- (setq wl-draft-field-completion-list ret-val)))
+ (setq cl
+ (cons (cons (concat wl-draft-mime-bcc-field-name ": ")
+ (concat wl-draft-mime-bcc-field-name ": "))
+ cl))
+ (setq wl-draft-field-completion-list cl)
+ (setq wl-address-complete-header-regexp
+ (wl-regexp-opt
+ (append wl-address-complete-header-list
+ (list (concat wl-draft-mime-bcc-field-name ":")))))))
(defun wl-draft-make-mail-followup-to (recipients)
(if (elmo-list-member
(t cc))))
(defun wl-draft-forward (original-subject summary-buf)
- (let (references)
+ (let (references parent-folder)
+ (with-current-buffer summary-buf
+ (setq parent-folder (wl-summary-buffer-folder-name)))
(with-current-buffer (wl-message-get-original-buffer)
(setq references (nconc
(std11-field-bodies '("References" "In-Reply-To"))
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))
+ (wl-draft (list (cons 'To "")
+ (cons 'Subject
+ (concat wl-forward-subject-prefix original-subject))
+ (cons 'References references))
+ nil nil nil nil parent-folder))
(goto-char (point-max))
(wl-draft-insert-message)
(mail-position-on-field "To"))
;;;(save-excursion
(let (r-list
to mail-followup-to cc subject in-reply-to references newsgroups
- from to-alist cc-alist decoder parent-folder)
+ to-alist cc-alist decoder parent-folder)
(set-buffer summary-buf)
(setq parent-folder (wl-summary-buffer-folder-name))
(set-buffer buf)
(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))
- ",")))
+ (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 `%s'"
references (wl-delete-duplicates 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 nil summary-buf nil parent-folder)
+ (wl-draft (list (cons 'To to)
+ (cons 'Cc cc)
+ (cons 'Newsgroups newsgroups)
+ (cons 'Subject subject)
+ (cons 'In-Reply-To in-reply-to)
+ (cons 'References references)
+ (cons 'Mail-Followup-To mail-followup-to))
+ nil nil nil nil parent-folder)
(setq wl-draft-reply-buffer buf))
(run-hooks 'wl-reply-hook))
(wl-message-field-exists-p "Resent-to")
(wl-message-field-exists-p "Cc")
(wl-message-field-exists-p "Bcc")
+ (wl-message-field-exists-p wl-draft-mime-bcc-field-name)
;;; This may be needed..
;;; (wl-message-field-exists-p "Fcc")
))
(search-forward (concat mail-header-separator "\n") nil t))
(unwind-protect
(set-buffer
- (wl-draft to subject in-reply-to cc references newsgroups
- mail-followup-to
+ (wl-draft (list
+ (cons 'From
+ (if (member
+ (nth 1 (std11-extract-address-components from))
+ wl-user-mail-address-list)
+ from))
+ (cons 'To to)
+ (cons 'Cc cc)
+ (cons 'Subject subject)
+ (cons 'Newsgroups newsgroups)
+ (cons 'Mail-Followup-To mail-followup-to)
+ (cons 'In-Reply-To in-reply-to)
+ (cons 'References references))
content-type content-transfer-encoding
(buffer-substring (point) (point-max))
- 'edit-again nil
- (if (member (nth 1 (std11-extract-address-components from))
- wl-user-mail-address-list)
- from)))
+ 'edit-again))
(and to (mail-position-on-field "To"))
(delete-other-windows)
(kill-buffer tmp-buf)))
(buffer-live-p message-buf))
(progn
(with-current-buffer summary-buf
- (setq num (save-excursion
- (set-buffer message-buf)
- wl-message-buffer-cur-number))
- (setq entity (elmo-msgdb-overview-get-entity
- num (wl-summary-buffer-msgdb)))
- (setq date (elmo-msgdb-overview-entity-get-date entity))
- (setq from (elmo-msgdb-overview-entity-get-from entity)))
+ (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
- (wl-summary-from-func-internal
- (or from "you"))
+ (funcall wl-summary-from-function
+ (or from "you"))
(or from "you"))))))
(and cite-title
(insert cite-title "\n"))
(kill-region b e)
(insert wl-draft-elide-ellipsis))
+;; Imported from message.el.
+(defun wl-draft-beginning-of-line (&optional n)
+ "Move point to beginning of header value or to beginning of line."
+ (interactive "p")
+ (let ((zrs 'zmacs-region-stays))
+ (when (and (interactive-p) (boundp zrs))
+ (set zrs t)))
+ (if (wl-draft-point-in-header-p)
+ (let* ((here (point))
+ (bol (progn (beginning-of-line n) (point)))
+ (eol (line-end-position))
+ (eoh (and (looking-at "[^ \t]")
+ (re-search-forward ": *" eol t))))
+ (if (and eoh (or (> here eoh) (= here bol)))
+ (goto-char eoh)
+ (goto-char bol)))
+ (beginning-of-line n)))
+
+(defun wl-draft-point-in-header-p ()
+ "Return t if point is in the header."
+ (save-excursion
+ (let ((p (point)))
+ (goto-char (point-min))
+ (not (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n")
+ p t)))))
+
;; function for wl-sent-message-via
(defmacro wl-draft-sent-message-p (type)
","))))
""))
(id (if id (concat " id=" id) ""))
- (time (wl-sendlog-time)))
+ (time (format-time-string "%Y/%m/%d %T")))
(insert (format "%s proto=%s stat=%s%s%s%s\n"
time proto status server to id))
(if (and wl-draft-sendlog-max-size filesize
msg-id-list))))
(nreverse msg-id-list)))
+(defun wl-draft-eword-encode-address-list (string &optional column)
+ "Encode header field STRING as list of address, and return the result.
+Cause an error when STRING contains invalid address.
+Optional argument COLUMN is start-position of the field."
+ (car (eword-encode-rword-list
+ (or column eword-encode-default-start-column)
+ (eword-encode-addresses-to-rword-list
+ (wl-draft-std11-parse-addresses (std11-lexical-analyze string))))))
+
(defun wl-draft-std11-parse-addresses (lal)
(let ((ret (std11-parse-address lal)))
+ (when (and (not (and (eq (length lal) 1)
+ (eq (car (car lal)) 'spaces)))
+ (null ret))
+ (error "Error while parsing address"))
(if ret
(let ((dest (list (car ret))))
(setq lal (cdr ret))
"Get address list suitable for smtp RCPT TO:<address>.
Group list content is removed if `wl-draft-remove-group-list-contents' is
non-nil."
- (let ((fields '("to" "cc" "bcc"))
+ (let ((fields (if (and wl-draft-doing-mime-bcc
+ wl-draft-disable-bcc-for-mime-bcc)
+ '("to" "cc")
+ '("to" "cc" "bcc")))
(resent-fields '("resent-to" "resent-cc" "resent-bcc"))
(case-fold-search t)
addrs recipients)
"$\\|^$") nil t)
(point-marker)))
(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"))))
+ (or wl-smtp-posting-server 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"))
(error
(wl-draft-write-sendlog 'failed 'smtp smtp-server
recipients id)
- (if (/= (nth 1 err) 334)
+ (if (and (eq (car err) 'smtp-response-error)
+ (/= (nth 1 err) 334))
(elmo-remove-passwd
(wl-smtp-password-key
smtp-sasl-user-name
(when session (elmo-network-close-session session)))
(error
(elmo-network-close-session session)
- (signal (car error)(cdr error)))))
+ (unless (string= (nth 1 error) "Unplugged")
+ (signal (car error)(cdr error))))))
(wl-draft-send-mail-with-smtp))
(defun wl-draft-insert-required-fields (&optional force-msgid)
"Insert Message-ID, Date, and From field.
-If FORCE-MSGID, ignore 'wl-insert-message-id'."
+If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
;; Insert Message-Id field...
(goto-char (point-min))
(when (and (or force-msgid
(defun wl-draft-dispatch-message (&optional mes-string)
"Send the message in the current buffer. Not modified the header fields."
- (let (delimline)
+ (let (delimline mime-bcc)
(if (and wl-draft-verbose-send mes-string)
(message mes-string))
;; get fcc folders.
(if (or (not (or wl-draft-force-queuing
wl-draft-force-queuing-mail))
(memq 'mail wl-sent-message-queued))
- (funcall wl-draft-send-mail-function)
+ (progn
+ (setq mime-bcc (wl-draft-mime-bcc-field))
+ (funcall wl-draft-send-mail-function)
+ (when (not (zerop (length mime-bcc)))
+ (wl-draft-do-mime-bcc mime-bcc)))
(push 'mail wl-sent-message-queued)
(wl-draft-set-sent-message 'mail 'unplugged)))
(if (and (wl-message-news-p)
(funcall wl-draft-send-news-function)
(push 'news wl-sent-message-queued)
(wl-draft-set-sent-message 'news 'unplugged))))
- ;;
(let* ((status (wl-draft-sent-message-results))
(unplugged-via (car status))
(sent-via (nth 1 status)))
;; If one sent, process fcc folder.
(if (and sent-via wl-draft-fcc-list)
(progn
- (wl-draft-do-fcc (wl-draft-get-header-delimiter) wl-draft-fcc-list)
+ (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"))
(not (wl-message-news-p)))
(error "No recipient is specified"))
(expand-abbrev) ; for mail-abbrevs
- (run-hooks 'mail-send-hook) ; translate buffer
+ (let ((mime-header-encode-method-alist
+ (append
+ '((wl-draft-eword-encode-address-list
+ . (To Cc Bcc Resent-To Resent-Cc Bcc Resent-Bcc)))
+ (if (boundp 'mime-header-encode-method-alist)
+ (symbol-value 'mime-header-encode-method-alist)))))
+ (run-hooks 'mail-send-hook) ; translate buffer
+ )
+ ;;
(if wl-draft-verbose-send
(message (or mes-string "Sending...")))
(funcall wl-draft-send-function editing-buffer kill-when-done)
(cdr (car mail-send-actions)))
(error))
(setq mail-send-actions (cdr mail-send-actions)))
-;; (if (or (eq major-mode 'wl-draft-mode)
-;; (eq major-mode 'mail-mode))
-;; (local-set-key "\C-c\C-s" 'wl-draft-send)) ; override
(if wl-draft-verbose-send
(message (concat (or wl-draft-verbose-msg
mes-string "Sending...")
(and (buffer-live-p sending-buffer)
(kill-buffer sending-buffer))))))
+(defun wl-draft-mime-bcc-field ()
+ "Return the MIME-Bcc field body. The field is deleted."
+ (prog1 (std11-field-body wl-draft-mime-bcc-field-name)
+ (wl-draft-delete-field wl-draft-mime-bcc-field-name)))
+
+(defun wl-draft-do-mime-bcc (field-body)
+ "Send MIME-Bcc (Encapsulated blind carbon copy)."
+ (let ((orig-from (mime-decode-field-body (std11-field-body "from")
+ 'From))
+ (orig-subj (mime-decode-field-body (or (std11-field-body "subject")
+ "")
+ 'Subject))
+ (recipients (wl-parse-addresses field-body))
+ (draft-buffer (current-buffer))
+ wl-draft-use-frame)
+ (save-window-excursion
+ (when (and (not wl-draft-doing-mime-bcc) ; To avoid infinite loop.
+ (not (zerop (length field-body))))
+ (let ((wl-draft-doing-mime-bcc t))
+ (dolist (recipient recipients)
+ (wl-draft-create-buffer)
+ (wl-draft-create-contents
+ (append `((From . ,orig-from)
+ (To . ,recipient)
+ (Subject . ,(concat "A blind carbon copy ("
+ orig-subj
+ ")")))
+ (wl-draft-default-headers)))
+ (wl-draft-insert-mail-header-separator)
+ (wl-draft-prepare-edit)
+ (goto-char (point-max))
+ (insert (or wl-draft-mime-bcc-body
+ "This is a blind carbon copy.")
+ "\n")
+ (mime-edit-insert-tag "message" "rfc822")
+ (insert-buffer 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)
- (save-buffer)
- (wl-draft-config-info-operation
- (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))
- 'save))
+ (if (buffer-modified-p)
+ (progn
+ (message "Saving %s..." wl-draft-buffer-file-name)
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
+ (with-temp-file wl-draft-buffer-file-name
+ (insert msg)
+ ;; If no header separator, insert it.
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (goto-char (point-min))
+ (if (re-search-forward "\n\n" nil t)
+ (replace-match (concat "\n" mail-header-separator "\n"))
+ (goto-char (point-max))
+ (insert (if (eq (char-before) ?\n) "" "\n")
+ mail-header-separator "\n"))))
+ (let ((mime-header-encode-method-alist
+ '((eword-encode-unstructured-field-body))))
+ (mime-edit-translate-buffer))
+ (wl-draft-get-header-delimiter t)))
+ (set-buffer-modified-p nil)
+ (wl-draft-config-info-operation
+ (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
+ (string-to-int
+ (match-string 0 wl-draft-buffer-file-name)))
+ 'save)
+ (message "Saving %s...done" wl-draft-buffer-file-name))
+ (message "(No changes need to be saved)")))
(defun wl-draft-mimic-kill-buffer ()
"Kill the current (draft) buffer with query."
(if (or (not bufname)
(string-equal bufname "")
(string-equal bufname (buffer-name)))
- (wl-draft-save-and-exit)
+ (let ((bufname (current-buffer)))
+ (when (or (not (buffer-modified-p))
+ (yes-or-no-p
+ (format "Buffer %s modified; kill anyway? " bufname)))
+ (set-buffer-modified-p nil)
+ (wl-draft-hide bufname)
+ (kill-buffer bufname)))
(kill-buffer bufname))))
(defun wl-draft-save-and-exit ()
(point-max)))))))
(defun wl-draft-get-fcc-list (header-end)
- (let (fcc-list
- (case-fold-search t))
- (or (markerp header-end) (error "HEADER-END must be a marker"))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^Fcc:[ \t]*" header-end t)
- (setq fcc-list
- (cons (buffer-substring-no-properties
- (point)
- (progn
- (end-of-line)
- (skip-chars-backward " \t")
- (point)))
- fcc-list))
- (save-match-data
- (wl-folder-confirm-existence
- (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list)))))
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point)))))
- fcc-list))
+ (if (and wl-draft-doing-mime-bcc
+ wl-draft-disable-fcc-for-mime-bcc)
+ (progn
+ (wl-draft-delete-field "fcc")
+ nil)
+ (let (fcc-list
+ (case-fold-search t))
+ (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)
+ (setq fcc-list
+ (cons (buffer-substring-no-properties
+ (point)
+ (progn
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ fcc-list))
+ (save-match-data
+ (wl-folder-confirm-existence
+ (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list)))))
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point)))))
+ fcc-list)))
(defun wl-draft-do-fcc (header-end &optional fcc-list)
(let ((send-mail-buffer (current-buffer))
;;;;;;;;;;;;;;;;
;;;###autoload
-(defun wl-draft (&optional to subject in-reply-to cc references newsgroups
- mail-followup-to
+(defun wl-draft (&optional header-alist
content-type content-transfer-encoding
- body edit-again summary-buf from parent-folder)
+ body edit-again
+ parent-folder)
"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)
+
+ (let (buf-name header-alist-internal)
(setq buf-name
(wl-draft-create-buffer
(or
(eq this-command 'wl-draft)
(eq this-command 'wl-summary-write)
- (eq this-command 'wl-summary-write-current-folder))
- parent-folder summary-buf))
- (setq header-alist
- (list
- (cons "From: " (or from wl-from))
- (cons "To: " (or to
- (and
- (or (interactive-p)
- (eq this-command 'wl-summary-write))
- "")))
- (cons "Cc: " cc)
- (cons "Subject: " (or subject ""))
- (cons "Newsgroups: " newsgroups)
- (cons "Mail-Followup-To: " mail-followup-to)
- (cons "In-Reply-To: " in-reply-to)
- (cons "References: " references)))
+ (eq this-command 'wl-summary-write-current-folder)
+ (eq this-command 'wl-folder-write-current-folder))
+ parent-folder))
+
+ (unless (cdr (assq 'From header-alist))
+ (setq header-alist
+ (append (list (cons 'From wl-from)) header-alist)))
+ (unless (cdr (assq 'To header-alist))
+ (let ((to))
+ (when (setq to (and
+ (interactive-p)
+ ""))
+ (if (assq 'To header-alist)
+ (setcdr (assq 'To header-alist) to)
+ (setq header-alist
+ (append header-alist
+ (list (cons 'To to))))))))
+ (unless (cdr (assq 'Subject header-alist))
+ (if (assq 'Subject header-alist)
+ (setcdr (assq 'Subject header-alist) "")
+ (setq header-alist
+ (append header-alist (list (cons 'Subject ""))))))
(setq header-alist (append header-alist
(wl-draft-default-headers)
- (if body (list "\n" body))))
+ wl-draft-additional-header-alist
+ (if body (list "" (cons 'Body body)))))
(wl-draft-create-contents header-alist)
(if edit-again
(wl-draft-decode-body
content-type content-transfer-encoding))
(wl-draft-insert-mail-header-separator)
- (wl-draft-prepare-edit (interactive-p))
-
+ (wl-draft-prepare-edit)
+ (if (interactive-p)
+ (run-hooks 'wl-mail-setup-hook))
(goto-char (point-min))
(wl-user-agent-compose-internal) ;; user-agent
- (cond ((eq this-command 'wl-summary-write-current-newsgroup)
- (mail-position-on-field "Subject"))
- ((and (interactive-p) (null to))
+ (cond ((and
+ (interactive-p)
+ (string= (cdr (assq 'To header-alist)) ""))
(mail-position-on-field "To"))
(t
(goto-char (point-max))))
buf-name))
-(defun wl-draft-create-buffer (&optional full parent-folder summary-buf)
+(defun wl-draft-create-buffer (&optional full 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 (or summary-buf (wl-summary-get-buffer parent-folder)))
+ (summary-buf (wl-summary-get-buffer parent-folder))
buf-name file-name num change-major-mode-hook)
(if (not (elmo-folder-message-file-p draft-folder))
(error "%s folder cannot be used for draft folder" wl-draft-folder))
(setq wl-draft-buffer-file-name file-name)
(setq wl-draft-config-exec-flag t)
(setq wl-draft-parent-folder parent-folder)
- (setq wl-draft-buffer-cur-summary-buffer summary-buf)
+ (or (eq this-command 'wl-folder-write-current-folder)
+ (setq wl-draft-buffer-cur-summary-buffer summary-buf))
buf-name))
(defun wl-draft-create-contents (header-alist)
"header-alist' sample
'(function ;; funcall
string ;; insert string
- (string . string) ;; insert string string
- (string . function) ;; insert string (funcall)
- (string . nil) ;; insert nothing
- (function . (arg1 arg2 ..)) ;; call function with argument
- nil ;; insert nothing
+ (symbol . string) ;; insert symbol-value: string
+ (symbol . function) ;; (funcall) and if it returns string,
+ ;; insert symbol-value: string
+ (symbol . nil) ;; do nothing
+ nil ;; do nothing
+ )
"
(unless (eq major-mode 'wl-draft-mode)
(error "wl-draft-create-header must be use in wl-draft-mode."))
(setq field (car (car halist)))
(setq value (cdr (car halist)))
(cond
- ((functionp field) (apply field value))
- ((stringp field)
+ ((symbolp field)
(cond
- ((stringp value) (insert field value "\n"))
- ((functionp value) (insert field (funcall value) "\n"))
+ ((eq field 'Body) ; body
+ (insert value))
+ ((stringp value) (insert (symbol-name field) ": " value "\n"))
+ ((functionp value)
+ (let ((value-return (funcall value)))
+ (when (stringp value-return)
+ (insert (symbol-name field) ": " value-return "\n"))))
((not value))
(t
(debug))))
)))
(setq halist (cdr halist)))))
-(defun wl-draft-prepare-edit (&optional hook)
- (wl-draft-editor-mode)
- (wl-draft-overload-functions)
- (wl-highlight-headers 'for-draft)
- (if hook (run-hooks 'wl-mail-setup-hook))
- (as-binary-output-file
- (write-region (point-min)(point-max) wl-draft-buffer-file-name
- nil t)))
+(defun wl-draft-prepare-edit ()
+ (unless (eq major-mode 'wl-draft-mode)
+ (error "wl-draft-create-header must be use in wl-draft-mode."))
+ (let (change-major-mode-hook)
+ (wl-draft-editor-mode)
+ (add-hook 'local-write-file-hooks 'wl-draft-save)
+ (wl-draft-overload-functions)
+ (wl-highlight-headers 'for-draft)
+ (wl-draft-save)
+ (clear-visited-file-modtime)))
(defun wl-draft-decode-header ()
(save-excursion
- (let (delimline)
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t)
- (goto-char (point-max)))
- (setq delimline (point))
- (save-restriction
- (narrow-to-region (point-min) delimline)
- (wl-draft-decode-message-in-buffer)
- (widen))
- delimline)))
+ (std11-narrow-to-header)
+ (wl-draft-decode-message-in-buffer)
+ (widen)))
(defun wl-draft-decode-body (&optional content-type content-transfer-encoding)
(let ((content-type
(or content-transfer-encoding
(std11-field-body "content-transfer-encoding")))
delimline)
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (progn
- (goto-char (1- (point)))
- (delete-char))
- (goto-char (point-max)))
- (setq delimline (point))
(save-excursion
- (wl-draft-delete-field "content-type" delimline)
- (wl-draft-delete-field "content-transfer-encoding" delimline))
- (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"))
- (save-restriction
+ (std11-narrow-to-header)
+ (wl-draft-delete-field "content-type")
+ (wl-draft-delete-field "content-transfer-encoding")
+ (goto-char (point-max))
+ (setq delimline (point-marker))
+ (widen)
(narrow-to-region delimline (point-max))
- (debug)
+ (goto-char (point-min))
+ (when content-type
+ (insert "Content-type: " content-type "\n"))
+ (when content-transfer-encoding
+ (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
(wl-draft-decode-message-in-buffer)
- (widen))
- (goto-char delimline)
- (insert "\n")
- delimline))
+ (goto-char (point-min))
+ (unless (re-search-forward "^$" (point-at-eol) t)
+ (insert "\n"))
+ (widen)
+ delimline)))
;;; subroutine for wl-draft-create-contents
;;; must be used in wl-draft-mode
(if (not (= (preceding-char) ?\n))
(insert ?\n)))
-(defsubst wl-draft-insert-ccs (str cc)
+(defsubst wl-draft-trim-ccs (cc)
(let ((field
(if (functionp cc)
(funcall cc)
(wl-parse-addresses (std11-field-body "To"))
(wl-parse-addresses (std11-field-body "Cc"))))
(mapcar 'downcase wl-subscribed-mailing-list)))))
- (insert str field "\n"))))
+ field
+ nil)))
(defsubst wl-draft-default-headers ()
(list
- (cons "Mail-Reply-To: " (and wl-insert-mail-reply-to
- (wl-address-header-extract-address
- wl-from)))
- wl-generate-mailer-string-function
- (cons "Reply-To: " mail-default-reply-to)
- (cons 'wl-draft-insert-ccs
- (list "Bcc: " (or wl-bcc
- (and mail-self-blind (user-login-name)))))
- (cons 'wl-draft-insert-ccs
- (list "Fcc: " wl-fcc))
- (cons "Organization: " wl-organization)
+ (cons 'Mail-Reply-To (and wl-insert-mail-reply-to
+ (wl-address-header-extract-address
+ wl-from)))
+ (cons 'User-Agent wl-generate-mailer-string-function)
+ (cons 'Reply-To mail-default-reply-to)
+ (cons 'Bcc (function
+ (lambda ()
+ (wl-draft-trim-ccs
+ (or wl-bcc (and mail-self-blind (user-login-name)))))))
+ (cons 'Fcc (function
+ (lambda ()
+ (wl-draft-trim-ccs wl-fcc))))
+ (cons 'Organization wl-organization)
(and wl-auto-insert-x-face
(file-exists-p wl-x-face-file)
'wl-draft-insert-x-face-field-here) ;; allow nil
mail-default-headers
;; check \n at th end of line for `mail-default-headers'
'wl-draft-check-new-line
-; wl-draft-default-headers
-; 'wl-draft-check-new-line
))
(defun wl-draft-insert-mail-header-separator (&optional delimline)
(goto-char delimline)
(goto-char (point-min))
(if (search-forward "\n\n" nil t)
- (progn
- (goto-char (1- (point)))
- (delete-char))
+ (delete-backward-char 1)
(goto-char (point-max))))
(wl-draft-check-new-line)
(put-text-property (point)
(elmo-nntp-default-port
(or wl-nntp-posting-port elmo-nntp-default-port))
(elmo-nntp-default-stream-type
- (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type)))
+ (or wl-nntp-posting-stream-type elmo-nntp-default-stream-type))
+ (elmo-nntp-default-function wl-nntp-posting-function)
+ condition)
+ (if (setq condition (cdr (elmo-string-matched-assoc
+ (std11-field-body "Newsgroups")
+ wl-nntp-posting-config-alist)))
+ (if (stringp condition)
+ (setq elmo-nntp-default-server condition)
+ (while (car condition)
+ (set (intern (format "elmo-nntp-default-%s"
+ (symbol-name (caar condition))))
+ (cdar condition))
+ (setq condition (cdr condition)))))
+ (unless elmo-nntp-default-function
+ (error "wl-draft-nntp-send: posting-function is nil."))
(if (not (elmo-plugged-p elmo-nntp-default-server elmo-nntp-default-port))
(wl-draft-set-sent-message 'news 'unplugged
(cons elmo-nntp-default-server
elmo-nntp-default-port))
- (elmo-nntp-post elmo-nntp-default-server (current-buffer))
+ (funcall elmo-nntp-default-function
+ elmo-nntp-default-server (current-buffer))
(wl-draft-set-sent-message 'news 'sent)
(wl-draft-write-sendlog 'ok 'nntp elmo-nntp-default-server
(std11-field-body "Newsgroups")
(defun wl-draft-reedit (number)
(let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
(wl-draft-reedit t)
- buf-name file-name change-major-mode-hook)
+ buffer file-name change-major-mode-hook)
(setq file-name (elmo-message-file-name draft-folder number))
(unless (file-exists-p file-name)
(error "File %s does not exist" file-name))
- (setq buf-name (find-file-noselect file-name))
- (if wl-draft-use-frame
- (switch-to-buffer-other-frame buf-name)
- (switch-to-buffer buf-name))
- (set-buffer buf-name)
- (if (not (string-match (regexp-quote wl-draft-folder)
- (buffer-name)))
- (rename-buffer (concat wl-draft-folder "/" (buffer-name))))
- (auto-save-mode -1)
- (wl-draft-mode)
- (setq wl-sent-message-via nil)
- (setq wl-sent-message-queued nil)
- (setq wl-draft-buffer-file-name file-name)
- (wl-draft-config-info-operation number 'load)
- (goto-char (point-min))
- (or (re-search-forward "\n\n" nil t)
- (search-forward (concat mail-header-separator "\n") nil t))
- (write-region (point-min)(point-max) wl-draft-buffer-file-name
- nil t)
- (wl-draft-overload-functions)
- (wl-draft-editor-mode)
- (wl-highlight-headers 'for-draft)
- (run-hooks 'wl-draft-reedit-hook)
- (goto-char (point-max))
- buf-name
- ))
+ (if (setq buffer (get-buffer
+ (concat wl-draft-folder "/"
+ (number-to-string number))))
+ (progn
+ (if wl-draft-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ (set-buffer buffer))
+ (setq buffer (get-buffer-create (number-to-string number)))
+ (if wl-draft-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ (set-buffer buffer)
+ (insert-file-contents-as-binary file-name)
+ (let((mime-edit-again-ignored-field-regexp
+ "^\\(Content-.*\\|Mime-Version\\):"))
+ (wl-draft-decode-message-in-buffer))
+ (wl-draft-insert-mail-header-separator)
+ (if (not (string-match (regexp-quote wl-draft-folder)
+ (buffer-name)))
+ (rename-buffer (concat wl-draft-folder "/" (buffer-name))))
+ (auto-save-mode -1)
+ (wl-draft-mode)
+ (setq buffer-file-name file-name)
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows nil)
+ (setq truncate-lines wl-draft-truncate-lines)
+ (setq wl-sent-message-via nil)
+ (setq wl-sent-message-queued nil)
+ (setq wl-draft-buffer-file-name file-name)
+ (wl-draft-config-info-operation number 'load)
+ (goto-char (point-min))
+ (wl-draft-overload-functions)
+ (wl-draft-editor-mode)
+ (add-hook 'local-write-file-hooks 'wl-draft-save)
+ (wl-highlight-headers 'for-draft)
+ (run-hooks 'wl-draft-reedit-hook)
+ (goto-char (point-max))
+ buffer)))
(defmacro wl-draft-body-goto-top ()
(` (progn
(wl-draft-config-exec config-alist reply-buf)))))
(defun wl-draft-config-exec (&optional config-alist reply-buf)
- "Change headers in draft sending time."
+ "Change headers according to the value of `wl-draft-config-alist'.
+Automatically applied in draft sending time."
(interactive)
(let ((case-fold-search t)
(alist (or config-alist wl-draft-config-alist))
(interactive "P")
(if arg
(wl-jump-to-draft-folder)
- (let ((bufs (buffer-list))
- (draft-regexp (concat
- "^" (regexp-quote
- (elmo-localdir-folder-directory-internal
- (wl-folder-get-elmo-folder wl-draft-folder)))))
- buf draft-bufs)
- (while bufs
- (if (and
- (setq buf (buffer-file-name (car bufs)))
- (string-match draft-regexp buf))
- (setq draft-bufs (cons (buffer-name (car bufs)) draft-bufs)))
- (setq bufs (cdr bufs)))
+ (let ((draft-bufs (wl-collect-draft))
+ buf)
(cond
((null draft-bufs)
(message "No draft buffer exist."))
(t
(setq draft-bufs
- (sort draft-bufs (function (lambda (a b) (not (string< a b))))))
- (if (setq buf (cdr (member (buffer-name) draft-bufs)))
+ (sort (mapcar 'buffer-name draft-bufs)
+ (function (lambda (a b)
+ (not (string< a b))))))
+ (if (setq buf (cdr (member (buffer-name)
+ draft-bufs)))
(setq buf (car buf))
(setq buf (car draft-bufs)))
(switch-to-buffer buf))))))