X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-mua.el;h=f3336559a87a47fb8999b6afcf33005405be1466;hp=cfdac0ef803a1f86b0a6e8d9317ee4519aecb92b;hb=0301055f07f993d98954036a353de9f5116f61d7;hpb=dc13fcbf8755506b2681ef3c44da98737ddab8e8
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index cfdac0ef..f3336559 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
;;
;; Copyright © David Edmondson
;;
@@ -15,10 +15,12 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with Notmuch. If not, see .
+;; along with Notmuch. If not, see .
;;
;; Authors: David Edmondson
+;;; Code:
+
(require 'message)
(require 'mm-view)
(require 'format-spec)
@@ -30,7 +32,7 @@
(declare-function notmuch-show-insert-body "notmuch-show" (msg body depth))
(declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ())
-(declare-function notmuch-fcc-handler "notmuch-maildir-fcc" (destdir))
+(declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ())
;;
@@ -60,7 +62,7 @@ disabled: this would result in an incorrect behavior."))
(const :tag "Compose mail in a new window" new-window)
(const :tag "Compose mail in a new frame" new-frame)))
-(defcustom notmuch-mua-user-agent-function 'notmuch-mua-user-agent-full
+(defcustom notmuch-mua-user-agent-function nil
"Function used to generate a `User-Agent:' string. If this is
`nil' then no `User-Agent:' will be generated."
:type '(choice (const :tag "No user agent string" nil)
@@ -71,7 +73,7 @@ disabled: this would result in an incorrect behavior."))
:value notmuch-mua-user-agent-full))
:group 'notmuch-send)
-(defcustom notmuch-mua-hidden-headers '("^User-Agent:")
+(defcustom notmuch-mua-hidden-headers nil
"Headers that are added to the `message-mode' hidden headers
list."
:type '(repeat string)
@@ -140,7 +142,7 @@ mutiple parts get a header."
(let ((notmuch-version (if (string= notmuch-emacs-version "unknown")
(notmuch-cli-version)
notmuch-emacs-version)))
- (concat "Notmuch/" notmuch-version " (http://notmuchmail.org)")))
+ (concat "Notmuch/" notmuch-version " (https://notmuchmail.org)")))
(defun notmuch-mua-user-agent-emacs ()
"Generate a `User-Agent:' string suitable for notmuch."
@@ -248,9 +250,18 @@ mutiple parts get a header."
;; Don't omit long parts.
(notmuch-show-max-text-part-size 0)
;; Insert headers for parts as appropriate for replying.
- (notmuch-show-insert-header-p-function notmuch-mua-reply-insert-header-p-function))
- (notmuch-show-insert-body original (plist-get original :body) 0)
- (buffer-substring-no-properties (point-min) (point-max)))))
+ (notmuch-show-insert-header-p-function notmuch-mua-reply-insert-header-p-function)
+ ;; Ensure that any encrypted parts are
+ ;; decrypted during the generation of the reply
+ ;; text.
+ (notmuch-show-process-crypto process-crypto)
+ ;; Don't indent multipart sub-parts.
+ (notmuch-show-indent-multipart nil))
+ ;; We don't want sigstatus buttons (an information leak and usually wrong anyway).
+ (letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore)
+ ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
+ (notmuch-show-insert-body original (plist-get original :body) 0)
+ (buffer-substring-no-properties (point-min) (point-max))))))
(set-mark (point))
(goto-char start)
@@ -272,8 +283,7 @@ mutiple parts get a header."
(define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]"
"Notmuch message composition mode. Mostly like `message-mode'"
- (when notmuch-address-command
- (notmuch-address-setup)))
+ (notmuch-address-setup))
(put 'notmuch-message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
@@ -318,8 +328,8 @@ modified. This function is notmuch addaptation of
(push (cons 'User-Agent user-agent) other-headers))))
(unless (assq 'From other-headers)
- (push (cons 'From (concat
- (notmuch-user-name) " <" (notmuch-user-primary-email) ">")) 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)))
@@ -330,11 +340,14 @@ modified. This function is notmuch addaptation of
;; C-h f compose-mail says that headers should be specified as
;; (string . value); however all the rest of message expects
;; headers to be symbols, not strings (eg message-header-format-alist).
- ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
+ ;; https://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
;; We need to convert any string input, eg from rmail-start-mail.
(dolist (h other-headers other-headers)
(if (stringp (car h)) (setcar h (intern (capitalize (car h))))))))
- (args (list yank-action send-actions)))
+ (args (list yank-action send-actions))
+ ;; Cause `message-setup-1' to do things relevant for mail,
+ ;; such as observe `message-default-mail-headers'.
+ (message-this-is-mail t))
;; message-setup-1 in Emacs 23 does not accept return-action
;; argument. Pass it only if it is supplied by the caller. This
;; will never be the case when we're called by `compose-mail' in
@@ -393,7 +406,7 @@ the From: header is already filled in by notmuch."
(ido-completing-read (concat "Sender address for " name ": ") addrs
nil nil nil 'notmuch-mua-sender-history
(car addrs))))
- (concat name " <" address ">"))))
+ (message-make-from name address))))
(put 'notmuch-mua-new-mail 'notmuch-prefix-doc "... and prompt for sender")
(defun notmuch-mua-new-mail (&optional prompt-for-sender)
@@ -481,15 +494,64 @@ will be addressed to all recipients of the source message."
(notmuch-mua-reply query-string sender reply-all)
(deactivate-mark)))
+(defun notmuch-mua-check-no-misplaced-secure-tag ()
+ "Query user if there is a misplaced secure mml tag.
+
+Emacs message-send will (probably) ignore a secure mml tag unless
+it is at the start of the body. Returns t if there is no such
+tag, or the user confirms they mean it."
+ (save-excursion
+ (let ((body-start (progn (message-goto-body) (point))))
+ (goto-char (point-max))
+ (or
+ ;; We are always fine if there is no secure tag.
+ (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)))
+ ;; The user confirms they means it.
+ (yes-or-no-p "\
+There is a <#secure> tag not at the start of the body. It is
+likely that the message will be sent unsigned and unencrypted.
+Really send? ")))))
+
+(defun notmuch-mua-check-secure-tag-has-newline ()
+ "Query if the secure mml tag has a newline following it.
+
+Emacs message-send will (probably) ignore a correctly placed
+secure mml tag unless it is followed by a newline. Returns t if
+any secure tag is followed by a newline, or the user confirms
+they mean it."
+ (save-excursion
+ (message-goto-body)
+ (or
+ ;; There is no (correctly placed) secure tag.
+ (not (looking-at "<#secure"))
+ ;; The secure tag is followed by a newline.
+ (looking-at "<#secure[^\n>]*>\n")
+ ;; The user confirms they means it.
+ (yes-or-no-p "\
+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? "))))
+
+(defun notmuch-mua-send-common (arg &optional exit)
+ (interactive "P")
+ (when (and (notmuch-mua-check-no-misplaced-secure-tag)
+ (notmuch-mua-check-secure-tag-has-newline))
+ (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
+ (if exit
+ (message-send-and-exit arg)
+ (message-send arg)))))
+
(defun notmuch-mua-send-and-exit (&optional arg)
(interactive "P")
- (let ((message-fcc-handler-function #'notmuch-fcc-handler))
- (message-send-and-exit arg)))
+ (notmuch-mua-send-common arg 't))
(defun notmuch-mua-send (&optional arg)
(interactive "P")
- (let ((message-fcc-handler-function #'notmuch-fcc-handler))
- (message-send arg)))
+ (notmuch-mua-send-common arg))
(defun notmuch-mua-kill-buffer ()
(interactive)
@@ -513,3 +575,5 @@ simply runs the corresponding `message-mode' hook functions."
;;
(provide 'notmuch-mua)
+
+;;; notmuch-mua.el ends here