(require 'notmuch-lib)
(require 'notmuch-address)
+(require 'notmuch-draft)
(eval-when-compile (require 'cl))
(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" ())
+(declare-function notmuch-draft-postpone "notmuch-draft" ())
+(declare-function notmuch-draft-save "notmuch-draft" ())
;;
"Function to decide which parts get a header when replying.
This function specifies which parts of a mime message with
-mutiple parts get a header."
+multiple parts get a header."
:type '(radio (const :tag "No part headers"
notmuch-show-reply-insert-header-p-never)
(const :tag "All except multipart/* and hidden parts"
(function :tag "Other"))
:group 'notmuch-reply)
+(defcustom notmuch-mua-attachment-regexp
+ "\\b\\(attache\?ment\\|attached\\|attach\\|pi[èe]ce\s+jointe?\\)\\b"
+ "Message body text indicating that an attachment is expected.
+
+This is not used unless `notmuch-mua-attachment-check' is added
+to `notmuch-mua-send-hook'.")
+
;;
+(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.
+
+Typically this is added to `notmuch-mua-send-hook'."
+ (when (and
+ ;; When the message mentions attachment...
+ (save-excursion
+ (message-goto-body)
+ (loop while (re-search-forward notmuch-mua-attachment-regexp (point-max) t)
+ ;; For every instance of the "attachment" string
+ ;; found, examine the text properties. If the text
+ ;; has either a `face' or `syntax-table' property
+ ;; then it is quoted text and should *not* cause the
+ ;; user to be asked about a missing attachment.
+ if (let ((props (text-properties-at (match-beginning 0))))
+ (not (or (memq 'syntax-table props)
+ (memq 'face props))))
+ return t
+ finally return nil))
+ ;; ...but doesn't have a part with a filename...
+ (save-excursion
+ (message-goto-body)
+ (not (re-search-forward "^<#part [^>]*filename=" nil t)))
+ ;; ...and that's not okay...
+ (not (y-or-n-p "Attachment mentioned, but no attachment - is that okay?")))
+ ;; ...signal an error.
+ (error "Missing attachment")))
+
(defun notmuch-mua-get-switch-function ()
"Get a switch function according to `notmuch-mua-compose-in'."
(cond ((eq notmuch-mua-compose-in 'current-window)
(unless (bolp) (insert "\n")))
(defun notmuch-mua-reply (query-string &optional sender reply-all)
- (let ((args '("reply" "--format=sexp" "--format-version=1"))
+ (let ((args '("reply" "--format=sexp" "--format-version=4"))
(process-crypto notmuch-show-process-crypto)
reply
original)
(when process-crypto
- (setq args (append args '("--decrypt"))))
+ (setq args (append args '("--decrypt=true"))))
(if reply-all
(setq args (append args '("--reply-to=all")))
else
collect pair)))
(notmuch-mua-mail (plist-get reply-headers :To)
- (plist-get reply-headers :Subject)
+ (notmuch-sanitize (plist-get reply-headers :Subject))
(notmuch-headers-plist-to-alist reply-headers)
nil (notmuch-mua-get-switch-function))))
(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)
+ ;; 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))
- (notmuch-show-insert-body original (plist-get original :body) 0)
- (buffer-substring-no-properties (point-min) (point-max)))))
+ ;; 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)
(define-key notmuch-message-mode-map (kbd "C-c C-c") #'notmuch-mua-send-and-exit)
(define-key notmuch-message-mode-map (kbd "C-c C-s") #'notmuch-mua-send)
+(define-key notmuch-message-mode-map (kbd "C-c C-p") #'notmuch-draft-postpone)
+(define-key notmuch-message-mode-map (kbd "C-x C-s") #'notmuch-draft-save)
(defun notmuch-mua-pop-to-buffer (name switch-function)
"Pop to buffer NAME, and warn if it already exists and is
(if window
;; Raise the frame already displaying the message buffer.
(progn
- (gnus-select-frame-set-input-focus (window-frame window))
+ (select-frame-set-input-focus (window-frame window))
(select-window window))
(funcall switch-function buffer)
(set-buffer buffer))
(notmuch-mua-reply query-string sender reply-all)
(deactivate-mark)))
-(defun notmuch-mua-send-and-exit (&optional arg)
+(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")
- (let ((message-fcc-handler-function #'notmuch-fcc-handler))
+ (run-hooks 'notmuch-mua-send-hook)
+ (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))
- (message-send-and-exit arg))))
+ (if exit
+ (message-send-and-exit arg)
+ (message-send arg)))))
+
+(defun notmuch-mua-send-and-exit (&optional arg)
+ (interactive "P")
+ (notmuch-mua-send-common arg 't))
(defun notmuch-mua-send (&optional arg)
(interactive "P")
- (let ((message-fcc-handler-function #'notmuch-fcc-handler))
- (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc))
- (message-send arg))))
+ (notmuch-mua-send-common arg))
(defun notmuch-mua-kill-buffer ()
(interactive)