git.cworth.org Git - notmuch/blob - 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     (mapcar (lambda (test)
  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             attachment-check-tests)
  82     (notmuch-test-expect-equal output expected)))