Package: emacs;
Reported by: Juri Linkov <juri <at> linkov.net>
Date: Mon, 30 Mar 2020 22:54:01 UTC
Severity: normal
Tags: fixed
Fixed in version 28.0.50
Done: Juri Linkov <juri <at> linkov.net>
Bug is archived. No further changes may be made.
Message #14 received at 40337 <at> debbugs.gnu.org (full text, mbox):
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Juri Linkov <juri <at> linkov.net> Cc: 40337 <at> debbugs.gnu.org Subject: Re: bug#40337: 28.0.50; Enable case-fold-search in hi-lock Date: Thu, 02 Apr 2020 19:02:33 -0400
> 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 ()
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.