user mechanism server))
(defmacro wl-smtp-extension-bind (&rest body)
- (` (let* ((smtp-sasl-mechanisms
- (if wl-smtp-authenticate-type
- (mapcar 'upcase
- (if (listp wl-smtp-authenticate-type)
- wl-smtp-authenticate-type
- (list wl-smtp-authenticate-type)))))
- (smtp-use-sasl (and smtp-sasl-mechanisms t))
- (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
- (smtp-open-connection-function
- (if (eq wl-smtp-connection-type 'ssl)
- #'open-ssl-stream
- smtp-open-connection-function))
- smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
- (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)
- (elmo-get-passwd
- (wl-smtp-password-key
- smtp-sasl-user-name
- (car smtp-sasl-mechanisms)
- smtp-server)))))
- (,@ body))))
+ `(let* ((smtp-sasl-mechanisms
+ (if wl-smtp-authenticate-type
+ (mapcar 'upcase
+ (if (listp wl-smtp-authenticate-type)
+ wl-smtp-authenticate-type
+ (list wl-smtp-authenticate-type)))))
+ (smtp-use-sasl (and smtp-sasl-mechanisms t))
+ (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
+ (smtp-open-connection-function
+ (if (eq wl-smtp-connection-type 'ssl)
+ #'open-ssl-stream
+ smtp-open-connection-function))
+ smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
+ (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)
+ (elmo-get-passwd
+ (wl-smtp-password-key
+ smtp-sasl-user-name
+ (car smtp-sasl-mechanisms)
+ smtp-server)))))
+ ,@body))
(defun wl-draft-insert-date-field ()
"Insert Date field."
(lambda (condition)
(cond ((stringp condition)
(std11-field-body condition))
- ((symbolp condition)
+ ((functionp condition)
(funcall condition))
((consp condition)
(and (funcall condition-match-p (car condition))
result))
(defun wl-draft-reply (buf with-arg summary-buf &optional number)
- "Reply to BUF buffer message.
-Reply to author if WITH-ARG is non-nil."
+ "Create draft for replying to the message in buffer BUF.
+Recipients are prepared along `wl-draft-reply-without-argument-list',
+or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
;;;(save-excursion
(let ((rule-list (if with-arg
'wl-draft-reply-with-argument-list
(setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
(with-temp-buffer ; to keep raw buffer unibyte.
(set-buffer-multibyte default-enable-multibyte-characters)
- (setq newsgroups (wl-parse newsgroups
+ (setq newsgroups (elmo-parse newsgroups
"[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
newsgroups (wl-delete-duplicates newsgroups)
newsgroups
to (copy-sequence to))
t t))
(and to (setq to (mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr to-alist)) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr to-alist)) addr)
+ addr))
to ",\n\t")))
(and cc (setq cc (mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr cc-alist)) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr cc-alist)) addr)
+ addr))
cc ",\n\t")))
(and mail-followup-to
(setq mail-followup-to
(mapconcat
- '(lambda (addr)
- (if wl-draft-reply-use-address-with-full-name
- (or (cdr (assoc addr (append to-alist cc-alist))) addr)
- addr))
+ (lambda (addr)
+ (if wl-draft-reply-use-address-with-full-name
+ (or (cdr (assoc addr (append to-alist cc-alist))) addr)
+ addr))
mail-followup-to ",\n\t")))
(and (null to) (setq to cc cc nil))
(setq references (delq nil references)
(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)
+ (let* ((mes-id (with-current-buffer mail-reply-buffer
(std11-field-body "message-id")))
(field (or alt-field "In-Reply-To"))
(ref (std11-field-body field))
(defun wl-draft-delete (editing-buffer)
"Kill the editing draft buffer and delete the file corresponds to it."
- (save-excursion
- (when editing-buffer
- (set-buffer editing-buffer)
+ (when editing-buffer
+ (with-current-buffer editing-buffer
(when wl-draft-buffer-message-number
(elmo-folder-delete-messages (wl-draft-get-folder)
(list
;; function for wl-sent-message-via
(defmacro wl-draft-sent-message-p (type)
- (` (eq (nth 1 (assq (, type) wl-sent-message-via)) 'sent)))
+ `(eq (nth 1 (assq ,type wl-sent-message-via)) 'sent))
(defmacro wl-draft-set-sent-message (type result &optional server-port)
- (` (let ((element (assq (, type) wl-sent-message-via)))
- (if element
- (unless (eq (nth 1 element) (, result))
- (setcdr element (list (, result) (, server-port)))
- (setq wl-sent-message-modified t))
- (push (list (, type) (, result) (, server-port)) wl-sent-message-via)
- (setq wl-sent-message-modified t)))))
+ `(let ((element (assq ,type wl-sent-message-via)))
+ (if element
+ (unless (eq (nth 1 element) ,result)
+ (setcdr element (list ,result ,server-port))
+ (setq wl-sent-message-modified t))
+ (push (list ,type ,result ,server-port) wl-sent-message-via)
+ (setq wl-sent-message-modified t))))
(defun wl-draft-sent-message-results ()
(let ((results wl-sent-message-via)
(concat " to="
(mapconcat
'identity
- (mapcar '(lambda(x) (format "<%s>" x)) to)
+ (mapcar (lambda (x) (format "<%s>" x)) to)
","))))
""))
(id (if id (concat " id=" id) ""))
(newline))
(run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
(if mail-interactive
- (save-excursion
- (set-buffer errbuf)
+ (with-current-buffer errbuf
(erase-buffer)))
(wl-draft-delete-field "bcc" delimline)
(wl-draft-delete-field "resent-bcc" delimline)
nil t)
(when (string= "" (match-string 1))
(replace-match ""))))
-;;; (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.
(condition-case nil
(progn
(when wl-draft-send-confirm-with-preview
- (let (wl-draft-send-hook)
+ (let (wl-draft-send-hook
+ (pgg-decrypt-automatically nil))
(wl-draft-preview-message)))
(save-excursion
(goto-char (point-min)) ; to show recipients in header
"Send current draft message.
If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(interactive)
- ;; Don't call this explicitly.
- ;; Added to 'wl-draft-send-hook (by teranisi)
- ;; (wl-draft-config-exec)
+;;; Don't call this explicitly.
+;;; Added to 'wl-draft-send-hook (by teranisi)
+;;; (wl-draft-config-exec)
(run-hooks 'wl-draft-send-hook)
(when (or (not wl-interactive-send)
(wl-draft-send-confirm))
(wl-draft-verbose-msg nil)
err)
(unwind-protect
- (save-excursion
- (set-buffer sending-buffer)
+ (with-current-buffer sending-buffer
(if (and (not (wl-message-mail-p))
(not (wl-message-news-p)))
(error "No recipient is specified"))
;; 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))
+ (condition-case nil
+ (wl-folder-set-persistent-mark
+ parent-folder parent-number parent-flag)
+ (error
+ (message "Set mark (%s) failed" (symbol-name parent-flag)))))
(funcall wl-draft-send-function editing-buffer kill-when-done)
;; Now perform actions on successful sending.
(while mail-send-actions
"This is a blind carbon copy.")
"\n")
(mime-edit-insert-tag "message" "rfc822")
- (insert-buffer draft-buffer)
+ (insert-buffer-substring draft-buffer)
(let (wl-interactive-send)
(wl-draft-send 'kill-when-done))))))))
(defun wl-draft-do-fcc (header-end &optional fcc-list)
(let ((send-mail-buffer (current-buffer))
- (tembuf (generate-new-buffer " fcc output"))
(case-fold-search t)
beg end)
(or (markerp header-end) (error "HEADER-END must be a marker"))
- (save-excursion
- (unless fcc-list
- (setq fcc-list (wl-draft-get-fcc-list header-end)))
- (set-buffer tembuf)
- (erase-buffer)
+ (unless fcc-list
+ (setq fcc-list (wl-draft-get-fcc-list header-end)))
+ (with-temp-buffer
;; insert just the headers to avoid moving the gap more than
;; necessary (the message body could be arbitrarily huge.)
(insert-buffer-substring send-mail-buffer 1 header-end)
(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)))
+ (setq fcc-list (cdr fcc-list)))))))
(defun wl-draft-on-field-p ()
(if (< (point)
(defun wl-draft-create-buffer (&optional parent-folder parent-number)
(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
(or (eq this-command 'wl-summary-reply)
(eq this-command 'wl-summary-reply-with-citation)
(setq wl-draft-parent-folder (or parent-folder ""))
(setq wl-draft-parent-number parent-number)
(or (eq this-command 'wl-folder-write-current-folder)
- (setq wl-draft-buffer-cur-summary-buffer summary-buf))
+ (setq wl-draft-buffer-cur-summary-buffer
+ (wl-summary-get-buffer parent-folder)))
buffer))
(defun wl-draft-create-contents (header-alist)
field
nil)))
-(defsubst wl-draft-default-headers ()
+(defun wl-draft-default-headers ()
(list
(cons 'Mail-Reply-To (and wl-insert-mail-reply-to
(wl-address-header-extract-address
(defun wl-draft-generate-clone-buffer (name &optional local-variables)
"Generate clone of current buffer named NAME."
(let ((editing-buffer (current-buffer)))
- (save-excursion
- (set-buffer (generate-new-buffer name))
+ (with-current-buffer (generate-new-buffer name)
(erase-buffer)
(wl-draft-mode)
(wl-draft-editor-mode)
- (insert-buffer editing-buffer)
+ (insert-buffer-substring editing-buffer)
(message "")
(while local-variables
(make-local-variable (car local-variables))
(set (car local-variables)
- (save-excursion
- (set-buffer editing-buffer)
+ (with-current-buffer editing-buffer
(symbol-value (car local-variables))))
(setq local-variables (cdr local-variables)))
(current-buffer))))
"\\1"))
auto-save-file-name-transforms)))
(setq buffer-file-name (buffer-name)
- wl-draft-parent-folder ""
wl-draft-buffer-message-number number)
+ (unless wl-draft-parent-folder
+ (setq wl-draft-parent-folder ""))
(when wl-draft-write-file-function
(add-hook 'local-write-file-hooks wl-draft-write-file-function))
(wl-highlight-headers 'for-draft)
(goto-char (point-max))
buffer))
-(defmacro wl-draft-body-goto-top ()
- (` (progn
- (goto-char (point-min))
- (if (re-search-forward mail-header-separator nil t)
- (forward-char 1)
- (goto-char (point-max))))))
+(defun wl-draft-body-goto-top ()
+ (goto-char (point-min))
+ (if (re-search-forward mail-header-separator nil t)
+ (forward-char 1)
+ (goto-char (point-max))))
-(defmacro wl-draft-body-goto-bottom ()
- (` (goto-char (point-max))))
+(defun wl-draft-body-goto-bottom ()
+ (goto-char (point-max)))
-(defmacro wl-draft-config-body-goto-header ()
- (` (progn
- (goto-char (point-min))
- (if (re-search-forward mail-header-separator nil t)
- (beginning-of-line)
- (goto-char (point-max))))))
+(defun wl-draft-config-body-goto-header ()
+ (goto-char (point-min))
+ (if (re-search-forward mail-header-separator nil t)
+ (beginning-of-line)
+ (goto-char (point-max))))
(defsubst wl-draft-config-sub-eval-insert (content &optional newline)
(let (content-value)
((eq key 'reply)
(when (and
reply-buf
- (save-excursion
- (set-buffer reply-buf)
+ (with-current-buffer reply-buf
(save-restriction
(std11-narrow-to-header)
(goto-char (point-min))
(message "No draft message exist.")
(if (string-match (concat "^" wl-draft-folder "/") mybuf)
(setq msg (cadr (memq
- (string-to-int (substring mybuf (match-end 0)))
+ (string-to-number (substring mybuf (match-end 0)))
msgs))))
(or msg (setq msg (car msgs)))
(if (setq buf (get-buffer (format "%s/%d" wl-draft-folder msg)))
((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 .....))
+;;; ((looking-at wl-address-complete-header-regexp)
+;;; (setq history .....))
(t
nil)))
(eolp))
(goto-char (point-min))
(search-forward mail-header-separator)
(forward-line 1)
- (insert body-text))
+ (insert body-text)
+ (or (bolp) (insert "\n")))
;;;###autoload
(defun wl-user-agent-compose (&optional to subject other-headers continue
;; to be necessary to protect the values used w/in
(let ((wl-user-agent-headers-and-body-alist other-headers)
(wl-draft-use-frame (eq switch-function 'switch-to-buffer-other-frame))
- (wl-draft-buffer-style switch-function))
+ (wl-draft-buffer-style switch-function)
+ tem)
(if to
- (if (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
- 'ignore-case)
- (setcdr
- (wl-string-match-assoc "to" wl-user-agent-headers-and-body-alist
- 'ignore-case)
- to)
+ (if (setq tem (wl-string-match-assoc
+ "\\`to\\'"
+ wl-user-agent-headers-and-body-alist
+ 'ignore-case))
+ (setcdr tem to)
(setq wl-user-agent-headers-and-body-alist
(cons (cons "to" to)
wl-user-agent-headers-and-body-alist))))
(if subject
- (if (wl-string-match-assoc "subject"
- wl-user-agent-headers-and-body-alist
- 'ignore-case)
- (setcdr
- (wl-string-match-assoc "subject"
- wl-user-agent-headers-and-body-alist
- 'ignore-case)
- subject)
+ (if (setq tem (wl-string-match-assoc
+ "\\`subject\\'"
+ wl-user-agent-headers-and-body-alist
+ 'ignore-case))
+ (setcdr tem subject)
(setq wl-user-agent-headers-and-body-alist
(cons (cons "subject" subject)
wl-user-agent-headers-and-body-alist))))
;; highlight headers (from wl-draft in wl-draft.el)
(wl-highlight-headers 'for-draft)
;; insert body
- (if (wl-string-match-assoc "body" wl-user-agent-headers-and-body-alist
- 'ignore-case)
- (wl-user-agent-insert-body
- (cdr (wl-string-match-assoc
- "body"
- wl-user-agent-headers-and-body-alist 'ignore-case)))))
+ (let ((body (wl-string-match-assoc "\\`body\\'"
+ wl-user-agent-headers-and-body-alist
+ 'ignore-case)))
+ (if body
+ (wl-user-agent-insert-body (cdr body)))))
t))
(defun wl-draft-setup-parent-flag (flag)
projects / elisp / wanderlust.git / blobdiff