wl-smtp-authenticate-type
(list wl-smtp-authenticate-type)))))
(smtp-use-sasl (and smtp-sasl-mechanisms t))
- (smtp-use-starttls wl-smtp-connection-type)
+ (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
(if (and (string= (car smtp-sasl-mechanisms) "DIGEST-MD5")
;; sendmail bug?
(defun wl-draft-insert-x-face-field ()
"Insert X-Face header."
(interactive)
- (if (not (file-exists-p wl-x-face-file))
- (error "File %s does not exist" wl-x-face-file)
- (beginning-of-buffer)
- (search-forward mail-header-separator nil t)
- (beginning-of-line)
- (wl-draft-insert-x-face-field-here)
- (run-hooks 'wl-draft-insert-x-face-field-hook))) ; highlight it if you want.
+ (unless (file-exists-p wl-x-face-file)
+ (error "File %s does not exist" wl-x-face-file))
+ (beginning-of-buffer)
+ (search-forward mail-header-separator nil t)
+ (beginning-of-line)
+ (wl-draft-insert-x-face-field-here)
+ (run-hooks 'wl-draft-insert-x-face-field-hook)) ; highlight it if you want.
(defun wl-draft-insert-x-face-field-here ()
"Insert X-Face field at point."
(substring subject (match-end 0))
subject))
-(defun wl-draft-reply-list-symbol (from no-arg)
- "Check FROM and NO-ARG, return symbol `wl-draft-reply-*-argument-list'.
-Return symbol, not list. Use symbol-name"
- (if (wl-address-user-mail-address-p from)
- (if no-arg
- 'wl-draft-reply-myself-without-argument-list
- 'wl-draft-reply-myself-with-argument-list)
- (if no-arg
- 'wl-draft-reply-without-argument-list
- 'wl-draft-reply-with-argument-list)))
-
-(defun wl-draft-reply (buf no-arg summary-buf)
- ""
+(defun wl-draft-reply-list-symbol (with-arg)
+ "Return symbol `wl-draft-reply-*-argument-list' match condition.
+Check WITH-ARG and From: field."
+ (if (wl-address-user-mail-address-p (or (elmo-field-body "From") ""))
+ (if with-arg
+ 'wl-draft-reply-myself-with-argument-list
+ 'wl-draft-reply-myself-without-argument-list)
+ (if with-arg
+ 'wl-draft-reply-with-argument-list
+ 'wl-draft-reply-without-argument-list)))
+
+(defun wl-draft-reply (buf with-arg summary-buf)
+ "Reply to BUF buffer message.
+Reply to author if WITH-ARG is non-nil."
;;;(save-excursion
(let (r-list
- (mime-header-lexical-analyzer '(eword-analyze-quoted-string
- eword-analyze-domain-literal
- eword-analyze-comment
- eword-analyze-spaces
- eword-analyze-special
- eword-analyze-encoded-word
- eword-analyze-atom))
- eword-lexical-analyzer
to mail-followup-to cc subject in-reply-to references newsgroups
- from to-alist cc-alist r-list-name)
- (setq eword-lexical-analyzer mime-header-lexical-analyzer)
+ from to-alist cc-alist decoder)
(set-buffer buf)
- (setq from (wl-address-header-extract-address (std11-field-body "From")))
- ;; symbol-name use in error message
- (setq r-list-name (symbol-name (wl-draft-reply-list-symbol from no-arg)))
- (setq r-list (symbol-value (wl-draft-reply-list-symbol from no-arg)))
+ (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
(catch 'done
(while r-list
(when (let ((condition (car (car r-list))))
",")))
(throw 'done nil))
(setq r-list (cdr r-list)))
- (error "No match field: check your `%s'" r-list-name))
+ (error "No match field: check your `%s'"
+ (symbol-name (wl-draft-reply-list-symbol with-arg))))
(setq subject (std11-field-body "Subject"))
(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)
- (setq subject (or (and subject
- (eword-decode-string
- (decode-mime-charset-string
- subject
- wl-mime-charset)))))
+ (setq decoder (mime-find-field-decoder 'Subject 'plain))
+ (setq subject (if (and subject decoder)
+ (funcall decoder subject) subject))
(setq to-alist
(mapcar
- '(lambda (addr)
- (setq addr (eword-extract-address-components addr))
- (cons (nth 1 addr)
- (if (nth 0 addr)
- (concat
- (wl-address-quote-specials (nth 0 addr))
- " <" (nth 1 addr) ">")
- (nth 1 addr))))
+ (lambda (addr)
+ (setq decoder (mime-find-field-decoder 'To 'plain))
+ (cons (nth 1 (std11-extract-address-components addr))
+ (if decoder (funcall decoder addr) addr)))
to))
(setq cc-alist
(mapcar
- '(lambda (addr)
- (setq addr (eword-extract-address-components addr))
- (cons (nth 1 addr)
- (if (nth 0 addr)
- (concat
- (wl-address-quote-specials (nth 0 addr))
- " <" (nth 1 addr) ">")
- (nth 1 addr))))
+ (lambda (addr)
+ (setq decoder (mime-find-field-decoder 'Cc 'plain))
+ (cons (nth 1 (std11-extract-address-components addr))
+ (if decoder (funcall decoder addr) addr)))
cc)))
- (and subject wl-reply-subject-prefix
+ (and wl-reply-subject-prefix
(setq subject (concat wl-reply-subject-prefix
- (wl-draft-strip-subject-re subject))))
+ (wl-draft-strip-subject-re
+ (or subject "")))))
(setq in-reply-to (std11-field-body "Message-Id"))
(setq references (nconc
(std11-field-bodies '("References" "In-Reply-To"))
;; and myself is contained in cc,
;; delete myself from cc.
(setq cc (wl-draft-delete-myself-from-cc to cc))
- (if wl-insert-mail-followup-to
- (progn
- (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))))
+ (when wl-insert-mail-followup-to
+ (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)
(defun wl-draft-confirm ()
"Confirm send message."
(interactive)
- (y-or-n-p (format "Send current draft as %s? "
- (cond ((and (wl-message-mail-p) (wl-message-news-p))
- "Mail and News")
- ((wl-message-mail-p) "Mail")
- ((wl-message-news-p) "News")))))
-
-(defun wl-message-news-p ()
- "If exist valid Newsgroups field, return non-nil."
- (std11-field-body "Newsgroups"))
+ (y-or-n-p
+ (cond ((and (wl-message-mail-p) (wl-message-news-p))
+ "Send current draft as Mail and News? ")
+ ((wl-message-mail-p) "Send current draft as Mail? ")
+ ((wl-message-news-p) "Send current draft as News? "))))
(defun wl-message-field-exists-p (field)
"If FIELD exist and FIELD value is not empty, return non-nil."
(and value
(not (string= value "")))))
+(defun wl-message-news-p ()
+ "If exist valid Newsgroups field, return non-nil."
+ (std11-field-body "Newsgroups"))
+
(defun wl-message-mail-p ()
"If exist To, Cc or Bcc field, return non-nil."
(or (wl-message-field-exists-p "To")
+ (wl-message-field-exists-p "Resent-to")
(wl-message-field-exists-p "Cc")
(wl-message-field-exists-p "Bcc")
;;; This may be needed..
(let ((cur-buf (current-buffer))
(tmp-buf (get-buffer-create " *wl-draft-edit-string*"))
to subject in-reply-to cc references newsgroups mail-followup-to
- content-type content-transfer-encoding
- body-beg buffer-read-only
- )
+ content-type content-transfer-encoding from
+ body-beg buffer-read-only)
(set-buffer tmp-buf)
(erase-buffer)
(insert string)
(decode-mime-charset-string
subject
wl-mime-charset))))
+ (setq from (std11-field-body "From")
+ from (and from
+ (eword-decode-string
+ (decode-mime-charset-string
+ from
+ wl-mime-charset))))
(setq in-reply-to (std11-field-body "In-Reply-To"))
(setq cc (std11-field-body "Cc"))
(setq cc (and cc
mail-followup-to
content-type content-transfer-encoding
(buffer-substring (point) (point-max))
- 'edit-again
- ))
+ 'edit-again nil
+ (if (member (nth 1 (std11-extract-address-components from))
+ wl-user-mail-address-list)
+ from)))
(and to (mail-position-on-field "To"))
(delete-other-windows)
(kill-buffer tmp-buf)))
(let ((mail-reply-buffer (wl-message-get-original-buffer))
mail-citation-hook mail-yank-hooks
wl-draft-add-references wl-draft-cite-func)
- (if (eq 0
- (save-excursion
- (set-buffer mail-reply-buffer)
- (buffer-size)))
+ (if (zerop
+ (with-current-buffer mail-reply-buffer
+ (buffer-size)))
(error "No current message")
(wl-draft-yank-from-mail-reply-buffer nil
wl-ignored-forwarded-headers))))
(let ((msg (and wl-draft-buffer-file-name
(string-match "[0-9]+$" wl-draft-buffer-file-name)
(string-to-int
- (elmo-match-string 0 wl-draft-buffer-file-name)))))
+ (match-string 0 wl-draft-buffer-file-name)))))
(wl-draft-config-info-operation msg 'delete))))
(set-buffer-modified-p nil) ; force kill
(kill-buffer editing-buffer))))
(message "")))
(defun wl-draft-fcc ()
- "Add a new FCC field, with file name completion."
+ "Add a new Fcc field, with file name completion."
(interactive)
- (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
+ (or (mail-position-on-field "fcc" t) ;Put new field after exiting Fcc.
(mail-position-on-field "to"))
- (insert "\nFCC: "))
+ (insert "\nFcc: "))
;; function for wl-sent-message-via
(defun wl-draft-parse-msg-id-list-string (string)
"Get msg-id list from STRING."
- (let ((parsed (std11-parse-msg-ids-string string))
- tokens msg-id msg-id-list)
- (while parsed
- (setq msg-id nil)
- (when (eq (car (car parsed)) 'msg-id)
- (setq tokens (cdr (car parsed)))
- (while tokens
- (if (or (eq (car (car tokens)) 'atom)
- (eq (car (car tokens)) 'specials))
- (setq msg-id (concat msg-id (cdr (car tokens)))))
- (setq tokens (cdr tokens))))
- (if msg-id (setq msg-id-list (cons (concat "<" msg-id ">")
- msg-id-list)))
- (setq parsed (cdr parsed)))
+ (let (msg-id-list)
+ (dolist (parsed-id (std11-parse-msg-ids-string string))
+ (when (eq (car parsed-id) 'msg-id)
+ (setq msg-id-list (cons (std11-msg-id-string parsed-id)
+ msg-id-list))))
(nreverse msg-id-list)))
(defun wl-draft-parse-mailbox-list (field &optional remove-group-list)
(if (and sent-via wl-draft-fcc-list)
(progn
(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"))
- (elmo-enable-disconnected-operation t))
- (elmo-cache-save id nil nil nil))))
+ (setq wl-draft-fcc-list nil)))
+ (if wl-draft-use-cache
+ (let ((id (std11-field-body "Message-ID"))
+ (elmo-enable-disconnected-operation t))
+ (elmo-cache-save id nil nil nil)))
;; If one unplugged, append queue.
(when (and unplugged-via
wl-sent-message-modified)
(wl-draft-config-info-operation
(and (string-match "[0-9]+$" wl-draft-buffer-file-name)
(string-to-int
- (elmo-match-string 0 wl-draft-buffer-file-name)))
+ (match-string 0 wl-draft-buffer-file-name)))
'save))
(defun wl-draft-mimic-kill-buffer ()
(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)
+ (while (re-search-forward "^Fcc:[ \t]*" header-end t)
(setq fcc-list
(cons (buffer-substring-no-properties
(point)
nil
(if (re-search-forward ":" pos t) nil t)))))))
-(defun wl-draft-random-alphabet ()
- (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)
+ body edit-again summary-buf from)
"Write and send mail/news message with Wanderlust."
(interactive)
(unless (featurep 'wl)
(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-newsgroup))
+ (eq this-command 'wl-summary-write-current-folder))
(delete-other-windows))
(auto-save-mode -1)
(wl-draft-mode)
(setq wl-sent-message-via nil)
- (if (stringp wl-from)
- (insert "From: " wl-from "\n"))
+ (if (stringp (or from wl-from))
+ (insert "From: " (or from wl-from) "\n"))
(and (or (interactive-p)
(eq this-command 'wl-summary-write)
to)
(setq wl-draft-buffer-file-name file-name)
(if mail-default-reply-to
(insert "Reply-To: " mail-default-reply-to "\n"))
- (if (or wl-bcc mail-self-blind)
- (insert "Bcc: " (or wl-bcc (user-login-name)) "\n"))
- (if wl-fcc
- (insert "FCC: " (if (functionp wl-fcc) (funcall wl-fcc) wl-fcc) "\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
(when content-type
(insert "Content-type: " content-type "\n"))
(when content-transfer-encoding
- (insert "Content-Transfer-encoding: " content-transfer-encoding "\n"))
+ (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
(if (or content-type content-transfer-encoding)
(insert "\n"))
(and body (insert body))
(1- (point)))
'category 'mail-header-separator)
(and body (insert body)))
- (if wl-on-nemacs
- (push-mark (point) t)
- (push-mark (point) t t))
(as-binary-output-file
(write-region (point-min)(point-max) wl-draft-buffer-file-name
nil t))
wl-summary-buffer-name)))
buf-name))
+(defsubst wl-draft-insert-ccs (str cc)
+ (let ((field
+ (if (functionp cc)
+ (funcall cc)
+ cc)))
+ (if (and field
+ (null (and wl-draft-delete-myself-from-bcc-fcc
+ (elmo-list-member
+ (mapcar 'wl-address-header-extract-address
+ (append
+ (wl-parse-addresses (std11-field-body "To"))
+ (wl-parse-addresses (std11-field-body "Cc"))))
+ (mapcar 'downcase wl-subscribed-mailing-list)))))
+ (insert str field "\n"))))
+
(defun wl-draft-elmo-nntp-send ()
(let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook)
(elmo-default-nntp-user
(goto-char (point-min))
(or (re-search-forward "\n\n" nil t)
(search-forward (concat mail-header-separator "\n") nil t))
- (if wl-on-nemacs
- (push-mark (point) t)
- (push-mark (point) t t))
(write-region (point-min)(point-max) wl-draft-buffer-file-name
nil t)
(wl-draft-overload-functions)
projects / elisp / wanderlust.git / blobdiff