X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-mua.el;h=bbf059a22cb5487f669497631363a7c924b1d3d8;hp=29a2538bb3a7cd3112e3450647fe3bbaea445b16;hb=HEAD;hpb=53a4eb4780ef3d24af75ca36836acf7a30635136 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 29a2538b..bf62b656 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -1,4 +1,4 @@ -;;; notmuch-mua.el --- emacs style mail-user-agent +;;; notmuch-mua.el --- emacs style mail-user-agent -*- lexical-binding: t -*- ;; ;; Copyright © David Edmondson ;; @@ -21,9 +21,10 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) (require 'message) +(require 'gmm-utils) (require 'mm-view) (require 'format-spec) @@ -38,7 +39,12 @@ (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." @@ -77,8 +83,24 @@ If this is `nil' then no `User-Agent:' will be generated." :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 @@ -120,12 +142,13 @@ to `notmuch-mua-send-hook'." :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 @@ -158,13 +181,11 @@ Typically this is added to `notmuch-mua-send-hook'." (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'." @@ -199,11 +220,10 @@ Typically this is added to `notmuch-mua-send-hook'." (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 @@ -215,11 +235,14 @@ Typically this is added to `notmuch-mua-send-hook'." (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 @@ -259,8 +282,8 @@ Typically this is added to `notmuch-mua-send-hook'." ;; 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. @@ -297,7 +320,9 @@ Typically this is added to `notmuch-mua-send-hook'." ;; 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)) @@ -318,10 +343,12 @@ Typically this is added to `notmuch-mua-send-hook'." (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) @@ -333,6 +360,8 @@ Typically this is added to `notmuch-mua-send-hook'." (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. Like `message-pop-to-buffer' but enable `notmuch-message-mode' @@ -348,31 +377,46 @@ instead of `message-mode' and SWITCH-FUNCTION is mandatory." (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))) @@ -391,45 +435,38 @@ instead of `message-mode' and SWITCH-FUNCTION is mandatory." ;; 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") @@ -469,7 +506,7 @@ the From: address." (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 @@ -496,21 +533,22 @@ the From: address." ;; 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 @@ -525,9 +563,11 @@ will be addressed to all recipients of the source message." (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. @@ -539,11 +579,11 @@ tag, or the user confirms they mean it." (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 @@ -570,6 +610,8 @@ The <#secure> tag at the start of the body is not followed by a 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) @@ -581,30 +623,34 @@ unencrypted. Really send? ")))) (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