(defvar mail-from-style)
(eval-when-compile
+ (require 'static)
(require 'elmo-pop3)
(defalias-maybe 'x-face-insert 'ignore)
(defalias-maybe 'x-face-insert-version-header 'ignore)
(eval-and-compile
(autoload 'wl-addrmgr "wl-addrmgr"))
-(defvar wl-draft-buf-name "Draft")
-(defvar wl-draft-buffer-file-name nil)
+(autoload 'open-ssl-stream "ssl")
+
+(defvar wl-draft-buffer-message-number nil)
(defvar wl-draft-field-completion-list nil)
(defvar wl-draft-verbose-send t)
(defvar wl-draft-verbose-msg nil)
(template . wl-draft-config-sub-template)
(x-face . wl-draft-config-sub-x-face)))
-(make-variable-buffer-local 'wl-draft-buffer-file-name)
+(make-variable-buffer-local 'wl-draft-buffer-message-number)
(make-variable-buffer-local 'wl-draft-buffer-cur-summary-buffer)
(make-variable-buffer-local 'wl-draft-config-variables)
(make-variable-buffer-local 'wl-draft-config-exec-flag)
(make-variable-buffer-local 'wl-draft-parent-folder)
(make-variable-buffer-local 'wl-draft-parent-number)
+(defvar wl-draft-folder-internal nil
+ "Internal variable for caching `opened' draft folder.")
+
(defsubst wl-smtp-password-key (user mechanism server)
(format "SMTP:%s/%s@%s"
user mechanism server))
(list wl-smtp-authenticate-type)))))
(smtp-use-sasl (and smtp-sasl-mechanisms t))
(smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
+ (smtp-open-connection-function
+ (if (eq wl-smtp-connection-type 'ssl)
+ #'open-ssl-stream
+ smtp-open-connection-function))
+ (smtp-end-of-line
+ (if (eq wl-smtp-connection-type 'ssl)
+ "\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?
(wl-folder-get-entity-with-petname)
wl-folder-entity-hashtb)
nil nil wl-default-spec
- 'wl-read-folder-hist))
+ 'wl-read-folder-history))
(number (call-interactively
(function (lambda (num)
(interactive "nNumber: ")
(defun wl-draft-hide (editing-buffer)
"Hide the editing draft buffer if possible."
(when (and editing-buffer
- (buffer-live-p editing-buffer))
- (set-buffer editing-buffer)
+ (buffer-live-p editing-buffer)
+ (get-buffer-window editing-buffer))
+ (select-window (get-buffer-window editing-buffer))
(let ((sum-buf wl-draft-buffer-cur-summary-buffer)
fld-buf sum-win fld-win)
(if (and wl-draft-use-frame
(save-excursion
(when editing-buffer
(set-buffer editing-buffer)
- (if wl-draft-buffer-file-name
- (progn
- (if (file-exists-p wl-draft-buffer-file-name)
- (delete-file wl-draft-buffer-file-name))
- (let ((msg (and wl-draft-buffer-file-name
- (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))))
- (wl-draft-config-info-operation msg 'delete))))
+ (when wl-draft-buffer-message-number
+ (elmo-folder-delete-messages (wl-draft-get-folder)
+ (list
+ wl-draft-buffer-message-number))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number
+ 'delete))
(set-buffer-modified-p nil) ; force kill
(kill-buffer editing-buffer))))
(when (and (or (eq major-mode 'wl-draft-mode)
(eq major-mode 'mail-mode))
(or force-kill
- (y-or-n-p "Kill Current Draft? ")))
+ (yes-or-no-p "Kill Current Draft? ")))
(let ((cur-buf (current-buffer)))
(when (and wl-draft-parent-number
(not (string= wl-draft-parent-folder "")))
(string= (wl-summary-buffer-folder-name)
folder-name)))
(with-current-buffer buffer
- (elmo-folder-unmark-answered folder (list number))
- (wl-summary-jump-to-msg number)
- (wl-summary-update-mark number))
+ (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-unmark-answered folder (list number))
+ (elmo-folder-unset-flag folder (list number) 'answered)
(elmo-folder-close folder))))
(wl-draft-hide cur-buf)
(wl-draft-delete cur-buf)))
(defun wl-draft-send-mail-with-pop-before-smtp ()
"Send the prepared message buffer with POP-before-SMTP."
(require 'elmo-pop3)
- (let ((session
+ (let ((folder
(luna-make-entity
'elmo-pop3-folder
:user (or wl-pop-before-smtp-user
elmo-pop3-default-port)
:auth (or wl-pop-before-smtp-authenticate-type
elmo-pop3-default-authenticate-type)
- :stream-type (or wl-pop-before-smtp-stream-type
- elmo-pop3-default-stream-type))))
+ :stream-type (elmo-get-network-stream-type
+ (or wl-pop-before-smtp-stream-type
+ elmo-pop3-default-stream-type))))
+ session)
(condition-case error
(progn
- (elmo-pop3-get-session session)
+ (setq session (elmo-pop3-get-session folder))
(when session (elmo-network-close-session session)))
(error
- (elmo-network-close-session session)
(unless (string= (nth 1 error) "Unplugged")
- (signal (car error)(cdr error))))))
+ (signal (car error) (cdr error))))))
(wl-draft-send-mail-with-smtp))
(defun wl-draft-insert-required-fields (&optional force-msgid)
(goto-char (point-min)) ; to show recipients in header
(catch 'done
(while t
+ (discard-input)
(message "Send current draft? <y/n/j(down)/k(up)> ")
(setq answer (let ((cursor-in-echo-area t)) (read-char)))
(cond
(let (wl-interactive-send)
(wl-draft-send 'kill-when-done))))))))
-;; Derived from `message-save-drafts' in T-gnus.
(defun wl-draft-save ()
"Save current draft."
(interactive)
(if (buffer-modified-p)
(progn
- (message "Saving %s..." wl-draft-buffer-file-name)
- (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
- (with-temp-file wl-draft-buffer-file-name
+ (message "Saving...")
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max)))
+ next-number)
+ (when wl-draft-buffer-message-number
+ (elmo-folder-delete-messages (wl-draft-get-folder)
+ (list wl-draft-buffer-message-number))
+ (wl-draft-config-info-operation wl-draft-buffer-message-number
+ 'delete))
+ (elmo-folder-check (wl-draft-get-folder))
+ ;; If no header separator, insert it.
+ (with-temp-buffer
(insert msg)
- ;; If no header separator, insert it.
- (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
(goto-char (point-min))
- (unless (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (goto-char (point-min))
- (if (re-search-forward "\n\n" nil t)
- (replace-match (concat "\n" mail-header-separator "\n"))
- (goto-char (point-max))
- (insert (if (eq (char-before) ?\n) "" "\n")
- mail-header-separator "\n"))))
+ (if (re-search-forward "\n\n" nil t)
+ (replace-match (concat "\n" mail-header-separator "\n"))
+ (goto-char (point-max))
+ (insert (if (eq (char-before) ?\n) "" "\n")
+ mail-header-separator "\n")))
(let ((mime-header-encode-method-alist
'((eword-encode-unstructured-field-body))))
(mime-edit-translate-buffer))
- (wl-draft-get-header-delimiter t)))
- (set-buffer-modified-p nil)
- (wl-draft-config-info-operation
- (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
- (string-to-int
- (match-string 0 wl-draft-buffer-file-name)))
- 'save)
- (message "Saving %s...done" wl-draft-buffer-file-name))
+ (wl-draft-get-header-delimiter t)
+ (setq next-number
+ (elmo-folder-next-message-number (wl-draft-get-folder)))
+ (elmo-folder-append-buffer (wl-draft-get-folder)))
+ (elmo-folder-check (wl-draft-get-folder))
+ (elmo-folder-commit (wl-draft-get-folder))
+ (setq wl-draft-buffer-message-number next-number)
+ (rename-buffer (format "%s/%d" wl-draft-folder next-number))
+ (setq buffer-file-name (buffer-name))
+ (set-buffer-modified-p nil)
+ (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
+ (message "Saving...done")))
(message "(No changes need to be saved)")))
(defun wl-draft-mimic-kill-buffer ()
(progn (forward-line 1) (point)))))
fcc-list)))
+(defcustom wl-draft-fcc-append-read-folder-history t
+ "Non-nil to append fcc'ed folder to `wl-read-folder-history'."
+ :type 'boolean
+ :group 'wl-draft)
+
(defun wl-draft-do-fcc (header-end &optional fcc-list)
(let ((send-mail-buffer (current-buffer))
(tembuf (generate-new-buffer " fcc output"))
(if (elmo-folder-append-buffer
(wl-folder-get-elmo-folder
(eword-decode-string (car fcc-list)))
- (and wl-fcc-force-as-read 'read))
+ (and wl-fcc-force-as-read '(read)))
(wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id)
(wl-draft-write-sendlog 'failed 'fcc nil (car fcc-list) id))
+ (if (and wl-draft-fcc-append-read-folder-history
+ (boundp 'wl-read-folder-history))
+ (or (equal (car fcc-list) (car wl-read-folder-history))
+ (setq wl-read-folder-history
+ (append (list (car fcc-list)) wl-read-folder-history))))
(setq fcc-list (cdr fcc-list)))))
(kill-buffer tembuf)))
(wl-init)) ; returns immediately if already initialized.
- (let (buf-name header-alist-internal)
- (setq buf-name
- (wl-draft-create-buffer parent-folder))
-
+ (let (buffer header-alist-internal)
+ (setq buffer (wl-draft-create-buffer parent-folder))
(unless (cdr (assq 'From header-alist))
(setq header-alist
(append (list (cons 'From wl-from)) header-alist)))
(if (interactive-p)
(run-hooks 'wl-mail-setup-hook))
(goto-char (point-min))
+ (setq buffer-undo-list nil)
(wl-user-agent-compose-internal) ;; user-agent
(cond ((and
(interactive-p)
(mail-position-on-field "To"))
(t
(goto-char (point-max))))
- buf-name))
+ buffer))
(defun wl-draft-create-buffer (&optional parent-folder)
- (let* ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+ (let* ((draft-folder (wl-draft-get-folder))
(parent-folder (or parent-folder (wl-summary-buffer-folder-name)))
(summary-buf (wl-summary-get-buffer parent-folder))
(reply-or-forward
(eq this-command 'wl-summary-forward)
(eq this-command 'wl-summary-target-mark-forward)
(eq this-command 'wl-summary-target-mark-reply-with-citation)))
- buf-name file-name num change-major-mode-hook)
- (if (not (elmo-folder-message-file-p draft-folder))
- (error "%s folder cannot be used for draft folder" wl-draft-folder))
- (setq num (elmo-max-of-list
- (or (elmo-folder-list-messages draft-folder) '(0))))
- (setq num (+ 1 num))
- ;; To get unused buffer name.
- (while (get-buffer (concat wl-draft-folder "/" (int-to-string num)))
- (setq num (+ 1 num)))
- (setq buf-name (find-file-noselect
- (setq file-name
- (elmo-message-file-name
- (wl-folder-get-elmo-folder wl-draft-folder)
- num))))
+ (buffer (generate-new-buffer "*draft*")) ; Just for initial name.
+ change-major-mode-hook)
+ (set-buffer buffer)
;; switch-buffer according to draft buffer style.
(if wl-draft-use-frame
- (switch-to-buffer-other-frame buf-name)
+ (switch-to-buffer-other-frame buffer)
(if reply-or-forward
(case wl-draft-reply-buffer-style
(split
(split-window-vertically)
(other-window 1)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(keep
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(full
(delete-other-windows)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(t
(if (functionp wl-draft-reply-buffer-style)
- (funcall wl-draft-reply-buffer-style buf-name)
+ (funcall wl-draft-reply-buffer-style buffer)
(error "Invalid value for wl-draft-reply-buffer-style"))))
(case wl-draft-buffer-style
(split
(wl-summary-toggle-disp-msg 'off))
(split-window-vertically)
(other-window 1)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(keep
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(full
(delete-other-windows)
- (switch-to-buffer buf-name))
+ (switch-to-buffer buffer))
(t (if (functionp wl-draft-buffer-style)
- (funcall wl-draft-buffer-style buf-name)
+ (funcall wl-draft-buffer-style buffer)
(error "Invalid value for wl-draft-buffer-style"))))))
- (set-buffer buf-name)
- (if (not (string-match (regexp-quote wl-draft-folder)
- (buffer-name)))
- (rename-buffer (concat wl-draft-folder "/" (int-to-string num))))
(auto-save-mode -1)
(wl-draft-mode)
(make-local-variable 'truncate-partial-width-windows)
(setq truncate-lines wl-draft-truncate-lines)
(setq wl-sent-message-via nil)
(setq wl-sent-message-queued nil)
- (setq wl-draft-buffer-file-name file-name)
(setq wl-draft-config-exec-flag t)
(setq wl-draft-parent-folder (or parent-folder ""))
(or (eq this-command 'wl-folder-write-current-folder)
(setq wl-draft-buffer-cur-summary-buffer summary-buf))
- buf-name))
+ buffer))
(defun wl-draft-create-contents (header-alist)
"header-alist' sample
(error "`wl-draft-create-header' must be use in wl-draft-mode"))
(let (change-major-mode-hook)
(wl-draft-editor-mode)
+ (static-when (boundp 'auto-save-file-name-transforms)
+ (make-local-variable 'auto-save-file-name-transforms)
+ (setq auto-save-file-name-transforms
+ (cons (list (concat (regexp-quote wl-draft-folder)
+ "/\\([0-9]+\\)")
+ (concat (expand-file-name
+ "auto-save-"
+ (elmo-folder-msgdb-path
+ (wl-draft-get-folder)))
+ "\\1"))
+ auto-save-file-name-transforms)))
(when wl-draft-write-file-function
(add-hook 'local-write-file-hooks wl-draft-write-file-function))
(wl-draft-overload-functions)
(delete-region (point-at-bol)(1+ (point-at-eol)))))
(defun wl-draft-reedit (number)
- (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+ (let ((draft-folder (wl-draft-get-folder))
(wl-draft-reedit t)
- buffer file-name change-major-mode-hook body-top)
- (setq file-name (elmo-message-file-name draft-folder number))
- (unless (file-exists-p file-name)
- (error "File %s does not exist" file-name))
- (if (setq buffer (get-buffer
- (concat wl-draft-folder "/"
- (number-to-string number))))
- (progn
- (if wl-draft-use-frame
- (switch-to-buffer-other-frame buffer)
- (switch-to-buffer buffer))
- (set-buffer buffer))
- (setq buffer (get-buffer-create (number-to-string number)))
- ;; switch-buffer according to draft buffer style.
- (if wl-draft-use-frame
- (switch-to-buffer-other-frame buffer)
- (case wl-draft-buffer-style
- (split
- (split-window-vertically)
- (other-window 1)
- (switch-to-buffer buffer))
- (keep
- (switch-to-buffer buffer))
- (full
- (delete-other-windows)
- (switch-to-buffer buffer))
- (t (if (functionp wl-draft-buffer-style)
- (funcall wl-draft-buffer-style buffer)
- (error "Invalid value for wl-draft-buffer-style")))))
- (set-buffer buffer)
- (setq wl-draft-parent-folder "")
- (insert-file-contents-as-binary file-name)
- (elmo-delete-cr-buffer)
- (let((mime-edit-again-ignored-field-regexp
- "^\\(Content-.*\\|Mime-Version\\):"))
- (wl-draft-decode-message-in-buffer))
- (setq body-top (wl-draft-insert-mail-header-separator))
- (if (not (string-match (regexp-quote wl-draft-folder)
- (buffer-name)))
- (rename-buffer (concat wl-draft-folder "/" (buffer-name))))
- (auto-save-mode -1)
- (wl-draft-mode)
- (setq buffer-file-name file-name)
- (make-local-variable 'truncate-partial-width-windows)
- (setq truncate-partial-width-windows nil)
- (setq truncate-lines wl-draft-truncate-lines)
- (setq wl-sent-message-via nil)
- (setq wl-sent-message-queued nil)
- (setq wl-draft-buffer-file-name file-name)
- (wl-draft-config-info-operation number 'load)
- (goto-char (point-min))
- (wl-draft-overload-functions)
- (wl-draft-editor-mode)
- (when wl-draft-write-file-function
- (add-hook 'local-write-file-hooks wl-draft-write-file-function))
- (wl-highlight-headers 'for-draft)
- (goto-char body-top)
- (run-hooks 'wl-draft-reedit-hook)
- (goto-char (point-max))
- buffer)))
+ (num 0)
+ buffer change-major-mode-hook body-top)
+ (setq buffer (get-buffer-create (format "%s/%d" wl-draft-folder
+ number)))
+ (if wl-draft-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ (set-buffer buffer)
+ (elmo-message-fetch draft-folder number (elmo-make-fetch-strategy 'entire)
+ nil (current-buffer))
+ (elmo-delete-cr-buffer)
+ (let ((mime-edit-again-ignored-field-regexp
+ "^\\(Content-.*\\|Mime-Version\\):"))
+ (wl-draft-decode-message-in-buffer))
+ (setq body-top (wl-draft-insert-mail-header-separator))
+ (auto-save-mode -1)
+ (wl-draft-mode)
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows nil)
+ (setq truncate-lines wl-draft-truncate-lines)
+ (setq wl-sent-message-via nil)
+ (setq wl-sent-message-queued nil)
+ (wl-draft-config-info-operation number 'load)
+ (goto-char (point-min))
+ (wl-draft-overload-functions)
+ (wl-draft-editor-mode)
+ (static-when (boundp 'auto-save-file-name-transforms)
+ (make-local-variable 'auto-save-file-name-transforms)
+ (setq auto-save-file-name-transforms
+ (cons (list (concat (regexp-quote wl-draft-folder)
+ "/\\([0-9]+\\)")
+ (concat (expand-file-name
+ "auto-save-"
+ (elmo-folder-msgdb-path
+ (wl-draft-get-folder)))
+ "\\1"))
+ auto-save-file-name-transforms)))
+ (setq buffer-file-name (buffer-name)
+ wl-draft-parent-folder ""
+ wl-draft-buffer-message-number number)
+ (when wl-draft-write-file-function
+ (add-hook 'local-write-file-hooks wl-draft-write-file-function))
+ (wl-highlight-headers 'for-draft)
+ (goto-char body-top)
+ (run-hooks 'wl-draft-reedit-hook)
+ (goto-char (point-max))
+ buffer))
(defmacro wl-draft-body-goto-top ()
(` (progn
(insert (concat field ": " content "\n"))))))))
(defun wl-draft-config-info-operation (msg operation)
- (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-folder-get-elmo-folder
- wl-draft-folder)))
+ (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-draft-get-folder)))
(filename
(expand-file-name
(format "%s-%d" wl-draft-config-save-filename msg)
(switch-to-buffer buf))))))
(defun wl-jump-to-draft-folder ()
- (let ((msgs (reverse (elmo-folder-list-messages (wl-folder-get-elmo-folder
- wl-draft-folder))))
+ (let ((msgs (reverse (elmo-folder-list-messages (wl-draft-get-folder))))
(mybuf (buffer-name))
msg buf)
(if (not msgs)
(put-text-property (point-min) (point-max) 'face nil)
(wl-highlight-message (point-min) (point-max) t))
(set-buffer-modified-p modified))))
+ (static-when (featurep 'xemacs)
+ ;; Cope with one of many XEmacs bugs that `recenter' takes
+ ;; a long time if there are a lot of invisible text lines.
+ (redraw-frame))
(recenter n))
+;; insert element from history
+(defvar wl-draft-current-history-position nil)
+(defvar wl-draft-history-backup-word "")
+
+(defun wl-draft-previous-history-element (n)
+ (interactive "p")
+ (let (bol history beg end prev new)
+ (when (and (not (wl-draft-on-field-p))
+ (< (point)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n") nil 0)
+ (point)))
+ (save-excursion
+ (beginning-of-line)
+ (while (and (looking-at "^[ \t]")
+ (not (= (point) (point-min))))
+ (forward-line -1))
+ (cond
+ ((looking-at wl-folder-complete-header-regexp)
+ (and (boundp 'wl-read-folder-history)
+ (setq history wl-read-folder-history)))
+ ;; ((looking-at wl-address-complete-header-regexp)
+ ;; (setq history .....))
+ (t
+ nil)))
+ (eolp))
+ (setq bol (save-excursion (beginning-of-line) (point)))
+ (cond ((and (or (eq last-command 'wl-draft-previous-history-element)
+ (eq last-command 'wl-draft-next-history-element))
+ wl-draft-current-history-position)
+ (setq end (point))
+ (or (search-backward-regexp ",[ \t]*\\(.*\\)" bol t)
+ (search-backward-regexp "^[ \t]\\(.*\\)" bol t)
+ (search-backward-regexp "^[^ \t]*: \\(.*\\)" bol t))
+ (setq prev (match-string 1))
+ (goto-char (match-beginning 1))
+ (setq beg (point))
+ (if (cond ((< n 0)
+ (>= (+ n wl-draft-current-history-position) 0))
+ ((> n 0)
+ (<= (+ n wl-draft-current-history-position)
+ (length history))))
+ (progn
+ (setq wl-draft-current-history-position
+ (+ n wl-draft-current-history-position))
+ (setq new
+ (nth wl-draft-current-history-position
+ (append (list wl-draft-history-backup-word)
+ history)))
+ (delete-region beg end)
+ (insert new))
+ (goto-char end)
+ (cond ((< n 0)
+ (message "End of history; no next item"))
+ ((> n 0)
+ (message "Beginning of history; no preceding item")))))
+ ((and (> n 0)
+ (save-excursion
+ (or (search-backward-regexp ",[ \t]*\\(.*\\)" bol t)
+ (search-backward-regexp "^[ \t]\\(.*\\)" bol t)
+ (search-backward-regexp "^[^ \t]*: \\(.*\\)" bol t)))
+ (car history))
+ (setq wl-draft-current-history-position 1)
+ (setq wl-draft-history-backup-word (match-string 1))
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (car history)))
+ (t
+ (setq wl-draft-current-history-position nil))))))
+
+(defun wl-draft-next-history-element (n)
+ (interactive "p")
+ (wl-draft-previous-history-element (- n)))
+
;;;; user-agent support by Sen Nagata
;; this appears to be necessarily global...
projects / elisp / wanderlust.git / blobdiff