bug#40337: 28.0.50; Enable case-fold-search in hi-lock

[Juri Linkov]

>> +        (setq-local font-lock-keywords-case-fold-search 
>> hi-lock-case-fold-search)
>
> This affects all the font-lock-keywords, so it's likely to mess things
> up for the non-hi-lock keywords.
>
> I think we should change the patterns added to `font-lock-keywords`
> instead, such that they do
>
>     (let ((case-fold-search hi-lock-case-fold-search)) <...>)
>
> around the corresponding regexp search.

I tried this, and it works well.  Then instead of adding defcustom I copied
all related details from occur to highlight-regexp/highlight-symbol-at-point
and from isearch-occur to isearch-highlight-regexp to make occur/hi-lock
identical in regard how they handle case-folding (docstrings were copied too).

There is one remaining case that is unclear - whether to use
case-fold-search in hi-lock-process-phrase.  Its comment says:

    ;; FIXME fragile; better to just bind case-fold-search?  (Bug#7161)

But according to docstring of highlight-phrase:

  When called interactively, replace whitespace in user-provided
  regexp with arbitrary whitespace, and make initial lower-case
  letters case-insensitive, before highlighting with `hi-lock-set-pattern'.

I'm not sure if "make initial lower-case letters case-insensitive"
the same as this code

   (if (and case-fold-search search-upper-case)
       (isearch-no-upper-case-p regexp t)
     case-fold-search)

shared between occur and hi-lock in this patch:

diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index de258935e1..243be13405 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -434,6 +434,9 @@ hi-lock-line-face-buffer
 Interactively, prompt for REGEXP using `read-regexp', then FACE.
 Use the global history list for FACE.
 
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
 Use Font lock mode, if enabled, to highlight REGEXP.  Otherwise,
 use overlays for highlighting.  If overlays are used, the
 highlighting will not update as you type."
@@ -447,7 +450,10 @@ hi-lock-line-face-buffer
   (hi-lock-set-pattern
    ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
    ;; or a trailing $ in REGEXP will be interpreted correctly.
-   (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face))
+   (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face nil
+   (if (and case-fold-search search-upper-case)
+       (isearch-no-upper-case-p regexp t)
+     case-fold-search)))
 
 
 ;;;###autoload
@@ -460,6 +466,9 @@ hi-lock-face-buffer
 corresponding SUBEXP (interactively, the prefix argument) of REGEXP.
 If SUBEXP is omitted or nil, the entire REGEXP is highlighted.
 
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
 Use Font lock mode, if enabled, to highlight REGEXP.  Otherwise,
 use overlays for highlighting.  If overlays are used, the
 highlighting will not update as you type."
@@ -471,7 +480,11 @@ hi-lock-face-buffer
     current-prefix-arg))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
-  (hi-lock-set-pattern regexp face subexp))
+  (hi-lock-set-pattern
+   regexp face subexp
+   (if (and case-fold-search search-upper-case)
+       (isearch-no-upper-case-p regexp t)
+     case-fold-search)))
 
 ;;;###autoload
 (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -507,6 +520,9 @@ hi-lock-face-symbol-at-point
 unless you use a prefix argument.
 Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point.
 
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
 This uses Font lock mode if it is enabled; otherwise it uses overlays,
 in which case the highlighting will not update as you type."
   (interactive)
@@ -516,7 +532,11 @@ hi-lock-face-symbol-at-point
         (face (hi-lock-read-face-name)))
     (or (facep face) (setq face 'hi-yellow))
     (unless hi-lock-mode (hi-lock-mode 1))
-    (hi-lock-set-pattern regexp face)))
+    (hi-lock-set-pattern
+     regexp face nil
+     (if (and case-fold-search search-upper-case)
+         (isearch-no-upper-case-p regexp t)
+       case-fold-search))))
 
 (defun hi-lock-keyword->face (keyword)
   (cadr (cadr (cadr keyword))))    ; Keyword looks like (REGEXP (0 'FACE) ...).
@@ -713,14 +733,17 @@ hi-lock-read-face-name
       (add-to-list 'hi-lock-face-defaults face t))
     (intern face)))
 
-(defun hi-lock-set-pattern (regexp face &optional subexp)
+(defun hi-lock-set-pattern (regexp face &optional subexp case-fold)
   "Highlight SUBEXP of REGEXP with face FACE.
 If omitted or nil, SUBEXP defaults to zero, i.e. the entire
-REGEXP is highlighted."
+REGEXP is highlighted.  Non-nil CASE-FOLD ignores case."
   ;; Hashcons the regexp, so it can be passed to remove-overlays later.
   (setq regexp (hi-lock--hashcons regexp))
   (setq subexp (or subexp 0))
-  (let ((pattern (list regexp (list subexp (list 'quote face) 'prepend)))
+  (let ((pattern (list (lambda (limit)
+                         (let ((case-fold-search case-fold))
+                           (re-search-forward regexp limit t)))
+                       (list subexp (list 'quote face) 'prepend)))
         (no-matches t))
     ;; Refuse to highlight a text that is already highlighted.
     (if (assoc regexp hi-lock-interactive-patterns)
@@ -740,14 +763,15 @@ hi-lock-set-pattern
                      (+ range-max (max 0 (- (point-min) range-min))))))
           (save-excursion
             (goto-char search-start)
-            (while (re-search-forward regexp search-end t)
-              (when no-matches (setq no-matches nil))
-              (let ((overlay (make-overlay (match-beginning subexp)
-                                           (match-end subexp))))
-                (overlay-put overlay 'hi-lock-overlay t)
-                (overlay-put overlay 'hi-lock-overlay-regexp regexp)
-                (overlay-put overlay 'face face))
-              (goto-char (match-end 0)))
+            (let ((case-fold-search case-fold))
+              (while (re-search-forward regexp search-end t)
+                (when no-matches (setq no-matches nil))
+                (let ((overlay (make-overlay (match-beginning subexp)
+                                             (match-end subexp))))
+                  (overlay-put overlay 'hi-lock-overlay t)
+                  (overlay-put overlay 'hi-lock-overlay-regexp regexp)
+                  (overlay-put overlay 'face face))
+                (goto-char (match-end 0))))
             (when no-matches
               (add-to-list 'hi-lock--unused-faces (face-name face))
               (setq hi-lock-interactive-patterns
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 7625ec12b5..1f06c3ba5a 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2382,22 +2382,12 @@ isearch--highlight-regexp-or-lines
                        (funcall isearch-regexp-function isearch-string))
                      (isearch-regexp-function (word-search-regexp 
isearch-string))
                      (isearch-regexp isearch-string)
-                     ((if (and (eq isearch-case-fold-search t)
-                               search-upper-case)
-                          (isearch-no-upper-case-p
-                           isearch-string isearch-regexp)
-                        isearch-case-fold-search)
-                      ;; Turn isearch-string into a case-insensitive
-                      ;; regexp.
-                      (mapconcat
-                       (lambda (c)
-                         (let ((s (string c)))
-                           (if (string-match "[[:alpha:]]" s)
-                               (format "[%s%s]" (upcase s) (downcase s))
-                             (regexp-quote s))))
-                       isearch-string ""))
                      (t (regexp-quote isearch-string)))))
-    (funcall hi-lock-func regexp (hi-lock-read-face-name)))
+    (let ((case-fold-search isearch-case-fold-search)
+         ;; Set `search-upper-case' to nil to not call
+         ;; `isearch-no-upper-case-p' in `hi-lock'.
+         (search-upper-case nil))
+      (funcall hi-lock-func regexp (hi-lock-read-face-name))))
   (and isearch-recursive-edit (exit-recursive-edit)))
 
 (defun isearch-highlight-regexp ()