-;;; notmuch-mua.el --- emacs style mail-user-agent
+;;; notmuch-mua.el --- emacs style mail-user-agent -*- lexical-binding: t -*-
;;
;; Copyright © David Edmondson
;;
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
(require 'message)
+(require 'gmm-utils)
(require 'mm-view)
(require 'format-spec)
(declare-function notmuch-draft-postpone "notmuch-draft" ())
(declare-function notmuch-draft-save "notmuch-draft" ())
-;;
+(defvar notmuch-show-indent-multipart)
+(defvar notmuch-show-insert-header-p-function)
+(defvar notmuch-show-max-text-part-size)
+(defvar notmuch-show-insert-text/plain-hook)
+
+;;; Options
(defcustom notmuch-mua-send-hook nil
"Hook run before sending messages."
:group 'notmuch-send)
(defcustom notmuch-mua-hidden-headers nil
- "Headers that are added to the `message-mode' hidden headers
-list."
+ "Headers that are added to the `message-mode' hidden headers list."
+ :type '(repeat string)
+ :group 'notmuch-send)
+
+(defcustom notmuch-identities nil
+ "Identities that can be used as the From: address when composing a new message.
+
+If this variable is left unset, then a list will be constructed from the
+name and addresses configured in the notmuch configuration file."
:type '(repeat string)
:group 'notmuch-send)
+(defcustom notmuch-always-prompt-for-sender nil
+ "Always prompt for the From: address when composing or forwarding a message.
+
+This is not taken into account when replying to a message, because in that case
+the From: header is already filled in by notmuch."
+ :type 'boolean
+ :group 'notmuch-send)
+
(defgroup notmuch-reply nil
- "Replying to messages in notmuch"
+ "Replying to messages in notmuch."
:group 'notmuch)
(defcustom notmuch-mua-cite-function 'message-cite-original
- "*Function for citing an original message.
+ "Function for citing an original message.
+
Predefined functions include `message-cite-original' and
-`message-cite-original-without-signature'.
-Note that these functions use `mail-citation-hook' if that is non-nil."
+`message-cite-original-without-signature'. Note that these
+functions use `mail-citation-hook' if that is non-nil."
:type '(radio (function-item message-cite-original)
(function-item message-cite-original-without-signature)
(function-item sc-cite-original)
:type 'regexp
:group 'notmuch-send)
-;;
+;;; Various functions
(defun notmuch-mua-attachment-check ()
- "Signal an error if the message text indicates that an
-attachment is expected but no MML referencing an attachment is
-found.
+ "Signal an error an attachement is expected but missing.
+
+Signal an error if the message text indicates that an attachment
+is expected but no MML referencing an attachment is found.
Typically this is added to `notmuch-mua-send-hook'."
(when (and
(defun notmuch-mua-get-switch-function ()
"Get a switch function according to `notmuch-mua-compose-in'."
- (cond ((eq notmuch-mua-compose-in 'current-window)
- 'switch-to-buffer)
- ((eq notmuch-mua-compose-in 'new-window)
- 'switch-to-buffer-other-window)
- ((eq notmuch-mua-compose-in 'new-frame)
- 'switch-to-buffer-other-frame)
- (t (error "Invalid value for `notmuch-mua-compose-in'"))))
+ (pcase notmuch-mua-compose-in
+ ('current-window 'switch-to-buffer)
+ ('new-window 'switch-to-buffer-other-window)
+ ('new-frame 'switch-to-buffer-other-frame)
+ (_ (error "Invalid value for `notmuch-mua-compose-in'"))))
(defun notmuch-mua-maybe-set-window-dedicated ()
- "Set the selected window as dedicated according to
-`notmuch-mua-compose-in'."
+ "Set the selected window as dedicated according to `notmuch-mua-compose-in'."
(when (or (eq notmuch-mua-compose-in 'new-frame)
(eq notmuch-mua-compose-in 'new-window))
(set-window-dedicated-p (selected-window) t)))
(defun notmuch-mua-reply-crypto (parts)
"Add mml sign-encrypt flag if any part of original message is encrypted."
(cl-loop for part in parts
- if (notmuch-match-content-type (plist-get part :content-type)
- "multipart/encrypted")
+ for type = (plist-get part :content-type)
+ if (notmuch-match-content-type type "multipart/encrypted")
do (mml-secure-message-sign-encrypt)
- else if (notmuch-match-content-type (plist-get part :content-type)
- "multipart/*")
+ else if (notmuch-match-content-type type "multipart/*")
do (notmuch-mua-reply-crypto (plist-get part :content))))
;; There is a bug in Emacs' message.el that results in a newline
(funcall original-func header references)
(unless (bolp) (insert "\n")))
-(defun notmuch-mua-reply (query-string &optional sender reply-all)
- (let ((args '("reply" "--format=sexp" "--format-version=4"))
- (process-crypto notmuch-show-process-crypto)
- reply
- original)
+;;; Mua reply
+
+(defun notmuch-mua-reply (query-string &optional sender reply-all duplicate)
+ (let* ((duparg (and duplicate (list (format "--duplicate=%d" duplicate))))
+ (args `("reply" "--format=sexp" "--format-version=5" ,@duparg))
+ (process-crypto notmuch-show-process-crypto)
+ reply
+ original)
(when process-crypto
(setq args (append args '("--decrypt=true"))))
(if reply-all
;; Create a buffer-local queue for tag changes triggered when
;; sending the reply.
(when notmuch-message-replied-tags
- (setq-local notmuch-message-queued-tag-changes
- (list (cons query-string notmuch-message-replied-tags))))
+ (setq notmuch-message-queued-tag-changes
+ (list (cons query-string notmuch-message-replied-tags))))
;; Insert the message body - but put it in front of the signature
;; if one is present, and after any other content
;; message*setup-hooks may have added to the message body already.
;; text.
(notmuch-show-process-crypto process-crypto)
;; Don't indent multipart sub-parts.
- (notmuch-show-indent-multipart nil))
+ (notmuch-show-indent-multipart nil)
+ ;; Stop certain mime types from being inlined
+ (mm-inline-override-types (notmuch--inline-override-types)))
;; We don't want sigstatus buttons (an information leak and usually wrong anyway).
(cl-letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore)
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
(message-goto-body)
(set-buffer-modified-p nil))
+;;; Mode and keymap
+
(defvar notmuch-message-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") #'notmuch-mua-send-and-exit)
- (define-key map (kbd "C-c C-s") #'notmuch-mua-send)
+ (define-key map [remap message-send-and-exit] #'notmuch-mua-send-and-exit)
+ (define-key map [remap message-send] #'notmuch-mua-send)
(define-key map (kbd "C-c C-p") #'notmuch-draft-postpone)
(define-key map (kbd "C-x C-s") #'notmuch-draft-save)
map)
(put 'notmuch-message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
+;;; New messages
+
(defun notmuch-mua-pop-to-buffer (name switch-function)
- "Pop to buffer NAME, and warn if it already exists and is
-modified. This function is notmuch adaptation of
-`message-pop-to-buffer'."
+ "Pop to buffer NAME, and warn if it already exists and is modified.
+Like `message-pop-to-buffer' but enable `notmuch-message-mode'
+instead of `message-mode' and SWITCH-FUNCTION is mandatory."
(let ((buffer (get-buffer name)))
(if (and buffer
(buffer-name buffer))
(select-window window))
(funcall switch-function buffer)
(set-buffer buffer))
- (when (and (buffer-modified-p)
- (not (prog1
- (y-or-n-p
- "Message already being composed; erase? ")
- (message nil))))
- (error "Message being composed")))
+ (when (buffer-modified-p)
+ (if (y-or-n-p "Message already being composed; erase? ")
+ (message nil)
+ (error "Message being composed"))))
(funcall switch-function name)
(set-buffer name))
(erase-buffer)
(notmuch-message-mode)))
-(defun notmuch-mua-mail (&optional to subject other-headers continue
+(defun notmuch-mua--remove-dont-reply-to-names ()
+ (when-let* ((nr (if (functionp message-dont-reply-to-names)
+ message-dont-reply-to-names
+ (gmm-regexp-concat message-dont-reply-to-names)))
+ (nr-filter
+ (if (functionp nr)
+ (lambda (mail) (and (not (funcall nr mail)) mail))
+ (lambda (mail) (and (not (string-match-p nr mail)) mail)))))
+ (dolist (header '("To" "Cc"))
+ (when-let ((v (message-fetch-field header)))
+ (let* ((tokens (mapcar #'string-trim (message-tokenize-header v)))
+ (good-tokens (delq nil (mapcar nr-filter tokens)))
+ (addr (and good-tokens (mapconcat #'identity good-tokens ", "))))
+ (message-replace-header header addr))))))
+
+;;;#autoload
+(defun notmuch-mua-mail (&optional to subject other-headers _continue
switch-function yank-action send-actions
- return-action &rest ignored)
- "Invoke the notmuch mail composition window."
+ return-action &rest _ignored)
+ "Invoke the notmuch mail composition window.
+
+The position of point when the function returns differs depending
+on the values of TO and SUBJECT. If both are non-nil, point is
+moved to the message's body. If SUBJECT is nil but TO isn't,
+point is moved to the \"Subject:\" header. Otherwise, point is
+moved to the \"To:\" header."
(interactive)
(when notmuch-mua-user-agent-function
(let ((user-agent (funcall notmuch-mua-user-agent-function)))
- (unless (string= "" user-agent)
+ (unless (string-empty-p user-agent)
(push (cons 'User-Agent user-agent) other-headers))))
- (unless (assq 'From other-headers)
- (push (cons 'From (message-make-from
- (notmuch-user-name)
- (notmuch-user-primary-email)))
- other-headers))
(notmuch-mua-pop-to-buffer (message-buffer-name "mail" to)
(or switch-function
(notmuch-mua-get-switch-function)))
;; Cause `message-setup-1' to do things relevant for mail,
;; such as observe `message-default-mail-headers'.
(message-this-is-mail t))
+ (unless (assq 'From headers)
+ (push (cons 'From (message-make-from
+ (notmuch-user-name)
+ (notmuch-user-primary-email)))
+ headers))
(message-setup-1 headers yank-action send-actions return-action))
(notmuch-fcc-header-setup)
+ (notmuch-mua--remove-dont-reply-to-names)
(message-sort-headers)
(message-hide-headers)
(set-buffer-modified-p nil)
(notmuch-mua-maybe-set-window-dedicated)
- (message-goto-to))
-
-(defcustom notmuch-identities nil
- "Identities that can be used as the From: address when composing a new message.
-
-If this variable is left unset, then a list will be constructed from the
-name and addresses configured in the notmuch configuration file."
- :type '(repeat string)
- :group 'notmuch-send)
-
-(defcustom notmuch-always-prompt-for-sender nil
- "Always prompt for the From: address when composing or forwarding a message.
-
-This is not taken into account when replying to a message, because in that case
-the From: header is already filled in by notmuch."
- :type 'boolean
- :group 'notmuch-send)
+ (cond
+ ((and to subject) (message-goto-body))
+ (to (message-goto-subject))
+ (t (message-goto-to))))
(defvar notmuch-mua-sender-history nil)
(defun notmuch-mua-prompt-for-sender ()
"Prompt for a sender from the user's configured identities."
(if notmuch-identities
- (ido-completing-read "Send mail from: " notmuch-identities
- nil nil nil 'notmuch-mua-sender-history
- (car notmuch-identities))
+ (completing-read "Send mail from: " notmuch-identities
+ nil nil nil 'notmuch-mua-sender-history
+ (car notmuch-identities))
(let* ((name (notmuch-user-name))
(addrs (cons (notmuch-user-primary-email)
(notmuch-user-other-email)))
(address
- (ido-completing-read (concat "Sender address for " name ": ") addrs
- nil nil nil 'notmuch-mua-sender-history
- (car addrs))))
+ (completing-read (concat "Sender address for " name ": ") addrs
+ nil nil nil 'notmuch-mua-sender-history
+ (car addrs))))
(message-make-from name address))))
(put 'notmuch-mua-new-mail 'notmuch-prefix-doc "... and prompt for sender")
(with-current-buffer temp-buffer
(erase-buffer)
(let ((coding-system-for-read 'no-conversion))
- (call-process notmuch-command nil t nil
+ (notmuch--call-process notmuch-command nil t nil
"show" "--format=raw" id))
;; Because we process the messages in reverse order,
;; always generate a forwarded subject, then use the
;; Create a buffer-local queue for tag changes triggered when
;; sending the message.
(when notmuch-message-forwarded-tags
- (setq-local notmuch-message-queued-tag-changes
- (cl-loop for id in forward-queries
- collect
- (cons id notmuch-message-forwarded-tags))))
+ (setq notmuch-message-queued-tag-changes
+ (cl-loop for id in forward-queries
+ collect
+ (cons id notmuch-message-forwarded-tags))))
;; `message-forward-make-body' shows the User-agent header. Hide
;; it again.
(message-hide-headers)
(set-buffer-modified-p nil))))
-(defun notmuch-mua-new-reply (query-string &optional prompt-for-sender reply-all)
+(defun notmuch-mua-new-reply (query-string &optional prompt-for-sender reply-all duplicate)
"Compose a reply to the message identified by QUERY-STRING.
If PROMPT-FOR-SENDER is non-nil, the user will be prompted for
the From: address first. If REPLY-ALL is non-nil, the message
-will be addressed to all recipients of the source message."
+will be addressed to all recipients of the source message. If
+DUPLICATE is non-nil, based the reply on that duplicate file"
;; `select-active-regions' is t by default. The reply insertion code
;; sets the region to the quoted message to make it easy to delete
;; (kill-region or C-w). These two things combine to put the quoted
(let ((sender (and prompt-for-sender
(notmuch-mua-prompt-for-sender)))
(select-active-regions nil))
- (notmuch-mua-reply query-string sender reply-all)
+ (notmuch-mua-reply query-string sender reply-all duplicate)
(deactivate-mark)))
+;;; Checks
+
(defun notmuch-mua-check-no-misplaced-secure-tag ()
"Query user if there is a misplaced secure mml tag.
(goto-char (point-max))
(or
;; We are always fine if there is no secure tag.
- (not (search-backward "<#secure" nil 't))
+ (not (search-backward "<#secure" nil t))
;; There is a secure tag, so it must be at the start of the
;; body, with no secure tag earlier (i.e., in the headers).
(and (= (point) body-start)
- (not (search-backward "<#secure" nil 't)))
+ (not (search-backward "<#secure" nil t)))
;; The user confirms they means it.
(yes-or-no-p "\
There is a <#secure> tag not at the start of the body. It is
newline. It is likely that the message will be sent unsigned and
unencrypted. Really send? "))))
+;;; Finishing commands
+
(defun notmuch-mua-send-common (arg &optional exit)
(interactive "P")
(run-hooks 'notmuch-mua-send-hook)
(message-send-and-exit arg)
(message-send arg)))))
+;;;#autoload
(defun notmuch-mua-send-and-exit (&optional arg)
(interactive "P")
- (notmuch-mua-send-common arg 't))
+ (notmuch-mua-send-common arg t))
+;;;#autoload
(defun notmuch-mua-send (&optional arg)
(interactive "P")
(notmuch-mua-send-common arg))
+;;;#autoload
(defun notmuch-mua-kill-buffer ()
(interactive)
(message-kill-buffer))
-;;
+;;; _
+;;;#autoload
(define-mail-user-agent 'notmuch-user-agent
- 'notmuch-mua-mail 'notmuch-mua-send-and-exit
- 'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)
+ 'notmuch-mua-mail
+ 'notmuch-mua-send-and-exit
+ 'notmuch-mua-kill-buffer
+ 'notmuch-mua-send-hook)
;; Add some more headers to the list that `message-mode' hides when
;; composing a message.
(notmuch-mua-add-more-hidden-headers)
-;;
-
(provide 'notmuch-mua)
;;; notmuch-mua.el ends here
projects / notmuch / blobdiff