]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix hi-lock-tests when 'use-dialog-box' is non-nil
authorEli Zaretskii <eliz@gnu.org>
Sat, 18 Feb 2023 08:45:12 +0000 (10:45 +0200)
committerEli Zaretskii <eliz@gnu.org>
Sat, 18 Feb 2023 08:45:12 +0000 (10:45 +0200)
* 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

index aeb08ecbb29b4b49445c7fd877d1469b231f9c1a..794a3b1d0c2a16f38062ce03345ad693bc2c558c 100644 (file)
       (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)
       (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 ()
     (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