]> git.notmuchmail.org Git - notmuch/blob - test/emacs-attachment-warnings.el
util/repair: identify and repair "Mixed Up" mangled messages
[notmuch] / test / emacs-attachment-warnings.el
1 (require 'notmuch-mua)
2
3 (defun attachment-check-test (&optional fn)
4   "Test `notmuch-mua-attachment-check' using a message where optional FN is evaluated.
5
6 Return `t' if the message would be sent, otherwise `nil'"
7   (notmuch-mua-mail)
8   (message-goto-body)
9   (when fn
10     (funcall fn))
11   (prog1
12       (condition-case nil
13           ;; Force `y-or-n-p' to always return `nil', as if the user
14           ;; pressed "n".
15           (letf (((symbol-function 'y-or-n-p) (lambda (&rest args) nil)))
16             (notmuch-mua-attachment-check)
17             t)
18         ('error nil))
19     (set-buffer-modified-p nil)
20     (kill-buffer (current-buffer))))
21
22 (defvar attachment-check-tests
23   '(
24     ;; These are all okay:
25     (t)
26     (t . (lambda () (insert "Nothing is a-tt-a-ch-ed!\n")))
27     (t . (lambda ()
28            (insert "Here is an attachment:\n")
29            (insert "<#part filename=\"foo\" />\n")))
30     (t . (lambda () (insert "<#part filename=\"foo\" />\n")))
31     (t . (lambda ()
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.
38            (sit-for 0.01)))
39
40     ;; These should not be okay:
41     (nil . (lambda () (insert "Here is an attachment:\n")))
42     (nil . (lambda ()
43              ;; "attachment" is mentioned in both a quoted section and
44              ;; outside of it.
45              (insert "> I sent you an attachment!\n")
46              (insert "The attachment was missing!\n")
47              ;; Code in `notmuch-mua-attachment-check' avoids matching
48              ;; on "attachment" in a quoted section of the message by
49              ;; looking at fontification properties. For fontification
50              ;; to happen we need to allow some time for redisplay.
51              (sit-for 0.01)))
52     ))
53
54 (defun notmuch-test-attachment-warning-1 ()
55   (let (output expected)
56     (mapcar (lambda (test)
57               (let* ((expect (car test))
58                      (body (cdr test))
59                      (result (attachment-check-test body)))
60                 (push expect expected)
61                 (push (if (eq result expect)
62                           result
63                         ;; In the case of a failure, include the test
64                         ;; details to make it simpler to debug.
65                         (format "%S <-- %S" result body))
66                       output)))
67             attachment-check-tests)
68     (notmuch-test-expect-equal output expected)))