(require 'emu)
(condition-case nil (require 'timezone) (error nil))
(require 'std11)
+(require 'eword-encode)
(require 'wl-vars)
(defvar x-face-add-x-face-version-header)
(defvar mail-from-style)
(eval-when-compile
+ (require 'cl)
(require 'static)
(require 'elmo-pop3)
(defalias-maybe 'x-face-insert 'ignore)
(\"From\" . \"user@domain2\"))))")
(defvar wl-draft-parent-number nil)
+(defvar wl-draft-parent-flag nil)
-(defconst wl-draft-reply-saved-variables
+(defconst wl-draft-parent-variables
'(wl-draft-parent-folder
- wl-draft-parent-number))
+ wl-draft-parent-number
+ wl-draft-parent-flag))
(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)
(make-variable-buffer-local 'wl-draft-parent-number)
+(make-variable-buffer-local 'wl-draft-parent-flag)
(defvar wl-draft-folder-internal nil
"Internal variable for caching `opened' draft folder.")
"\n"
smtp-end-of-line))
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 smtp-sasl-user-name wl-smtp-posting-user
+ smtp-sasl-properties (when wl-smtp-authenticate-realm
+ (list 'realm
+ wl-smtp-authenticate-realm)))
(setq sasl-read-passphrase
(function
(lambda (prompt)
(list (concat wl-draft-mime-bcc-field-name ":")))))))
(defun wl-draft-make-mail-followup-to (recipients)
- (if (elmo-list-member
- (or wl-user-mail-address-list
- (list (wl-address-header-extract-address wl-from)))
- recipients)
- (let ((rlist (elmo-list-delete
- (or wl-user-mail-address-list
- (list (wl-address-header-extract-address wl-from)))
- recipients
- (lambda (elem list)
- (elmo-delete-if
- (lambda (item) (string= (downcase elem)
- (downcase item)))
- list)))))
- (if (elmo-list-member rlist (mapcar 'downcase
- wl-subscribed-mailing-list))
- rlist
- (append rlist (list (wl-address-header-extract-address
- wl-from)))))
- recipients))
+ (let ((rlist (wl-address-delete-user-mail-addresses recipients)))
+ (if (elmo-list-member rlist (mapcar 'downcase
+ wl-subscribed-mailing-list))
+ rlist
+ (append rlist (list (wl-address-header-extract-address
+ wl-from))))))
(defun wl-draft-delete-myself-from-cc (to cc)
- (let ((myself (or wl-user-mail-address-list
- (list (wl-address-header-extract-address wl-from)))))
- (cond (wl-draft-always-delete-myself ; always-delete option
- (elmo-list-delete myself cc
- (lambda (elem list)
- (elmo-delete-if
- (lambda (item) (string= (downcase elem)
- (downcase item)))
- list))))
- ((elmo-list-member (append to cc) ; subscribed mailing-list
- (mapcar 'downcase wl-subscribed-mailing-list))
- (elmo-list-delete myself cc
- (lambda (elem list)
- (elmo-delete-if
- (lambda (item) (string= (downcase elem)
- (downcase item)))
- list))))
- (t cc))))
-
-(defun wl-draft-forward (original-subject summary-buf)
- (let (references parent-folder)
+ (cond (wl-draft-always-delete-myself ; always-delete option
+ (wl-address-delete-user-mail-addresses cc))
+ ((elmo-list-member (append to cc) ; subscribed mailing-list
+ (mapcar 'downcase wl-subscribed-mailing-list))
+ (wl-address-delete-user-mail-addresses cc))
+ (t cc)))
+
+(defsubst wl-draft-strip-subject-regexp (subject regexp)
+ "Remove REGEXP from SUBJECT string."
+ (if (string-match regexp subject)
+ (substring subject (match-end 0))
+ subject))
+
+(defun wl-draft-forward-make-subject (original-subject)
+ "Generate subject string for forwarding."
+ (cond ((functionp wl-forward-subject-prefix)
+ (concat (funcall wl-forward-subject-prefix)
+ original-subject))
+ ((stringp wl-forward-subject-prefix)
+ (concat wl-forward-subject-prefix
+ (wl-draft-strip-subject-regexp
+ (or original-subject "")
+ wl-subject-forward-prefix-regexp)))
+ (t original-subject)))
+
+(defun wl-draft-reply-make-subject (original-subject)
+ "Generate subject string for replying."
+ (cond ((functionp wl-reply-subject-prefix)
+ (concat (funcall wl-reply-subject-prefix)
+ original-subject))
+ ((stringp wl-reply-subject-prefix)
+ (concat wl-reply-subject-prefix
+ (wl-draft-strip-subject-regexp
+ (or original-subject "")
+ wl-subject-re-prefix-regexp)))
+ (t original-subject)))
+
+(defun wl-draft-forward (original-subject summary-buf &optional number)
+ (let (references parent-folder subject)
(with-current-buffer summary-buf
(setq parent-folder (wl-summary-buffer-folder-name)))
+ (let ((decoder (mime-find-field-decoder 'Subject 'plain)))
+ (setq subject (if (and original-subject decoder)
+ (funcall decoder original-subject) original-subject)))
(with-current-buffer (wl-message-get-original-buffer)
+ (setq subject (wl-draft-forward-make-subject subject))
(setq references (nconc
(std11-field-bodies '("References" "In-Reply-To"))
(list (std11-field-body "Message-Id"))))
(get-buffer-window summary-buf)
(select-window (get-buffer-window summary-buf)))
(wl-draft (list (cons 'To "")
- (cons 'Subject
- (concat wl-forward-subject-prefix original-subject))
+ (cons 'Subject subject)
(cons 'References references))
nil nil nil nil parent-folder))
+ (setq wl-draft-parent-number number)
(goto-char (point-max))
(wl-draft-insert-message)
- (mail-position-on-field "To"))
-
-(defun wl-draft-strip-subject-re (subject)
- "Remove \"Re:\" from SUBJECT string. Shamelessly copied from Gnus."
- (if (string-match wl-subject-prefix-regexp subject)
- (substring subject (match-end 0))
- subject))
+ (mail-position-on-field "To")
+ (setq wl-draft-config-variables
+ (append wl-draft-parent-variables
+ wl-draft-config-variables))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
+ (run-hooks 'wl-draft-forward-hook))
(defun wl-draft-self-reply-p ()
"Return t when From address in the current message is user's self one or not."
(setq to (wl-parse-addresses to)
cc (wl-parse-addresses cc))
(with-temp-buffer ; to keep raw buffer unibyte.
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
(setq decoder (mime-find-field-decoder 'Subject 'plain))
(setq subject (if (and subject decoder)
(funcall decoder subject) subject))
(cons (nth 1 (std11-extract-address-components addr))
(if decoder (funcall decoder addr) addr)))
cc)))
- (and wl-reply-subject-prefix
- (setq subject (concat wl-reply-subject-prefix
- (wl-draft-strip-subject-re
- (or subject "")))))
+ (setq subject (wl-draft-reply-make-subject subject))
(setq in-reply-to (std11-field-body "Message-Id"))
(setq references (nconc
(std11-field-bodies '("References" "In-Reply-To"))
(wl-draft-make-mail-followup-to (append to cc)))
(setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
(with-temp-buffer ; to keep raw buffer unibyte.
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (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)
(setq wl-draft-parent-number number)
(setq wl-draft-reply-buffer buf)
(setq wl-draft-config-variables
- (append wl-draft-reply-saved-variables
- wl-draft-config-variables)))
- (run-hooks 'wl-reply-hook))
+ (append wl-draft-parent-variables
+ wl-draft-config-variables))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save))
+ (run-hooks 'wl-draft-reply-hook))
(defun wl-draft-reply-position (position)
(cond ((eq position 'body)
(save-restriction
(narrow-to-region (point)(point))
(insert
- (with-current-buffer mail-reply-buffer
- (when decode-it
- (decode-mime-charset-region (point-min) (point-max)
- wl-mime-charset))
- (buffer-substring-no-properties
- (point-min) (point-max))))
+ (string-as-multibyte
+ (with-current-buffer mail-reply-buffer
+ (when decode-it
+ (decode-mime-charset-region (point-min) (point-max)
+ wl-mime-charset))
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
(when ignored-fields
(goto-char (point-min))
(wl-draft-delete-fields ignored-fields))
(set-buffer
(wl-draft (list
(cons 'From
- (if (member
- (nth 1 (std11-extract-address-components from))
- wl-user-mail-address-list)
- from))
+ (if (wl-address-user-mail-address-p from) from))
(cons 'To to)
(cons 'Cc cc)
(cons 'Subject subject)
mail-citation-hook mail-yank-hooks
wl-draft-add-references wl-draft-add-in-reply-to
wl-draft-cite-function)
- (with-current-buffer wl-draft-buffer-cur-summary-buffer
- (with-current-buffer wl-message-buffer
- (setq original-buffer (wl-message-get-original-buffer))
- (if (zerop
- (with-current-buffer original-buffer
- (buffer-size)))
- (error "No current message"))))
- (setq mail-reply-buffer original-buffer)
- (wl-draft-yank-from-mail-reply-buffer
- nil
- wl-ignored-forwarded-headers)))
+ (if (and wl-draft-buffer-cur-summary-buffer
+ (with-current-buffer wl-draft-buffer-cur-summary-buffer
+ (and wl-message-buffer
+ (with-current-buffer wl-message-buffer
+ (setq original-buffer (wl-message-get-original-buffer))
+ (not (zerop (with-current-buffer original-buffer
+ (buffer-size))))))))
+ (progn
+ (setq mail-reply-buffer original-buffer)
+ (wl-draft-yank-from-mail-reply-buffer
+ nil
+ wl-ignored-forwarded-headers))
+ (when (string= (mime-make-tag "message" "rfc822")
+ (buffer-substring-no-properties (point-at-bol 0)(point-at-eol 0)))
+ (delete-region (point-at-bol 0) (1+ (point-at-eol 0))))
+ (error "No current message"))))
(defun wl-draft-insert-get-message (dummy)
(let ((fld (completing-read
(or force-kill
(yes-or-no-p "Kill Current Draft? ")))
(let ((cur-buf (current-buffer)))
- (when (and wl-draft-parent-number
- (not (string= wl-draft-parent-folder "")))
- (let* ((number wl-draft-parent-number)
- (folder-name wl-draft-parent-folder)
- (folder (wl-folder-get-elmo-folder folder-name))
- buffer)
- (if (and (setq buffer (wl-summary-get-buffer folder-name))
- (with-current-buffer buffer
- (string= (wl-summary-buffer-folder-name)
- folder-name)))
- (with-current-buffer buffer
- (elmo-folder-unset-flag folder (list number) 'answered)
- (when (wl-summary-jump-to-msg number)
- (wl-summary-update-persistent-mark)))
- (elmo-folder-open folder 'load-msgdb)
- (elmo-folder-unset-flag folder (list number) 'answered)
- (elmo-folder-close folder))))
+ (run-hooks 'wl-draft-kill-pre-hook)
(wl-draft-hide cur-buf)
(wl-draft-delete cur-buf)))
(message "")))
(re-search-forward "\n[ \t]*\n\n*" nil t))
(replace-match "\n"))
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"^[^ \t\n:]+:[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n"
nil t)
(when (string= "" (match-string 1))
(t
(throw 'done nil)))))))
(quit nil))
- (when wl-draft-send-confirm-with-preview
- (mime-preview-quit)))))
+ (when (and wl-draft-send-confirm-with-preview
+ (eq major-mode 'mime-view-mode))
+ (wl-mime-quit-preview)))))
(defun wl-draft-send (&optional kill-when-done mes-string)
"Send current draft message.
" *wl-draft-sending-buffer*"
(append wl-draft-config-variables
(wl-draft-clone-local-variables))))
+ (parent-flag wl-draft-parent-flag)
+ (parent-number wl-draft-parent-number)
+ (parent-folder wl-draft-parent-folder)
(wl-draft-verbose-msg nil)
err)
(unwind-protect
;;
(if wl-draft-verbose-send
(message "%s" (or mes-string "Sending...")))
+ ;; Set flag before send-function because
+ ;; there's no need to change current mailbox at this time.
+ ;; If flag is set after send-function, the current mailbox
+ ;; might changed by Fcc.
+ ;; It causes a huge loss in the IMAP folder.
+ (when (and parent-flag parent-number
+ (not (eq (length parent-folder) 0)))
+ (wl-folder-set-persistent-mark
+ parent-folder parent-number parent-flag))
(funcall wl-draft-send-function editing-buffer kill-when-done)
;; Now perform actions on successful sending.
(while mail-send-actions
(insert (if (eq (char-before) ?\n) "" "\n")
mail-header-separator "\n")))
(let ((mime-header-encode-method-alist
- '((eword-encode-unstructured-field-body))))
+ (append
+ '((eword-encode-unstructured-field-body
+ . (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From)))
+ (if (boundp 'mime-header-encode-method-alist)
+ (symbol-value 'mime-header-encode-method-alist)))))
(mime-edit-translate-buffer))
(wl-draft-get-header-delimiter t)
(setq next-number
(goto-char (point-max))
(insert-buffer-substring send-mail-buffer header-end)
(let ((id (std11-field-body "Message-ID"))
- (elmo-enable-disconnected-operation t)
- cache-saved)
+ (elmo-enable-disconnected-operation t))
(while fcc-list
- (unless (or cache-saved
- (elmo-folder-plugged-p
- (wl-folder-get-elmo-folder (car fcc-list))))
- (elmo-file-cache-save id nil) ;; for disconnected operation
- (setq cache-saved t))
(if (elmo-folder-append-buffer
(wl-folder-get-elmo-folder
(eword-decode-string (car fcc-list)))
(let (wl-demo)
(wl-init)) ; returns immediately if already initialized.
-
+ (wl-set-save-drafts)
(let (buffer header-alist-internal)
(setq buffer (wl-draft-create-buffer parent-folder))
(unless (cdr (assq 'From header-alist))
(eq this-command 'wl-summary-forward)
(eq this-command 'wl-summary-target-mark-forward)
(eq this-command 'wl-summary-target-mark-reply-with-citation)))
- (buffer (generate-new-buffer "*draft*")) ; Just for initial name.
- change-major-mode-hook)
+ (buffer (generate-new-buffer "*draft*"))) ; Just for initial name.
(set-buffer buffer)
;; switch-buffer according to draft buffer style.
(if wl-draft-use-frame
(funcall wl-draft-buffer-style buffer)
(error "Invalid value for wl-draft-buffer-style"))))))
(auto-save-mode -1)
- (wl-draft-mode)
+ (let (change-major-mode-hook)
+ (wl-draft-mode))
+ (set-buffer-multibyte t) ; draft buffer is always multibyte.
(make-local-variable 'truncate-partial-width-windows)
(setq truncate-partial-width-windows nil)
(setq truncate-lines wl-draft-truncate-lines)
(setq found t)))
(if (and found wl-draft-config-matchone)
(throw 'done t))
- (setq alist (cdr alist))))
- (if found
- (setq wl-draft-config-exec-flag nil))
- (run-hooks 'wl-draft-config-exec-hook)
- (put-text-property (point-min)(point-max) 'face nil)
- (wl-highlight-message (point-min)(point-max) t)
- (setq wl-draft-config-variables
- (elmo-uniq-list local-variables))))))
+ (setq alist (cdr alist)))))
+ (if found
+ (setq wl-draft-config-exec-flag nil))
+ (run-hooks 'wl-draft-config-exec-hook)
+ (put-text-property (point-min)(point-max) 'face nil)
+ (wl-highlight-message (point-min)(point-max) t)
+ (setq wl-draft-config-variables
+ (elmo-uniq-list local-variables)))))
(defun wl-draft-replace-field (field content &optional add)
(save-excursion
wl-user-agent-headers-and-body-alist 'ignore-case)))))
t))
+(defun wl-draft-setup-parent-flag (flag)
+ "Setup a FLAG for parent message."
+ (when (and (> (length wl-draft-parent-folder) 0)
+ wl-draft-parent-number)
+ (setq wl-draft-parent-flag flag)
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)))
+
(require 'product)
(product-provide (provide 'wl-draft) (require 'wl-version))