From deef41a82590658455bfd6468b2811147dd5f845 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 18 Feb 2023 10:45:12 +0200 Subject: [PATCH] Fix hi-lock-tests when 'use-dialog-box' is non-nil * test/lisp/hi-lock-tests.el (hi-lock-case-fold) (hi-lock-unhighlight): Bind 'use-dialog-box' to nil. --- test/lisp/hi-lock-tests.el | 143 ++++++++++++++++++++----------------- 1 file changed, 79 insertions(+), 64 deletions(-) diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el index aeb08ecbb29..794a3b1d0c2 100644 --- a/test/lisp/hi-lock-tests.el +++ b/test/lisp/hi-lock-tests.el @@ -86,13 +86,18 @@ (unhighlight-regexp "a a") (should (= (length (overlays-in (point-min) (point-max))) 0)) - (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp "a a")) + (let ((search-spaces-regexp search-whitespace-regexp)) + (highlight-regexp "a a")) (should (= (length (overlays-in (point-min) (point-max))) 1)) - (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll - &optional _x _y _z _hist defaults _inherit) - (car defaults)))) - (call-interactively 'unhighlight-regexp)) + ;; We bind use-dialog-box to nil to prevent unhighlight-regexp + ;; from using popup menus, since the replacement for + ;; completing-read below is not ready for that calamity + (let ((use-dialog-box nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) + (car defaults)))) + (call-interactively 'unhighlight-regexp))) (should (= (length (overlays-in (point-min) (point-max))) 0)) (emacs-lisp-mode) @@ -142,12 +147,16 @@ (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp "a a")) (font-lock-ensure) (should (memq 'hi-yellow (get-text-property 1 'face))) - (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll - &optional _x _y _z _hist defaults _inherit) - (car defaults))) - (font-lock-fontified t)) - (call-interactively 'unhighlight-regexp)) + ;; We bind use-dialog-box to nil to prevent unhighlight-regexp + ;; from using popup menus, since the replacement for + ;; completing-read below is not ready for that calamity + (let ((use-dialog-box nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) + (car defaults))) + (font-lock-fontified t)) + (call-interactively 'unhighlight-regexp))) (should (null (get-text-property 1 'face)))))) (ert-deftest hi-lock-unhighlight () @@ -156,58 +165,64 @@ (with-temp-buffer (insert "aAbB\n") - (cl-letf (((symbol-function 'completing-read) - (lambda (_prompt _coll - &optional _x _y _z _hist defaults _inherit) - (car defaults)))) - - (highlight-regexp "a") - (highlight-regexp "b") - (should (= (length (overlays-in (point-min) (point-max))) 4)) - ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1, - ;; not the last regexp "b" - (goto-char 1) - (call-interactively 'unhighlight-regexp) - (should (= (length (overlays-in 1 3)) 0)) - (should (= (length (overlays-in 3 5)) 2)) - ;; Next call should unhighlight remaining regepxs - (call-interactively 'unhighlight-regexp) - (should (= (length (overlays-in 3 5)) 0)) - - ;; Test unhighlight all - (highlight-regexp "a") - (highlight-regexp "b") - (should (= (length (overlays-in (point-min) (point-max))) 4)) - (unhighlight-regexp t) - (should (= (length (overlays-in (point-min) (point-max))) 0)) - - (emacs-lisp-mode) - (setq font-lock-mode t) - - (highlight-regexp "a") - (highlight-regexp "b") - (font-lock-ensure) - (should (memq 'hi-yellow (get-text-property 1 'face))) - (should (memq 'hi-yellow (get-text-property 3 'face))) - ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1, - ;; not the last regexp "b" - (goto-char 1) - (let ((font-lock-fontified t)) (call-interactively 'unhighlight-regexp)) - (should (null (get-text-property 1 'face))) - (should (memq 'hi-yellow (get-text-property 3 'face))) - ;; Next call should unhighlight remaining regepxs - (let ((font-lock-fontified t)) (call-interactively 'unhighlight-regexp)) - (should (null (get-text-property 3 'face))) - - ;; Test unhighlight all - (highlight-regexp "a") - (highlight-regexp "b") - (font-lock-ensure) - (should (memq 'hi-yellow (get-text-property 1 'face))) - (should (memq 'hi-yellow (get-text-property 3 'face))) - (let ((font-lock-fontified t)) (unhighlight-regexp t)) - (should (null (get-text-property 1 'face))) - (should (null (get-text-property 3 'face))))))) + ;; We bind use-dialog-box to nil to prevent unhighlight-regexp + ;; from using popup menus, since the replacement for + ;; completing-read below is not ready for that calamity + (let ((use-dialog-box nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _coll + &optional _x _y _z _hist defaults _inherit) + (car defaults)))) + (highlight-regexp "a") + (highlight-regexp "b") + (should (= (length (overlays-in (point-min) (point-max))) 4)) + ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1, + ;; not the last regexp "b" + (goto-char 1) + (call-interactively 'unhighlight-regexp) + (should (= (length (overlays-in 1 3)) 0)) + (should (= (length (overlays-in 3 5)) 2)) + ;; Next call should unhighlight remaining regepxs + (call-interactively 'unhighlight-regexp) + (should (= (length (overlays-in 3 5)) 0)) + + ;; Test unhighlight all + (highlight-regexp "a") + (highlight-regexp "b") + (should (= (length (overlays-in (point-min) (point-max))) 4)) + (unhighlight-regexp t) + (should (= (length (overlays-in (point-min) (point-max))) 0)) + + (emacs-lisp-mode) + (setq font-lock-mode t) + + (highlight-regexp "a") + (highlight-regexp "b") + (font-lock-ensure) + (should (memq 'hi-yellow (get-text-property 1 'face))) + (should (memq 'hi-yellow (get-text-property 3 'face))) + ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1, + ;; not the last regexp "b" + (goto-char 1) + (let ((font-lock-fontified t)) + (call-interactively 'unhighlight-regexp)) + (should (null (get-text-property 1 'face))) + (should (memq 'hi-yellow (get-text-property 3 'face))) + ;; Next call should unhighlight remaining regepxs + (let ((font-lock-fontified t)) + (call-interactively 'unhighlight-regexp)) + (should (null (get-text-property 3 'face))) + + ;; Test unhighlight all + (highlight-regexp "a") + (highlight-regexp "b") + (font-lock-ensure) + (should (memq 'hi-yellow (get-text-property 1 'face))) + (should (memq 'hi-yellow (get-text-property 3 'face))) + (let ((font-lock-fontified t)) + (unhighlight-regexp t)) + (should (null (get-text-property 1 'face))) + (should (null (get-text-property 3 'face)))))))) (provide 'hi-lock-tests) ;;; hi-lock-tests.el ends here -- 2.39.2