-;;; wl-draft.el -- Message draft mode for Wanderlust.
+;;; wl-draft.el --- Message draft mode for Wanderlust.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
(autoload 'wl-addrmgr "wl-addrmgr"))
(defvar wl-draft-buf-name "Draft")
-(defvar wl-draft-cite-function 'wl-default-draft-cite)
(defvar wl-draft-buffer-file-name nil)
(defvar wl-draft-field-completion-list nil)
(defvar wl-draft-verbose-send t)
(defvar wl-draft-queue-flush-send-function 'wl-draft-dispatch-message)
(defvar wl-sent-message-via nil)
(defvar wl-sent-message-modified nil)
+(defvar wl-sent-message-queued nil)
(defvar wl-draft-fcc-list nil)
(defvar wl-draft-reedit nil)
(defvar wl-draft-reply-buffer nil)
(defvar wl-draft-forward nil)
+(defvar wl-draft-parent-folder nil)
(defvar wl-draft-config-sub-func-alist
- '((body . wl-draft-config-sub-body)
- (top . wl-draft-config-sub-top)
- (bottom . wl-draft-config-sub-bottom)
- (header . wl-draft-config-sub-header)
- (body-file . wl-draft-config-sub-body-file)
- (top-file . wl-draft-config-sub-top-file)
- (bottom-file . wl-draft-config-sub-bottom-file)
- (header-file . wl-draft-config-sub-header-file)
- (template . wl-draft-config-sub-template)
- (x-face . wl-draft-config-sub-x-face)))
+ '((body . wl-draft-config-sub-body)
+ (top . wl-draft-config-sub-top)
+ (bottom . wl-draft-config-sub-bottom)
+ (header . wl-draft-config-sub-header)
+ (header-top . wl-draft-config-sub-header-top)
+ (header-bottom . wl-draft-config-sub-header)
+ (part-top . wl-draft-config-sub-part-top)
+ (part-bottom . wl-draft-config-sub-part-bottom)
+ (body-file . wl-draft-config-sub-body-file)
+ (top-file . wl-draft-config-sub-top-file)
+ (bottom-file . wl-draft-config-sub-bottom-file)
+ (header-file . wl-draft-config-sub-header-file)
+ (template . wl-draft-config-sub-template)
+ (x-face . wl-draft-config-sub-x-face)))
(make-variable-buffer-local 'wl-draft-buffer-file-name)
(make-variable-buffer-local 'wl-draft-buffer-cur-summary-buffer)
(make-variable-buffer-local 'wl-draft-config-variables)
(make-variable-buffer-local 'wl-draft-config-exec-flag)
(make-variable-buffer-local 'wl-sent-message-via)
+(make-variable-buffer-local 'wl-sent-message-queued)
(make-variable-buffer-local 'wl-draft-fcc-list)
(make-variable-buffer-local 'wl-draft-reply-buffer)
+(make-variable-buffer-local 'wl-draft-parent-folder)
+
+(defsubst wl-smtp-password-key (user mechanism server)
+ (format "SMTP:%s/%s@%s"
+ user mechanism server))
(defmacro wl-smtp-extension-bind (&rest body)
(` (let* ((smtp-sasl-mechanisms
(function
(lambda (prompt)
(elmo-get-passwd
- (format "%s@%s"
- smtp-sasl-user-name
- smtp-server)))))
+ (wl-smtp-password-key
+ smtp-sasl-user-name
+ (car smtp-sasl-mechanisms)
+ smtp-server)))))
(,@ body))))
(defun wl-draft-insert-date-field ()
;;;(save-excursion
(let (r-list
to mail-followup-to cc subject in-reply-to references newsgroups
- from to-alist cc-alist decoder)
+ from to-alist cc-alist decoder parent-folder)
+ (set-buffer summary-buf)
+ (setq parent-folder (wl-summary-buffer-folder-name))
(set-buffer buf)
(setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
(catch 'done
(setq mail-followup-to
(wl-draft-make-mail-followup-to (append to cc)))
(setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
- (setq newsgroups (wl-parse newsgroups
- "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
- newsgroups (wl-delete-duplicates newsgroups)
- newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
+ (with-temp-buffer ; to keep raw buffer unibyte.
+ (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (setq newsgroups (wl-parse newsgroups
+ "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
+ newsgroups (wl-delete-duplicates newsgroups)
+ newsgroups
+ (if newsgroups
+ (mapconcat
+ (lambda (grp)
+ (setq decoder (mime-find-field-decoder 'Newsgroups 'plain))
+ (if decoder (funcall decoder grp) grp))
+ newsgroups ","))))
(setq to (wl-delete-duplicates to nil t))
(setq cc (wl-delete-duplicates
(append (wl-delete-duplicates cc nil t)
(mapconcat 'identity references "\n\t")))
(wl-draft
to subject in-reply-to cc references newsgroups mail-followup-to
- nil nil nil nil summary-buf)
+ nil nil nil nil summary-buf nil parent-folder)
(setq wl-draft-reply-buffer buf))
(run-hooks 'wl-reply-hook))
(defun wl-draft-add-references ()
+ (wl-draft-add-in-reply-to "References"))
+
+(defun wl-draft-add-in-reply-to (&optional alt-field)
(let* ((mes-id (save-excursion
(set-buffer mail-reply-buffer)
(std11-field-body "message-id")))
- (ref (std11-field-body "References"))
+ (field (or alt-field "In-Reply-To"))
+ (ref (std11-field-body field))
(ref-list nil) (st nil))
(when (and mes-id ref)
(while (string-match "<[^>]+>" ref st)
(setq mes-id nil)))
(when mes-id
(save-excursion
- (when (mail-position-on-field "References")
+ (when (mail-position-on-field field)
(forward-line)
(while (looking-at "^[ \t]")
(forward-line))
(mail-yank-hooks (run-hooks 'mail-yank-hooks))
(wl-draft-cite-function (funcall wl-draft-cite-function))) ; default cite
(run-hooks 'wl-draft-cited-hook)
- (when (and wl-draft-add-references
- (wl-draft-add-references))
+ (when (if wl-draft-add-references
+ (wl-draft-add-references)
+ (if wl-draft-add-in-reply-to
+ (wl-draft-add-in-reply-to)))
(wl-highlight-headers 'for-draft)) ; highlight when added References:
(when wl-highlight-body-too
(wl-highlight-body-region beg (point-max)))))
(wl-draft-edit-string (elmo-get-file-string
(or file
(read-file-name "File to edit: "
- (or wl-tmp-dir "~/"))))))
+ (or wl-temporary-file-directory
+ "~/"))))))
(defun wl-draft-edit-string (string)
(let ((cur-buf (current-buffer))
(let (original-buffer
mail-reply-buffer
mail-citation-hook mail-yank-hooks
- wl-draft-add-references wl-draft-cite-function)
+ 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))
(setq from (elmo-msgdb-overview-entity-get-from entity)))
(setq cite-title (format "At %s,\n%s wrote:"
(or date "some time ago")
- (wl-summary-from-func-internal
- (or from "you"))))))
+ (if wl-default-draft-cite-decorate-author
+ (wl-summary-from-func-internal
+ (or from "you"))
+ (or from "you"))))))
(and cite-title
(insert cite-title "\n"))
(mail-indent-citation)))
(defun wl-draft-hide (editing-buffer)
"Hide the editing draft buffer if possible."
- (interactive)
(when (and editing-buffer
(buffer-live-p editing-buffer))
(set-buffer editing-buffer)
(mail-position-on-field "to"))
(insert "\nFcc: "))
+;; Imported from message.el.
+(defun wl-draft-elide-region (b e)
+ "Elide the text in the region.
+An ellipsis (from `wl-draft-elide-ellipsis') will be inserted where the
+text was killed."
+ (interactive "r")
+ (kill-region b e)
+ (insert wl-draft-elide-ellipsis))
+
;; function for wl-sent-message-via
(defmacro wl-draft-sent-message-p (type)
(defun wl-draft-write-sendlog (status proto server to id)
"Write send log file, if `wl-draft-sendlog' is non-nil."
(when wl-draft-sendlog
- (save-excursion
- (let* ((tmp-buf (get-buffer-create " *wl-draft-sendlog*"))
- (filename (expand-file-name wl-draft-sendlog-filename
- elmo-msgdb-dir))
+ (with-temp-buffer
+ (let* ((filename (expand-file-name wl-draft-sendlog-filename
+ elmo-msgdb-directory))
(filesize (nth 7 (file-attributes filename)))
(server (if server (concat " server=" server) ""))
(to (if to (cond
""))
(id (if id (concat " id=" id) ""))
(time (wl-sendlog-time)))
- (set-buffer tmp-buf)
- (erase-buffer)
(insert (format "%s proto=%s stat=%s%s%s%s\n"
time proto status server to id))
(if (and wl-draft-sendlog-max-size filesize
(> filesize wl-draft-sendlog-max-size))
(rename-file filename (concat filename ".old") t))
(if (file-writable-p filename)
- (write-region (point-min) (point-max)
- filename t 'no-msg)
- (message (format "%s is not writable." filename)))
- (kill-buffer tmp-buf)))))
+ (write-region-as-binary (point-min) (point-max)
+ filename t 'no-msg)
+ (message "%s is not writable." filename))))))
(defun wl-draft-get-header-delimiter (&optional delete)
;; If DELETE is non-nil, replace the header delimiter with a blank line
(not (elmo-plugged-p)))
(wl-draft-set-sent-message 'mail 'unplugged)
;; send the message
+ (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(let ((id (std11-field-body "Message-ID"))
(to (std11-field-body "To")))
(case
"Get address list suitable for smtp RCPT TO:<address>.
Group list content is removed if `wl-draft-remove-group-list-contents' is
non-nil."
- (let ((fields '("to" "cc" "bcc"))
+ (let ((fields '("to" "cc" "bcc"))
(resent-fields '("resent-to" "resent-cc" "resent-bcc"))
(case-fold-search t)
addrs recipients)
(goto-char (1+ delimline))
(if (eval mail-mailer-swallows-blank-line)
(newline))
-;;; (run-hooks 'wl-mail-send-pre-hook)
+ (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(if mail-interactive
(save-excursion
(set-buffer errbuf)
(error
(wl-draft-write-sendlog 'failed 'smtp smtp-server
recipients id)
+ (if (/= (nth 1 err) 334)
+ (elmo-remove-passwd
+ (wl-smtp-password-key
+ smtp-sasl-user-name
+ (car smtp-sasl-mechanisms)
+ smtp-server)))
(signal (car err) (cdr err)))))
(wl-draft-set-sent-message 'mail 'sent)
(wl-draft-write-sendlog
(defun wl-draft-send-mail-with-pop-before-smtp ()
"Send the prepared message buffer with POP-before-SMTP."
(require 'elmo-pop3)
- (condition-case ()
- (let ((session (elmo-pop3-get-session
- (luna-make-entity
- 'elmo-pop3-folder
- :user (or wl-pop-before-smtp-user
- elmo-pop3-default-user)
- :server (or wl-pop-before-smtp-server
- elmo-pop3-default-server)
- :port (or wl-pop-before-smtp-port
- elmo-pop3-default-port)
- :auth (or wl-pop-before-smtp-authenticate-type
- elmo-pop3-default-authenticate-type)
- :stream-type (or wl-pop-before-smtp-stream-type
- elmo-pop3-default-stream-type)))))
- (when session (elmo-network-close-session session)))
- (error))
+ (let ((session
+ (luna-make-entity
+ 'elmo-pop3-folder
+ :user (or wl-pop-before-smtp-user
+ elmo-pop3-default-user)
+ :server (or wl-pop-before-smtp-server
+ elmo-pop3-default-server)
+ :port (or wl-pop-before-smtp-port
+ elmo-pop3-default-port)
+ :auth (or wl-pop-before-smtp-authenticate-type
+ elmo-pop3-default-authenticate-type)
+ :stream-type (or wl-pop-before-smtp-stream-type
+ elmo-pop3-default-stream-type))))
+ (condition-case error
+ (progn
+ (elmo-pop3-get-session session)
+ (when session (elmo-network-close-session session)))
+ (error
+ (elmo-network-close-session session)
+ (unless (string= (nth 1 error) "Unplugged")
+ (signal (car error)(cdr error))))))
(wl-draft-send-mail-with-smtp))
(defun wl-draft-insert-required-fields (&optional force-msgid)
wl-insert-message-id)
(not (re-search-forward "^Message-ID[ \t]*:" nil t)))
(insert (concat "Message-ID: "
- (wl-draft-make-message-id-string)
+ (funcall wl-message-id-function)
"\n")))
;; Insert date field.
(goto-char (point-min))
;; ignore any blank lines in the header
(while (re-search-forward "\n\n\n*" nil t)
(replace-match "\n")))
- (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
+;;; (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(wl-draft-dispatch-message)
(when kill-when-done
;; hide editing-buffer.
(progn
(if (and (wl-message-mail-p)
(not (wl-draft-sent-message-p 'mail)))
- (funcall wl-draft-send-mail-function))
+ (if (or (not (or wl-draft-force-queuing
+ wl-draft-force-queuing-mail))
+ (memq 'mail wl-sent-message-queued))
+ (funcall wl-draft-send-mail-function)
+ (push 'mail wl-sent-message-queued)
+ (wl-draft-set-sent-message 'mail 'unplugged)))
(if (and (wl-message-news-p)
(not (wl-draft-sent-message-p 'news))
(not (wl-message-field-exists-p "Resent-to")))
- (funcall wl-draft-send-news-function)))
+ (if (or (not (or wl-draft-force-queuing
+ wl-draft-force-queuing-news))
+ (memq 'news wl-sent-message-queued))
+ (funcall wl-draft-send-news-function)
+ (push 'news wl-sent-message-queued)
+ (wl-draft-set-sent-message 'news 'unplugged))))
;;
(let* ((status (wl-draft-sent-message-results))
(unplugged-via (car status))
(when (and unplugged-via
wl-sent-message-modified)
(if wl-draft-enable-queuing
- (wl-draft-queue-append wl-sent-message-via)
+ (progn
+ (wl-draft-queue-append wl-sent-message-via)
+ (setq wl-sent-message-modified 'requeue))
(error "Unplugged")))
(when wl-draft-verbose-send
(if (and unplugged-via sent-via);; combined message
(let (wl-interactive-send
;;; wl-draft-verbose-send
(wl-mail-send-pre-hook (and force-pre-hook wl-mail-send-pre-hook))
-;;; wl-news-send-pre-hook
+ (wl-news-send-pre-hook (and force-pre-hook wl-news-send-pre-hook))
mail-send-hook
mail-send-actions)
(wl-draft-send kill-when-done mes-string))))
(kill-buffer sending-buffer))))))
(defun wl-draft-save ()
- "Save current draft."
+ "Save current draft.
+Derived from `message-save-drafts' in T-gnus."
(interactive)
- (save-buffer)
- (wl-draft-config-info-operation
- (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))
- 'save))
+ (if (buffer-modified-p)
+ (progn
+ (message "Saving %s..." wl-draft-buffer-file-name)
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
+ (with-temp-file wl-draft-buffer-file-name
+ (insert msg)
+ ;; If no header separator, insert it.
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (goto-char (point-min))
+ (if (re-search-forward "\n\n" nil t)
+ (replace-match (concat "\n" mail-header-separator "\n"))
+ (goto-char (point-max))
+ (insert (if (eq (char-before) ?\n) "" "\n")
+ mail-header-separator "\n"))))
+ (let ((mime-header-encode-method-alist
+ '((eword-encode-unstructured-field-body))))
+ (mime-edit-translate-buffer))
+ (wl-draft-get-header-delimiter t)))
+ (set-buffer-modified-p nil)
+ (wl-draft-config-info-operation
+ (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
+ (string-to-int
+ (match-string 0 wl-draft-buffer-file-name)))
+ 'save)
+ (message "Saving %s...done" wl-draft-buffer-file-name))
+ (message "(No changes need to be saved)")))
(defun wl-draft-mimic-kill-buffer ()
"Kill the current (draft) buffer with query."
(let ((wl-interactive-send t))
(wl-draft-send-and-exit)))
-(defun wl-draft-delete-field (field &optional delimline)
- (wl-draft-delete-fields (regexp-quote field) delimline))
+(defun wl-draft-delete-field (field &optional delimline replace)
+ (wl-draft-delete-fields (regexp-quote field) delimline replace))
-(defun wl-draft-delete-fields (regexp &optional delimline)
+(defun wl-draft-delete-fields (field &optional delimline replace)
(save-restriction
(unless delimline
+ (goto-char (point-min))
(if (search-forward "\n\n" nil t)
(setq delimline (point))
(setq delimline (point-max))))
(narrow-to-region (point-min) delimline)
(goto-char (point-min))
- (let ((regexp (concat "^" regexp ":"))
- (case-fold-search t)
- last)
+ (let ((regexp (concat "^" field ":"))
+ (case-fold-search t))
(while (not (eobp))
(if (looking-at regexp)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(goto-char (match-beginning 0))
- (point-max)))))
+ (point-max))))
+ (if replace
+ (insert (concat field ": " replace "\n"))))
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(goto-char (match-beginning 0))
(let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)))
(nth (abs (% (random) 26)) alphabet)))
+;;;;;;;;;;;;;;;;
;;;###autoload
(defun wl-draft (&optional to subject in-reply-to cc references newsgroups
mail-followup-to
content-type content-transfer-encoding
- body edit-again summary-buf from)
+ body edit-again summary-buf from parent-folder)
"Write and send mail/news message with Wanderlust."
(interactive)
- (unless (featurep 'wl)
- (require 'wl))
+ (require 'wl)
(unless wl-init
(wl-load-profile)
(wl-folder-init)
(elmo-init)
(wl-plugged-init t))
- (wl-init) ; returns immediately if already initialized.
- (if (interactive-p)
- (setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name))))
- (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
- buf-name file-name num wl-demo change-major-mode-hook)
+ (let (wl-demo)
+ (wl-init)) ; returns immediately if already initialized.
+
+ (let (buf-name header-alist)
+ (setq buf-name
+ (wl-draft-create-buffer
+ (or
+ (eq this-command 'wl-draft)
+ (eq this-command 'wl-summary-write)
+ (eq this-command 'wl-summary-write-current-folder))
+ parent-folder summary-buf))
+ (setq header-alist
+ (list
+ (cons "From: " (or from wl-from))
+ (cons "To: " (or to
+ (and
+ (or (interactive-p)
+ (eq this-command 'wl-summary-write))
+ "")))
+ (cons "Cc: " cc)
+ (cons "Subject: " (or subject ""))
+ (cons "Newsgroups: " newsgroups)
+ (cons "Mail-Followup-To: " mail-followup-to)
+ (cons "In-Reply-To: " in-reply-to)
+ (cons "References: " references)))
+ (setq header-alist (append header-alist
+ (wl-draft-default-headers)
+ (if body (list "" body))))
+ (wl-draft-create-contents header-alist)
+ (if edit-again
+ (wl-draft-decode-body
+ content-type content-transfer-encoding))
+ (wl-draft-insert-mail-header-separator)
+ (wl-draft-prepare-edit)
+ (if (interactive-p)
+ (run-hooks 'wl-mail-setup-hook))
+
+ (goto-char (point-min))
+ (wl-user-agent-compose-internal) ;; user-agent
+ (cond ((eq this-command 'wl-summary-write-current-newsgroup)
+ (mail-position-on-field "Subject"))
+ ((and (interactive-p) (null to))
+ (mail-position-on-field "To"))
+ (t
+ (goto-char (point-max))))
+ buf-name))
+
+(defun wl-draft-create-buffer (&optional full parent-folder summary-buf)
+ (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+ (parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
+ (summary-buf (or summary-buf (wl-summary-get-buffer parent-folder)))
+ buf-name file-name num change-major-mode-hook)
(if (not (elmo-folder-message-file-p draft-folder))
(error "%s folder cannot be used for draft folder" wl-draft-folder))
(setq num (elmo-max-of-list
(buffer-name)))
(rename-buffer (concat wl-draft-folder "/" (int-to-string num))))
(if (or (eq wl-draft-reply-buffer-style 'full)
- (eq this-command 'wl-draft)
- (eq this-command 'wl-summary-write)
- (eq this-command 'wl-summary-write-current-folder))
+ full)
(delete-other-windows))
(auto-save-mode -1)
(wl-draft-mode)
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows nil)
(setq truncate-lines wl-draft-truncate-lines)
(setq wl-sent-message-via nil)
- (if (stringp (or from wl-from))
- (insert "From: " (or from wl-from) "\n"))
- (and (or (interactive-p)
- (eq this-command 'wl-summary-write)
- to)
- (insert "To: " (or to "") "\n"))
- (and cc (insert "Cc: " (or cc "") "\n"))
- (insert "Subject: " (or subject "") "\n")
- (and newsgroups (insert "Newsgroups: " newsgroups "\n"))
- (and mail-followup-to (insert "Mail-Followup-To: " mail-followup-to "\n"))
- (and wl-insert-mail-reply-to
- (insert "Mail-Reply-To: "
- (wl-address-header-extract-address
- wl-from) "\n"))
- (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n"))
- (and references (insert "References: " references "\n"))
- (insert (funcall wl-generate-mailer-string-function) "\n")
+ (setq wl-sent-message-queued nil)
(setq wl-draft-buffer-file-name file-name)
- (if mail-default-reply-to
- (insert "Reply-To: " mail-default-reply-to "\n"))
- (wl-draft-insert-ccs "Bcc: " (or wl-bcc
- (and mail-self-blind (user-login-name))))
- (wl-draft-insert-ccs "Fcc: " wl-fcc)
- (if wl-organization
- (insert "Organization: " wl-organization "\n"))
- (and wl-auto-insert-x-face
- (file-exists-p wl-x-face-file)
- (wl-draft-insert-x-face-field-here))
- (if mail-default-headers
- (insert mail-default-headers))
- (if (not (= (preceding-char) ?\n))
- (insert ?\n))
- (if edit-again
- (let (start)
- (setq start (point))
- (when content-type
- (insert "Content-type: " content-type "\n"))
- (when content-transfer-encoding
- (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
- (if (or content-type content-transfer-encoding)
- (insert "\n"))
- (and body (insert body))
- (save-restriction
- (narrow-to-region start (point))
- (and edit-again
- (wl-draft-decode-message-in-buffer))
- (widen)
- (goto-char start)
- (put-text-property (point)
- (progn
- (insert mail-header-separator "\n")
- (1- (point)))
- 'category 'mail-header-separator)))
- (put-text-property (point)
- (progn
- (insert mail-header-separator "\n")
- (1- (point)))
- 'category 'mail-header-separator)
- (and body (insert body)))
- (as-binary-output-file
- (write-region (point-min)(point-max) wl-draft-buffer-file-name
- nil t))
+ (setq wl-draft-config-exec-flag t)
+ (setq wl-draft-parent-folder parent-folder)
+ (setq wl-draft-buffer-cur-summary-buffer summary-buf)
+ buf-name))
+
+(defun wl-draft-create-contents (header-alist)
+ "header-alist' sample
+'(function ;; funcall
+ string ;; insert string
+ (string . string) ;; insert string string
+ (string . function) ;; insert string (funcall)
+ (string . nil) ;; insert nothing
+ (function . (arg1 arg2 ..)) ;; call function with argument
+ nil ;; insert nothing
+"
+ (unless (eq major-mode 'wl-draft-mode)
+ (error "wl-draft-create-header must be use in wl-draft-mode."))
+ (let ((halist header-alist)
+ field value)
+ (while halist
+ (cond
+ ;; function
+ ((functionp (car halist)) (funcall (car halist)))
+ ;; string
+ ((stringp (car halist)) (insert (car halist) "\n"))
+ ;; cons
+ ((consp (car halist))
+ (setq field (car (car halist)))
+ (setq value (cdr (car halist)))
+ (cond
+ ((functionp field) (apply field value))
+ ((stringp field)
+ (cond
+ ((stringp value) (insert field value "\n"))
+ ((functionp value) (insert field (funcall value) "\n"))
+ ((not value))
+ (t
+ (debug))))
+ ;;
+ ((not field))
+ (t
+ (debug))
+ )))
+ (setq halist (cdr halist)))))
+
+(defun wl-draft-prepare-edit ()
+ (unless (eq major-mode 'wl-draft-mode)
+ (error "wl-draft-create-header must be use in wl-draft-mode."))
+ (let (change-major-mode-hook)
(wl-draft-editor-mode)
+ (add-hook 'local-write-file-hooks 'wl-draft-save)
(wl-draft-overload-functions)
(wl-highlight-headers 'for-draft)
- (goto-char (point-min))
- (setq wl-draft-config-exec-flag t)
- (if (interactive-p)
- (run-hooks 'wl-mail-setup-hook))
- (wl-user-agent-compose-internal) ;; user-agent
- (cond ((eq this-command 'wl-summary-write-current-newsgroup)
- (mail-position-on-field "Subject"))
- ((and (interactive-p) (null to))
- (mail-position-on-field "To"))
- (t
- (goto-char (point-max))))
- (setq wl-draft-buffer-cur-summary-buffer (or summary-buf
- (get-buffer
- wl-summary-buffer-name)))
- buf-name))
+ (wl-draft-save)
+ (clear-visited-file-modtime)))
+
+(defun wl-draft-decode-header ()
+ (save-excursion
+ (std11-narrow-to-header)
+ (wl-draft-decode-message-in-buffer)
+ (widen)))
+
+(defun wl-draft-decode-body (&optional content-type content-transfer-encoding)
+ (let ((content-type
+ (or content-type
+ (std11-field-body "content-type")))
+ (content-transfer-encoding
+ (or content-transfer-encoding
+ (std11-field-body "content-transfer-encoding")))
+ delimline)
+ (save-excursion
+ (std11-narrow-to-header)
+ (wl-draft-delete-field "content-type")
+ (wl-draft-delete-field "content-transfer-encoding")
+ (goto-char (point-max))
+ (setq delimline (point-marker))
+ (widen)
+ (narrow-to-region delimline (point-max))
+ (goto-char (point-min))
+ (when content-type
+ (insert "Content-type: " content-type "\n"))
+ (when content-transfer-encoding
+ (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
+ (wl-draft-decode-message-in-buffer)
+ (goto-char (point-min))
+ (unless (re-search-forward "^$" (point-at-eol) t)
+ (insert "\n"))
+ (widen)
+ delimline)))
+
+;;; subroutine for wl-draft-create-contents
+;;; must be used in wl-draft-mode
+(defun wl-draft-check-new-line ()
+ (if (not (= (preceding-char) ?\n))
+ (insert ?\n)))
(defsubst wl-draft-insert-ccs (str cc)
(let ((field
(mapcar 'downcase wl-subscribed-mailing-list)))))
(insert str field "\n"))))
+(defsubst wl-draft-default-headers ()
+ (list
+ (cons "Mail-Reply-To: " (and wl-insert-mail-reply-to
+ (wl-address-header-extract-address
+ wl-from)))
+ (cons "" wl-generate-mailer-string-function)
+ (cons "Reply-To: " mail-default-reply-to)
+ (cons 'wl-draft-insert-ccs
+ (list "Bcc: " (or wl-bcc
+ (and mail-self-blind (user-login-name)))))
+ (cons 'wl-draft-insert-ccs
+ (list "Fcc: " wl-fcc))
+ (cons "Organization: " wl-organization)
+ (and wl-auto-insert-x-face
+ (file-exists-p wl-x-face-file)
+ 'wl-draft-insert-x-face-field-here) ;; allow nil
+ mail-default-headers
+ ;; check \n at th end of line for `mail-default-headers'
+ 'wl-draft-check-new-line
+; wl-draft-default-headers
+; 'wl-draft-check-new-line
+ ))
+
+(defun wl-draft-insert-mail-header-separator (&optional delimline)
+ (save-excursion
+ (if delimline
+ (goto-char delimline)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (delete-backward-char 1)
+ (goto-char (point-max))))
+ (wl-draft-check-new-line)
+ (put-text-property (point)
+ (progn
+ (insert mail-header-separator "\n")
+ (1- (point)))
+ 'category 'mail-header-separator)))
+
+;;;;;;;;;;;;;;;;
+
(defun wl-draft-elmo-nntp-send ()
(let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook)
(elmo-nntp-default-user
(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-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-body-goto-header)
(if content (insert (concat (eval content) "\n"))))
+(defun wl-draft-config-sub-header-top (content)
+ (goto-char (point-min))
+ (if content (insert (concat (eval content) "\n"))))
+
+(defun wl-draft-config-sub-part-top (content)
+ (goto-char (mime-edit-content-beginning))
+ (if content (insert (concat (eval content) "\n"))))
+
+(defun wl-draft-config-sub-part-bottom (content)
+ (goto-char (mime-edit-content-end))
+ (if content (insert (concat (eval content) "\n"))))
+
(defsubst wl-draft-config-sub-file (content)
(let ((coding-system-for-read wl-cs-autoconv)
(file (expand-file-name (eval content))))
wl-draft-config-variables
(list 'wl-draft-fcc-list)))))
(if add-sent-message-via
- (push 'wl-sent-message-via variables))
+ (progn
+ (push 'wl-sent-message-queued variables)
+ (push 'wl-sent-message-via variables)))
(while (setq variable (pop variables))
(when (boundp variable)
(wl-append alist
"Flush draft queue."
(interactive)
(let* ((queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
- (msgs2 (elmo-folder-list-messages queue-folder))
+ (msgs2 (progn
+ (elmo-folder-open-internal queue-folder)
+ (elmo-folder-list-messages queue-folder)))
(i 0)
(performed 0)
(wl-draft-queue-flushing t)
(catch 'found
(while sent-via
(when (and (eq (nth 1 (car sent-via)) 'unplugged)
- (elmo-plugged-p
- (car (nth 2 (car sent-via)))
- (cdr (nth 2 (car sent-via)))))
+ (or (not (nth 2 (car sent-via)))
+ (elmo-plugged-p
+ (car (nth 2 (car sent-via)))
+ (cdr (nth 2 (car sent-via))))))
(wl-append msgs (list (car msgs2)))
(throw 'found t))
(setq sent-via (cdr sent-via))))
(setq failure t))
(quit
(setq failure t)))
- (unless failure
- (elmo-folder-delete-messages
- queue-folder (cons (car msgs) nil))
- (wl-draft-queue-info-operation (car msgs) 'delete)
- (setq performed (+ 1 performed)))
+ (if (eq wl-sent-message-modified 'requeue)
+ (progn
+ (elmo-folder-delete-messages
+ queue-folder (cons (car msgs) nil))
+ (wl-draft-queue-info-operation (car msgs) 'delete))
+ (unless failure
+ (elmo-folder-delete-messages
+ queue-folder (cons (car msgs) nil))
+ (wl-draft-queue-info-operation (car msgs) 'delete)
+ (setq performed (+ 1 performed))))
(setq msgs (cdr msgs)))
(kill-buffer buffer)
(message "%d message(s) are sent." performed)))
(message "%d message(s) are remained to be sent." len))
+ (elmo-folder-close queue-folder)
len)))
(defun wl-jump-to-draft-buffer (&optional arg)
buf draft-bufs)
(while bufs
(if (and
- (setq buf (buffer-file-name (car bufs)))
+ (setq buf (with-current-buffer (car bufs)
+ wl-draft-buffer-file-name))
(string-match draft-regexp buf))
(setq draft-bufs (cons (buffer-name (car bufs)) draft-bufs)))
(setq bufs (cdr bufs)))
projects / elisp / wanderlust.git / blobdiff