bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active

[Juri Linkov <juri@linkov.net>]

> This is an offshoot of #22520:
>
> Juri Linkov wrote:
>
>> > Another possible side effect of this is that highlighting
>> >
>> >   Database directory:
>> >
>> > doesn't work: hi-lock goes through the motions but nothing ends up being
>> > highlighted. Turning off char-folding fixes that.
>>
>> Actually “Database directory:” is not highlighted due to case-folding.
>> After toggling case-folding with ‘M-s c’ and preserving the capital D,
>> it's highlighted correctly.
>
> This is true! And it's really weird... The user expectation is that if
> we highlight something (M-s h r) directly from isearch, then at least
> the thing isearch was finding would be highlighted, and here this
> doesn't happen. So a slightly simpler example is:
>
> 0: Let the buffer have the string Ab
> 1: put the point on A
> 2: C-s
> 3: C-w (to isearch the whole thing)
> 4: M-s h r enter
>
> Then Ab isn't found because we defaulted to char-folding, and the regex was
>
>   \(?:a[̀-̄̆-̨̣̥̊̌̏̑]\|[aªà-åāăąǎȁȃȧᵃḁạảₐⓐａ𝐚𝑎𝒂𝒶𝓪𝔞𝕒𝖆𝖺𝗮𝘢𝙖𝚊]\)\(?:b[̣̱̇]\|[bᵇḃḅḇⓑｂ𝐛𝑏𝒃𝒷𝓫𝔟𝕓𝖇𝖻𝗯𝘣𝙗𝚋]\)
>
> This clearly has no case-folding active on top of the char-folding. But
> the isearch had both, so the regex should get both. This would make the
> regex twice as long, but it would be right, at least.
>
> If we turn off char-folding (but leave case-folding alone; on) by adding
> a step
>
> 2.5: M-s '
>
> then the regex we get is
>
>   [Aa][Bb]
>
> which clearly has the case-folding, and works the way we expect.

The problem is that with introduction of char-folding, a hack responsible
for case-folding in isearch-highlight-regexp that turns isearch-string
into a case-insensitive regexp is not used anymore, i.e. it's overridden by
isearch-regexp-function.  (Also note a FIXME comment in hi-lock-process-phrase)

Since we can't change the value of font-lock-keywords-case-fold-search
for font-lock based highlighting in hi-lock for individual regexps,
the best solution is to rely on the feature allowing MATCHER in
font-lock-keywords to be a function.  So we can let-bind case-fold-search
in its lambda.

Now the remaining problem is how to transfer case-fold from
isearch-highlight-regexp down to hi-lock-set-pattern.

Implementing pcre-style embedded modifiers is a good long-term goal,
but we need to fix this for the next release.  What options do we have now?
I see no other way than adding new argument to the chain of calls:

diff --git a/lisp/isearch.el b/lisp/isearch.el
index 2efa4c7..f77ef19 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1906,7 +1906,12 @@ isearch-highlight-regexp
 			      (regexp-quote s))))
 			isearch-string ""))
 		      (t (regexp-quote isearch-string)))))
-    (hi-lock-face-buffer regexp (hi-lock-read-face-name)))
+    (hi-lock-face-buffer regexp (hi-lock-read-face-name)
+                         (if (and (eq isearch-case-fold-search t)
+                                  search-upper-case)
+                             (isearch-no-upper-case-p
+                              isearch-string isearch-regexp)
+                           isearch-case-fold-search)))
   (and isearch-recursive-edit (exit-recursive-edit)))
 
 \f
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index ec14e0b..27a2ae6 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -432,7 +432,7 @@ hi-lock-line-face-buffer
 ;;;###autoload
 (defalias 'highlight-regexp 'hi-lock-face-buffer)
 ;;;###autoload
-(defun hi-lock-face-buffer (regexp &optional face)
+(defun hi-lock-face-buffer (regexp &optional face case-fold)
   "Set face of each match of REGEXP to FACE.
 Interactively, prompt for REGEXP using `read-regexp', then FACE.
 Use the global history list for FACE.
@@ -444,10 +444,11 @@ hi-lock-face-buffer
    (list
     (hi-lock-regexp-okay
      (read-regexp "Regexp to highlight" 'regexp-history-last))
-    (hi-lock-read-face-name)))
+    (hi-lock-read-face-name)
+    case-fold-search))
   (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 case-fold))
 
 ;;;###autoload
 (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -689,11 +690,17 @@ hi-lock-read-face-name
       (add-to-list 'hi-lock-face-defaults face t))
     (intern face)))
 
-(defun hi-lock-set-pattern (regexp face)
+(defun hi-lock-set-pattern (regexp face &optional case-fold)
   "Highlight REGEXP with face FACE."
   ;; Hashcons the regexp, so it can be passed to remove-overlays later.
   (setq regexp (hi-lock--hashcons regexp))
-  (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend))))
+  (let ((pattern (list (if (eq case-fold 'undefined)
+                           regexp
+                         (byte-compile
+                          `(lambda (limit)
+                             (let ((case-fold-search ,case-fold))
+                               (re-search-forward ,regexp limit t)))))
+                       (list 0 (list 'quote face) 'prepend))))
     ;; Refuse to highlight a text that is already highlighted.
     (unless (assoc regexp hi-lock-interactive-patterns)
       (push pattern hi-lock-interactive-patterns)
@@ -711,12 +718,13 @@ 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)
-              (let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
-                (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)
+                (let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
+                  (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))))))))))
 
 (defun hi-lock-set-file-patterns (patterns)
   "Replace file patterns list with PATTERNS and refontify."