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

[Stefan Monnier <monnier@iro.umontreal.ca>]

> 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).

Great, the patch looks good.

> 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:

I think it's a good interpretation of that docstring.  If needed
we could additionally tweak the docstring to clarify the behavior.


        Stefan


> 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 ()