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 #11 received at 40337 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: 40337 <at> debbugs.gnu.org Subject: Re: bug#40337: 28.0.50; Enable case-fold-search in hi-lock Date: Fri, 03 Apr 2020 00:31:38 +0300
[Message part 1 (text/plain, inline)]
>> + (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:
[hi-lock-case-fold.patch (text/x-diff, inline)]
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.