[PATCH v2 0/2] emacs: Optionally warn if attachments are mentioned in an outgoing

[David Edmondson]

emacs: Optionally warn if attachments are mentioned in an outgoing
message but no MML referencing an attachment is found.

v2:
- Check whether "attachment" is within a quoted region, and don't
prompt if so.
- Extend and re-work the tests - more lisp, less bash.


David Edmondson (2):
emacs: Optionally check for missing attachments in outgoing messages
test: Add emacs attachment check tests.

emacs/notmuch-mua.el | 37 ++++++++++++++++++
test/T720-emacs-attachment-warnings.sh | 9 +++++
test/emacs-attachment-warnings.el | 68 ++++++++++++++++++++++++++++++++++
3 files changed, 114 insertions(+)
create mode 100755 test/T720-emacs-attachment-warnings.sh
create mode 100644 test/emacs-attachment-warnings.el

[David Edmondson]

Query the user if the message text indicates that an attachment is
expected but no MML referencing an attachment is found.

This is not enabled by default - see the documentation for
`notmuch-mua-attachment-check'.
---
emacs/notmuch-mua.el | 37 +++++++++++++++++++++++++++++++++++++
1 file changed, 37 insertions(+)

diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index fc8ac687..13759c73 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -115,8 +115,45 @@ multiple parts get a header."
(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)

[David Bremner]

Post by David Edmondson
Query the user if the message text indicates that an attachment is
expected but no MML referencing an attachment is found.
This is not enabled by default - see the documentation for
`notmuch-mua-attachment-check'.
---
emacs/notmuch-mua.el | 37 +++++++++++++++++++++++++++++++++++++
1 file changed, 37 insertions(+)
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index fc8ac687..13759c73 100644
--- a/emacs/notmuch-mua.el
+++ b/emacs/notmuch-mua.el
@@ -115,8 +115,45 @@ multiple parts get a header."
(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'.")
+
;;

notmuch-mua-send-hook is not firing for me. I ran the following test

./devel/try-emac-mua -q

(add-hook 'notmuch-mua-send-hook (lambda () (error "boo!"))) C-x C-e
(notmuch-hello) C-x C-e
m
delete Fcc header
C-c C-c
select trasport

Nothing in messages from my hook, no traceback.

This is not caused by your patches, but seems like we should figure out
what's going on?

[David Edmondson]

---
test/T720-emacs-attachment-warnings.sh | 9 +++++
test/emacs-attachment-warnings.el | 68 ++++++++++++++++++++++++++++++++++
2 files changed, 77 insertions(+)
create mode 100755 test/T720-emacs-attachment-warnings.sh
create mode 100644 test/emacs-attachment-warnings.el

diff --git a/test/T720-emacs-attachment-warnings.sh b/test/T720-emacs-attachment-warnings.sh
new file mode 100755
index 00000000..c8d2bcc2
--- /dev/null
+++ b/test/T720-emacs-attachment-warnings.sh
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+test_description="emacs attachment warnings"
+. $(dirname "$0")/test-lib.sh || exit 1
+
+test_begin_subtest "notmuch-test-attachment-warning part 1"
+test_emacs_expect_t '(notmuch-test-attachment-warning-1)'
+
+test_done
diff --git a/test/emacs-attachment-warnings.el b/test/emacs-attachment-warnings.el
new file mode 100644
index 00000000..200ca7ba
--- /dev/null
+++ b/test/emacs-attachment-warnings.el
@@ -0,0 +1,68 @@
+(require 'notmuch-mua)
+
+(defun attachment-check-test (&optional fn)
+ "Test `notmuch-mua-attachment-check' using a message where optional FN is evaluated.
+
+Return `t' if the message would be sent, otherwise `nil'"
+ (notmuch-mua-mail)
+ (message-goto-body)
+ (when fn
+ (funcall fn))
+ (prog1
+ (condition-case nil
+ ;; Force `y-or-n-p' to always return `nil', as if the user
+ ;; pressed "n".
+ (letf (((symbol-function 'y-or-n-p) (lambda (&rest args) nil)))
+ (notmuch-mua-attachment-check)
+ t)
+ ('error nil))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer))))
+
+(defvar attachment-check-tests
+ '(
+ ;; These are all okay:
+ (t)
+ (t . (lambda () (insert "Nothing is a-tt-a-ch-ed!\n")))
+ (t . (lambda ()
+ (insert "Here is an attachment:\n")
+ (insert "<#part filename=\"foo\" />\n")))
+ (t . (lambda () (insert "<#part filename=\"foo\" />\n")))
+ (t . (lambda ()
+ ;; "attachment" is only mentioned in a quoted section.
+ (insert "> I sent you an attachment!\n")
+ ;; Code in `notmuch-mua-attachment-check' avoids matching on
+ ;; "attachment" in a quoted section of the message by looking at
+ ;; fontification properties. For fontification to happen we need to
+ ;; allow some time for redisplay.
+ (sit-for 0.01)))
+
+ ;; These should not be okay:
+ (nil . (lambda () (insert "Here is an attachment:\n")))
+ (nil . (lambda ()
+ ;; "attachment" is mentioned in both a quoted section and
+ ;; outside of it.
+ (insert "> I sent you an attachment!\n")
+ (insert "The attachment was missing!\n")
+ ;; Code in `notmuch-mua-attachment-check' avoids matching
+ ;; on "attachment" in a quoted section of the message by
+ ;; looking at fontification properties. For fontification
+ ;; to happen we need to allow some time for redisplay.
+ (sit-for 0.01)))
+ ))
+
+(defun notmuch-test-attachment-warning-1 ()
+ (let (output expected)
+ (mapcar (lambda (test)
+ (let* ((expect (car test))
+ (body (cdr test))
+ (result (attachment-check-test body)))
+ (push expect expected)
+ (push (if (eq result expect)
+ result
+ ;; In the case of a failure, include the test
+ ;; details to make it simpler to debug.
+ (format "%S <-- %S" result body))
+ output)))
+ attachment-check-tests)
+ (notmuch-test-expect-equal output expected)))