mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-11-21 18:38:08 +01:00
81 lines
2.8 KiB
EmacsLisp
81 lines
2.8 KiB
EmacsLisp
(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)))
|