3 (defun attachment-check-test (&optional fn)
4 "Test `notmuch-mua-attachment-check' using a message where optional FN is evaluated.
6 Return `t' if the message would be sent, otherwise `nil'"
13 ;; Force `y-or-n-p' to always return `nil', as if the user
15 (letf (((symbol-function 'y-or-n-p) (lambda (&rest args) nil)))
16 (notmuch-mua-attachment-check)
19 (set-buffer-modified-p nil)
20 (kill-buffer (current-buffer))))
22 (defvar attachment-check-tests
24 ;; These are all okay:
26 (t . (lambda () (insert "Nothing is a-tt-a-ch-ed!\n")))
28 (insert "Here is an attachment:\n")
29 (insert "<#part filename=\"foo\" />\n")))
30 (t . (lambda () (insert "<#part filename=\"foo\" />\n")))
32 ;; "attachment" is only mentioned in a quoted section.
33 (insert "> I sent you an attachment!\n")
34 ;; Code in `notmuch-mua-attachment-check' avoids matching on
35 ;; "attachment" in a quoted section of the message by looking at
36 ;; fontification properties. For fontification to happen we need to
37 ;; allow some time for redisplay.
40 ;; "attach" is only mentioned in a forwarded message.
42 (insert "<#mml type=message/rfc822 disposition=inline>\n")
43 (insert "X-Has-Attach:\n")
44 (insert "<#/mml>\n")))
46 ;; These should not be okay:
47 (nil . (lambda () (insert "Here is an attachment:\n")))
49 ;; "attachment" is mentioned in both a quoted section and
51 (insert "> I sent you an attachment!\n")
52 (insert "The attachment was missing!\n")
53 ;; Code in `notmuch-mua-attachment-check' avoids matching
54 ;; on "attachment" in a quoted section of the message by
55 ;; looking at fontification properties. For fontification
56 ;; to happen we need to allow some time for redisplay.
59 ;; "attachment" is mentioned before a forwarded message.
60 (insert "I also attach something.\n")
61 (insert "<#mml type=message/rfc822 disposition=inline>\n")
62 (insert "X-Has-Attach:\n")
63 (insert "<#/mml>\n")))
66 (defun notmuch-test-attachment-warning-1 ()
67 (let (output expected)
68 (mapcar (lambda (test)
69 (let* ((expect (car test))
71 (result (attachment-check-test body)))
72 (push expect expected)
73 (push (if (eq result expect)
75 ;; In the case of a failure, include the test
76 ;; details to make it simpler to debug.
77 (format "%S <-- %S" result body))
79 attachment-check-tests)
80 (notmuch-test-expect-equal output expected)))