]> git.cworth.org Git - notmuch-old/blob - test/emacs-attachment-warnings.el
lib/message-property: sync removed properties to the database
[notmuch-old] / test / emacs-attachment-warnings.el
1 (require 'cl-lib)
2 (require 'notmuch-mua)
3
4 (defun attachment-check-test (&optional fn)
5   "Test `notmuch-mua-attachment-check' using a message where optional FN is evaluated.
6
7 Return `t' if the message would be sent, otherwise `nil'"
8   (notmuch-mua-mail)
9   (message-goto-body)
10   (when fn
11     (funcall fn))
12   (prog1
13       (condition-case nil
14           ;; Force `y-or-n-p' to always return `nil', as if the user
15           ;; pressed "n".
16           (cl-letf (((symbol-function 'y-or-n-p)
17                      (lambda (&rest args) nil)))
18             (notmuch-mua-attachment-check)
19             t)
20         ('error nil))
21     (set-buffer-modified-p nil)
22     (kill-buffer (current-buffer))))
23
24 (defvar attachment-check-tests
25   '(
26     ;; These are all okay:
27     (t)
28     (t . (lambda () (insert "Nothing is a-tt-a-ch-ed!\n")))
29     (t . (lambda ()
30            (insert "Here is an attachment:\n")
31            (insert "<#part filename=\"foo\" />\n")))
32     (t . (lambda () (insert "<#part filename=\"foo\" />\n")))
33     (t . (lambda ()
34            ;; "attachment" is only mentioned in a quoted section.
35            (insert "> I sent you an attachment!\n")
36            ;; Code in `notmuch-mua-attachment-check' avoids matching on
37            ;; "attachment" in a quoted section of the message by looking at
38            ;; fontification properties. For fontification to happen we need to
39            ;; allow some time for redisplay.
40            (sit-for 0.01)))
41     (t . (lambda ()
42            ;; "attach" is only mentioned in a forwarded message.
43            (insert "Hello\n")
44            (insert "<#mml type=message/rfc822 disposition=inline>\n")
45            (insert "X-Has-Attach:\n")
46            (insert "<#/mml>\n")))
47
48     ;; These should not be okay:
49     (nil . (lambda () (insert "Here is an attachment:\n")))
50     (nil . (lambda ()
51              ;; "attachment" is mentioned in both a quoted section and
52              ;; outside of it.
53              (insert "> I sent you an attachment!\n")
54              (insert "The attachment was missing!\n")
55              ;; Code in `notmuch-mua-attachment-check' avoids matching
56              ;; on "attachment" in a quoted section of the message by
57              ;; looking at fontification properties. For fontification
58              ;; to happen we need to allow some time for redisplay.
59              (sit-for 0.01)))
60     (nil . (lambda ()
61            ;; "attachment" is mentioned before a forwarded message.
62            (insert "I also attach something.\n")
63            (insert "<#mml type=message/rfc822 disposition=inline>\n")
64            (insert "X-Has-Attach:\n")
65            (insert "<#/mml>\n")))
66     ))
67
68 (defun notmuch-test-attachment-warning-1 ()
69   (let (output expected)
70     (dolist (test attachment-check-tests)
71       (let* ((expect (car test))
72              (body (cdr test))
73              (result (attachment-check-test body)))
74         (push expect expected)
75         (push (if (eq result expect)
76                   result
77                 ;; In the case of a failure, include the test
78                 ;; details to make it simpler to debug.
79                 (format "%S <-- %S" result body))
80               output)))
81     (notmuch-test-expect-equal output expected)))