mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-11-22 19:08:09 +01:00
11ac932a45
Starting with Emacs 27 the old `cl' implementation is finally considered obsolete. Previously its use was strongly discouraged at run-time but one was still allowed to use it at compile-time. For the most part the transition is very simple and boils down to adding the "cl-" prefix to some symbols. A few replacements do not follow that simple pattern; e.g. `first' is replaced with `car', even though the alias `cl-first' exists, because the latter is not idiomatic emacs-lisp. In a few cases we start using `pcase-let' or `pcase-lambda' instead of renaming e.g. `first' to `car'. That way we can remind the reader of the meaning of the various parts of the data that is being deconstructed. An obsolete `lexical-let' and a `lexical-let*' are replaced with their regular variants `let' and `let*' even though we do not at the same time enable `lexical-binding' for that file. That is the right thing to do because it does not actually make a difference in those cases whether lexical bindings are used or not, and because this should be enabled in a separate commit. We need to explicitly depend on the `cl-lib' package because Emacs 24.1 and 24.2 lack that library. When using these releases we end up using the backport from GNU Elpa. We need to explicitly require the `pcase' library because `pcase-dolist' was not autoloaded until Emacs 25.1.
82 lines
2.8 KiB
EmacsLisp
82 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)
|
|
(mapcar (lambda (test)
|
|
(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)))
|
|
attachment-check-tests)
|
|
(notmuch-test-expect-equal output expected)))
|