unofficial mirror of notmuch@notmuchmail.org
 help / color / mirror / code / Atom feed
blob 8f4918ef60e114c3497f53709bbd85fed887a479 2834 bytes (raw)
name: test/emacs-attachment-warnings.el 	 # note: path name is non-authoritative(*)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 
(require 'cl-lib)
(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".
	  (cl-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)))
    (t . (lambda ()
	   ;; "attach" is only mentioned in a forwarded message.
	   (insert "Hello\n")
	   (insert "<#mml type=message/rfc822 disposition=inline>\n")
	   (insert "X-Has-Attach:\n")
	   (insert "<#/mml>\n")))

    ;; 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)))
    (nil . (lambda ()
	   ;; "attachment" is mentioned before a forwarded message.
	   (insert "I also attach something.\n")
	   (insert "<#mml type=message/rfc822 disposition=inline>\n")
	   (insert "X-Has-Attach:\n")
	   (insert "<#/mml>\n")))
    ))

(defun notmuch-test-attachment-warning-1 ()
  (let (output expected)
    (dolist (test attachment-check-tests)
      (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)))
    (notmuch-test-expect-equal output expected)))

debug log:

solving 8f4918ef ...
found 8f4918ef in https://yhetil.org/notmuch.git/

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://yhetil.org/notmuch.git/

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).