emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

emacs-29 deef41a8259: Fix hi-lock-tests when 'use-dialog-box' is non-nil


From: Eli Zaretskii
Subject: emacs-29 deef41a8259: Fix hi-lock-tests when 'use-dialog-box' is non-nil
Date: Sat, 18 Feb 2023 03:46:50 -0500 (EST)

branch: emacs-29
commit deef41a82590658455bfd6468b2811147dd5f845
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]