Package: emacs;
Reported by: Dima Kogan <dima <at> secretsauce.net>
Date: Wed, 3 Feb 2016 06:30:02 UTC
Severity: normal
Tags: fixed
Found in version 25.0.50
Fixed in version 28.0.50
Done: Juri Linkov <juri <at> linkov.net>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 22541 in the body.
You can then email your comments to 22541 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Wed, 03 Feb 2016 06:30:02 GMT) Full text and rfc822 format available.Dima Kogan <dima <at> secretsauce.net>:bug-gnu-emacs <at> gnu.org.
(Wed, 03 Feb 2016 06:30:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Dima Kogan <dima <at> secretsauce.net> To: bug-gnu-emacs <at> gnu.org Subject: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Tue, 02 Feb 2016 22:29:22 -0800
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.
Dima Kogan <dima <at> secretsauce.net>
to control <at> debbugs.gnu.org.
(Thu, 25 Feb 2016 00:58:01 GMT) Full text and rfc822 format available.bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Tue, 01 Mar 2016 00:22:02 GMT) Full text and rfc822 format available.Message #10 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: Dima Kogan <dima <at> secretsauce.net> Cc: 22541 <at> debbugs.gnu.org Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Tue, 01 Mar 2016 02:14:15 +0200
> 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)))
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."
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Wed, 27 Apr 2016 05:03:02 GMT) Full text and rfc822 format available.Message #13 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Dima Kogan <dima <at> secretsauce.net> To: Juri Linkov <juri <at> linkov.net> Cc: 22541 <at> debbugs.gnu.org Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Tue, 26 Apr 2016 22:02:23 -0700
Juri Linkov <juri <at> linkov.net> writes: >> 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. >>> >>> ...... > > 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. Hi. Sorry it took me so long to reply to this. I haven't looked at isearch specifically in enough detail to comment on this, but if it makes this better, then I'm all for it :) > 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: > ... I've been looking long-term, and emacs-devel now has a thread about an initial implementation of one of the embedded modifiers. Since char-fold isn't the default anymore, maybe this issue isn't pressing and isn't critical to fix by emacs-25? Thanks dima
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Sat, 30 Apr 2016 20:11:02 GMT) Full text and rfc822 format available.Message #16 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: Dima Kogan <dima <at> secretsauce.net> Cc: 22541 <at> debbugs.gnu.org Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Sat, 30 Apr 2016 23:07:40 +0300
>>>> > 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. >>>> >>>> ...... >> >> 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. > > Hi. Sorry it took me so long to reply to this. I haven't looked at > isearch specifically in enough detail to comment on this, but if it > makes this better, then I'm all for it :) Fortunately, I'll have more time in May to help in fixing this. >> 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: >> ... > > I've been looking long-term, and emacs-devel now has a thread about an > initial implementation of one of the embedded modifiers. Since char-fold > isn't the default anymore, maybe this issue isn't pressing and isn't > critical to fix by emacs-25? Better to release emacs-25 with less bugs :)
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Sat, 22 Apr 2017 12:32:01 GMT) Full text and rfc822 format available.Message #19 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: Juri Linkov <juri <at> linkov.net> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net>, tino.calancha <at> gmail.com Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Sat, 22 Apr 2017 21:31:31 +0900
Juri Linkov <juri <at> linkov.net> writes:
> 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:
Hi Juri,
I think is a good moment to comeback to this issue once we have already
released Emacs 25.2.
I have updated your patch so that hi-lock-face-buffer checks search-upper-case
in interactive calls. It works OK.
Since there isn't recent activity in the implementation of the pcre-style
embedded modifiers, we might use your patch in the meantime.
--8<-----------------------------cut here---------------start------------->8---
commit 7c3a515ec92f4bd9e82393dff1fcc4a3c2bb03b4
Author: Juri Linkov <juri <at> linkov.net>
Date: Sat Apr 22 21:11:41 2017 +0900
highlight-regexp: Honor case-fold-search
Perform the matches of REGEXP as `isearch-forward' (Bug#22541).
* lisp/hi-lock.el (hi-lock-face-buffer, hi-lock-set-pattern):
Add optional arg CASE-FOLD. All callers updated.
* lisp/isearch.el (isearch-highlight-regexp): Call hi-lock-face-buffer
with 3 arguments.
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index ebd18621ef..845b52c6b6 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -432,8 +432,9 @@ 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.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
@@ -441,13 +442,18 @@ hi-lock-face-buffer
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
(interactive
- (list
- (hi-lock-regexp-okay
- (read-regexp "Regexp to highlight" 'regexp-history-last))
- (hi-lock-read-face-name)))
+ (let* ((reg
+ (hi-lock-regexp-okay
+ (read-regexp "Regexp to highlight" 'regexp-history-last)))
+ (face (hi-lock-read-face-name))
+ (fold
+ (if search-upper-case
+ (isearch-no-upper-case-p reg t)
+ case-fold-search)))
+ (list reg face fold)))
(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 +695,18 @@ hi-lock-read-face-name
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
-(defun hi-lock-set-pattern (regexp face)
- "Highlight REGEXP with face FACE."
+(defun hi-lock-set-pattern (regexp face &optional case-fold)
+ "Highlight REGEXP with face FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it."
;; 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 +724,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."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index c34739d638..250d37b45e 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1950,7 +1950,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)))
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-04-22
Repository revision: eb52828a439f674733ba70844b795c6673733572
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Sun, 23 Apr 2017 23:22:02 GMT) Full text and rfc822 format available.Message #22 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: Tino Calancha <tino.calancha <at> gmail.com> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net> Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Mon, 24 Apr 2017 02:18:06 +0300
> I think is a good moment to comeback to this issue once we have already > released Emacs 25.2. > I have updated your patch so that hi-lock-face-buffer checks search-upper-case > in interactive calls. It works OK. > Since there isn't recent activity in the implementation of the pcre-style > embedded modifiers, we might use your patch in the meantime. Thank you for taking care of this issue. If in your tests it works as expected, then I suppose this is the way to go.
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Tue, 25 Apr 2017 05:23:02 GMT) Full text and rfc822 format available.Message #25 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: Juri Linkov <juri <at> linkov.net> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net>, tino.calancha <at> gmail.com Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Tue, 25 Apr 2017 14:22:10 +0900
Juri Linkov <juri <at> linkov.net> writes:
>> I think is a good moment to comeback to this issue once we have already
>> released Emacs 25.2.
>> I have updated your patch so that hi-lock-face-buffer checks search-upper-case
>> in interactive calls. It works OK.
>> Since there isn't recent activity in the implementation of the pcre-style
>> embedded modifiers, we might use your patch in the meantime.
>
> Thank you for taking care of this issue. If in your tests it works
> as expected, then I suppose this is the way to go.
I updated the patch to make work `hi-lock-unface-buffer'. I added tests
as well.
Note that in interactive calls the case fold is determined with the
variables `search-upper-case' and `case-fold-search'. This way it behaves
as `isearch-forward-regexp'.
Before this bug case fold was determined _just_ with `case-fold-search'.
Do you prefer avoid `search-upper-case' in this case?
--8<-----------------------------cut here---------------start------------->8---
From 7cad27c0fcc39add8679d0893010c4fdb3ed507a Mon Sep 17 00:00:00 2001
From: Juri Linkov <juri <at> jurta.org>
Date: Tue, 25 Apr 2017 14:17:23 +0900
Subject: [PATCH] highlight-regexp: Honor case-fold-search
Perform the matches of REGEXP as `isearch-forward' i.e., in interactive
calls determine the case fold with `search-upper-case' and
`case-fold-search' (Bug#22541).
* lisp/hi-lock.el (hi-lock-face-buffer, hi-lock-set-pattern):
Add optional arg CASE-FOLD. All callers updated.
(hi-lock--regexps-at-point, hi-lock-unface-buffer):
Handle when pattern is a cons (REGEXP . FUNCTION).
* lisp/isearch.el (isearch-highlight-regexp): Call hi-lock-face-buffer
with 3 arguments.
Co-authored-by: Tino Calancha <tino.calancha <at> gmail.com>
---
lisp/hi-lock.el | 99 ++++++++++++++++++++++++++++++++++++++-------------------
lisp/isearch.el | 7 +++-
2 files changed, 73 insertions(+), 33 deletions(-)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index ebd18621ef..c9e0428f01 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -432,8 +432,9 @@ 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.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
@@ -441,13 +442,18 @@ hi-lock-face-buffer
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
(interactive
- (list
- (hi-lock-regexp-okay
- (read-regexp "Regexp to highlight" 'regexp-history-last))
- (hi-lock-read-face-name)))
+ (let* ((reg
+ (hi-lock-regexp-okay
+ (read-regexp "Regexp to highlight" 'regexp-history-last)))
+ (face (hi-lock-read-face-name))
+ (fold
+ (if search-upper-case
+ (isearch-no-upper-case-p reg t)
+ case-fold-search)))
+ (list reg face fold)))
(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)
@@ -530,10 +536,17 @@ hi-lock--regexps-at-point
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
- (let ((regexp (car hi-lock-pattern)))
- (if (string-match regexp hi-text)
- (push regexp regexps)))))))
- regexps))
+ (let ((regexp-or-fn (car hi-lock-pattern)))
+ (cond ((stringp regexp-or-fn)
+ (when (string-match regexp-or-fn hi-text)
+ (push regexp-or-fn regexps)))
+ (t
+ (with-temp-buffer
+ (insert hi-text)
+ (goto-char 1)
+ (when (funcall regexp-or-fn nil)
+ (push regexp-or-fn regexps)))))))
+ ))) regexps))
(defvar-local hi-lock--unused-faces nil
"List of faces that is not used and is available for highlighting new text.
@@ -561,13 +574,16 @@ hi-lock-unface-buffer
(cons
`keymap
(cons "Select Pattern to Unhighlight"
- (mapcar (lambda (pattern)
- (list (car pattern)
- (format
- "%s (%s)" (car pattern)
- (hi-lock-keyword->face pattern))
- (cons nil nil)
- (car pattern)))
+ (mapcar (lambda (pattern)
+ (let ((regexp (if (consp (car pattern))
+ (caar pattern)
+ (car pattern))))
+ (list regexp
+ (format
+ "%s (%s)" regexp
+ (hi-lock-keyword->face pattern))
+ (cons nil nil)
+ regexp)))
hi-lock-interactive-patterns))))
;; If the user clicks outside the menu, meaning that they
;; change their mind, x-popup-menu returns nil, and
@@ -581,16 +597,24 @@ hi-lock-unface-buffer
(error "No highlighting to remove"))
;; Infer the regexp to un-highlight based on cursor position.
(let* ((defaults (or (hi-lock--regexps-at-point)
- (mapcar #'car hi-lock-interactive-patterns))))
+ (mapcar (lambda (x)
+ (if (consp (car x)) (caar x) (car x)))
+ hi-lock-interactive-patterns))))
(list
(completing-read (if (null defaults)
"Regexp to unhighlight: "
(format "Regexp to unhighlight (default %s): "
(car defaults)))
hi-lock-interactive-patterns
- nil t nil nil defaults))))))
- (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
- (list (assoc regexp hi-lock-interactive-patterns))))
+ nil nil nil nil defaults))))))
+ (let ((keys
+ (mapcar (lambda (x)
+ (if (consp (car x))
+ (cons (caar x) (cdr x))
+ x))
+ hi-lock-interactive-patterns)))
+ (dolist (keyword (if (eq regexp t) keys
+ (list (assoc regexp keys))))
(when keyword
(let ((face (hi-lock-keyword->face keyword)))
;; Make `face' the next one to use by default.
@@ -606,7 +630,7 @@ hi-lock-unface-buffer
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword)))
- (font-lock-flush))))
+ (font-lock-flush)))))
;;;###autoload
(defun hi-lock-write-interactive-patterns ()
@@ -689,15 +713,25 @@ hi-lock-read-face-name
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
-(defun hi-lock-set-pattern (regexp face)
- "Highlight REGEXP with face FACE."
+(defun hi-lock-set-pattern (regexp face &optional case-fold)
+ "Highlight REGEXP with face FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it."
;; 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
+ (cons 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)
- (if (and font-lock-mode (font-lock-specified-p major-mode))
+ (if (and font-lock-mode
+ (font-lock-specified-p major-mode)
+ (not (consp pattern)))
(progn
(font-lock-add-keywords nil (list pattern) t)
(font-lock-flush))
@@ -711,12 +745,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."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index c34739d638..250d37b45e 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1950,7 +1950,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)))
--
2.11.0
From f0f68d2a2049b549a6690f411dd746cb4333f99b Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Tue, 25 Apr 2017 14:18:00 +0900
Subject: [PATCH] * test/lisp/hi-lock-tests.el: Add test.
---
test/lisp/hi-lock-tests.el | 90 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 90 insertions(+)
create mode 100644 test/lisp/hi-lock-tests.el
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
new file mode 100644
index 0000000000..836fbe9a89
--- /dev/null
+++ b/test/lisp/hi-lock-tests.el
@@ -0,0 +1,90 @@
+;;; hi-lock-tests.el --- Tests for hi-lock.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calancha <tino.calancha <at> gmail.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'hi-lock)
+(eval-when-compile (require 'cl-lib))
+
+(defun hi-lock--count (face)
+ (let ((count 0))
+ (save-excursion
+ (goto-char (point-min))
+ (dolist (ov (car (overlay-lists)))
+ (let ((props (memq 'face (overlay-properties ov))))
+ (when (eq (cadr props) face)
+ (cl-incf count)))))
+ count))
+
+(defun hi-lock--highlight-and-count (regexp face case-fold)
+ "Highlight REGEXP with FACE with case fold CASE-FOLD.
+Return number of matches."
+ (hi-lock-unface-buffer t)
+ (should (eq 0 (hi-lock--count face)))
+ (hi-lock-face-buffer regexp face case-fold)
+ (hi-lock--count face))
+
+(defun hi-lock--interactive-test-1 (regexp face res ucase cfold)
+ (hi-lock-unface-buffer t)
+ (should (eq 0 (hi-lock--count face)))
+ (cl-letf (((symbol-function 'read-regexp)
+ (lambda (x y) (ignore x y) regexp))
+ ((symbol-function 'hi-lock-read-face-name)
+ (lambda () face)))
+ (setq search-upper-case ucase
+ case-fold-search cfold)
+ (call-interactively 'hi-lock-face-buffer)
+ (should (= res (hi-lock--count face)))))
+
+;; Interactive test should not depend on the major mode.
+(defun hi-lock--interactive-test (regexp face res ucase cfold)
+ (lisp-interaction-mode)
+ (hi-lock--interactive-test-1 regexp face res ucase cfold)
+ (fundamental-mode)
+ (hi-lock--interactive-test-1 regexp face res ucase cfold))
+
+;; In batch calls to `hi-lock-face-buffer', case is given by
+;; its third argument. In interactive calls, case depends
+;; on `search-upper-case' and `case-fold-search'.
+(ert-deftest hi-lock-face-buffer-test ()
+ "Test for http://debbugs.gnu.org/22541 ."
+ (let ((face 'hi-yellow)
+ (regexp "a")
+ case-fold-search search-upper-case)
+ (with-temp-buffer
+ (insert "a A\n")
+ (should (= 1 (hi-lock--highlight-and-count regexp face nil)))
+ (should (= 2 (hi-lock--highlight-and-count regexp face t)))
+ ;; Case depends on the regexp.
+ (hi-lock--interactive-test regexp face 2 t nil)
+ (hi-lock--interactive-test "A" face 1 t nil)
+ (hi-lock--interactive-test "\\A" face 2 t nil)
+ ;; Case depends on `case-fold-search'.
+ (hi-lock--interactive-test "a" face 1 nil nil)
+ (hi-lock--interactive-test "A" face 1 nil nil)
+ (hi-lock--interactive-test "\\A" face 1 nil nil)
+ ;;
+ (hi-lock--interactive-test "a" face 2 nil t)
+ (hi-lock--interactive-test "A" face 2 nil t)
+ (hi-lock--interactive-test "\\A" face 2 nil t))))
+
+(provide 'hi-lock-tests)
+;;; hi-lock-tests.el ends here
--
2.11.0
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-04-25
Repository revision: 622c24a2b75a564b9861fc3ca7a7878741e8568d
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Tue, 25 Apr 2017 20:59:02 GMT) Full text and rfc822 format available.Message #28 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: Tino Calancha <tino.calancha <at> gmail.com> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net> Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Tue, 25 Apr 2017 23:52:06 +0300
> I updated the patch to make work `hi-lock-unface-buffer'. I added tests
> as well.
>
> Note that in interactive calls the case fold is determined with the
> variables `search-upper-case' and `case-fold-search'. This way it behaves
> as `isearch-forward-regexp'.
> Before this bug case fold was determined _just_ with `case-fold-search'.
> Do you prefer avoid `search-upper-case' in this case?
Since ‘search-upper-case’ is used by other commands such as ‘occur’ and
‘perform-replace’, I think ‘hi-lock’ should use it as well.
>>From 7cad27c0fcc39add8679d0893010c4fdb3ed507a Mon Sep 17 00:00:00 2001
> From: Juri Linkov <juri <at> jurta.org>
> Date: Tue, 25 Apr 2017 14:17:23 +0900
> Subject: [PATCH] highlight-regexp: Honor case-fold-search
> ...
> Co-authored-by: Tino Calancha <tino.calancha <at> gmail.com>
I recommend to commit first my old patch, and then later your changes over it.
> -(defun hi-lock-face-buffer (regexp &optional face)
> +(defun hi-lock-face-buffer (regexp &optional face case-fold)
> ...
> + (let* ((reg
> + (hi-lock-regexp-okay
> + (read-regexp "Regexp to highlight" 'regexp-history-last)))
> + (face (hi-lock-read-face-name))
> + (fold
> + (if search-upper-case
> + (isearch-no-upper-case-p reg t)
> + case-fold-search)))
> + (list reg face fold)))
Small thing, but for readability in the interactive spec better to use
the same variable names as argument names:
(list regexp face case-fold)
> -(defun hi-lock-set-pattern (regexp face)
> - "Highlight REGEXP with face FACE."
> +(defun hi-lock-set-pattern (regexp face &optional case-fold)
> + "Highlight REGEXP with face FACE.
> +If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it."
> ;; 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
> + (cons regexp
> + (byte-compile
> + `(lambda (limit)
> + (let ((case-fold-search ,case-fold))
> + (re-search-forward ,regexp limit t))))))
> + (list 0 (list 'quote face) 'prepend))))
Do you need to remember also the value of ‘case-fold-search’
(together with ‘regexp’)?
> @@ -1950,7 +1950,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)))
If this works reliably, then we could remove that ugly hack
from ‘isearch-highlight-regexp’, I mean the one with the comment
“Turn isearch-string into a case-insensitive regexp”.
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Thu, 27 Apr 2017 14:23:01 GMT) Full text and rfc822 format available.Message #31 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: Juri Linkov <juri <at> linkov.net> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net>, tino.calancha <at> gmail.com Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Thu, 27 Apr 2017 23:22:05 +0900
Juri Linkov <juri <at> linkov.net> writes:
Thanks for the feedback!
>> -(defun hi-lock-set-pattern (regexp face)
>> - "Highlight REGEXP with face FACE."
>> +(defun hi-lock-set-pattern (regexp face &optional case-fold)
>> + "Highlight REGEXP with face FACE.
>> +If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it."
>> ;; 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
>> + (cons regexp
>> + (byte-compile
>> + `(lambda (limit)
>> + (let ((case-fold-search ,case-fold))
>> + (re-search-forward ,regexp limit t))))))
>> + (list 0 (list 'quote face) 'prepend))))
>
> Do you need to remember also the value of ‘case-fold-search’
> (together with ‘regexp’)?
AFAICT i don't need it.
>> @@ -1950,7 +1950,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)))
>
> If this works reliably, then we could remove that ugly hack
> from ‘isearch-highlight-regexp’, I mean the one with the comment
> “Turn isearch-string into a case-insensitive regexp”.
That's right. We don't need such trick here anymore. But this hack
turned ut to be useful in hi-lock.el.
The new patch, in addition to fix this bug report, it also
helps with the 5. in bug#22520, that is:
emacs -Q
M-s hr t RET RET ; Highlight with regexp "[Tt]"
M-s hu t RET ; Unhighlight the buffer.
--8<-----------------------------cut here---------------start------------->8---
From 5183897b88b93060ce391f166cdeebf605785362 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Thu, 27 Apr 2017 23:02:41 +0900
Subject: [PATCH] highlight-regexp: Honor case-fold-search
* lisp/hi-lock.el (hi-lock-face-buffer, hi-lock-set-pattern):
Add optional arg CASE-FOLD. All callers updated.
* lisp/isearch.el (isearch-highlight-regexp): Call hi-lock-face-buffer
with 3 arguments.
---
lisp/hi-lock.el | 30 +++++++++++++++++++-----------
lisp/isearch.el | 7 ++++++-
2 files changed, 25 insertions(+), 12 deletions(-)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 5139e01fa8..55ad3ccb58 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.
(if (assoc regexp hi-lock-interactive-patterns)
(add-to-list 'hi-lock--unused-faces (face-name face))
@@ -712,12 +719,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."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index c34739d638..250d37b45e 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1950,7 +1950,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)))
--
2.11.0
From 32ec762b9459cf2a1b50217fa061c70541c0a241 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Thu, 27 Apr 2017 23:05:01 +0900
Subject: [PATCH] Fix hi-lock-unface-buffer from last commit
Perform the matches of REGEXP as `isearch-forward' i.e., in interactive
calls determine the case fold with `search-upper-case' and
`case-fold-search' (Bug#22541).
* lisp/hi-lock.el (hi-lock-face-buffer): Update docstring.
Determine the case fold with `search-upper-case' and
`case-fold-search'.
(hi-lock--regexps-at-point, hi-lock-unface-buffer):
Handle when pattern is a cons (REGEXP . FUNCTION).
(hi-lock-read-face-name): Update docstring.
(hi-lock--case-insensitive-regexp,
hi-lock--case-insensitive-regexp-p): New defuns.
(hi-lock-set-pattern, hi-lock-unface-buffer): Use them.
* lisp/isearch.el (isearch-highlight-regexp): Delete hack for
case-insensitive search; this is now handled in
hi-lock-face-buffer.
* test/lisp/hi-lock-tests.el (hi-lock-face-buffer-test, hi-lock-bug22520):
Add tests.
---
lisp/hi-lock.el | 153 +++++++++++++++++++++++++++++++++------------
lisp/isearch.el | 10 +--
test/lisp/hi-lock-tests.el | 91 ++++++++++++++++++++++++++-
3 files changed, 204 insertions(+), 50 deletions(-)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 55ad3ccb58..5862974844 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -434,6 +434,7 @@ 'highlight-regexp
;;;###autoload
(defun hi-lock-face-buffer (regexp &optional face case-fold)
"Set face of each match of REGEXP to FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
@@ -441,11 +442,15 @@ hi-lock-face-buffer
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
(interactive
- (list
- (hi-lock-regexp-okay
- (read-regexp "Regexp to highlight" 'regexp-history-last))
- (hi-lock-read-face-name)
- case-fold-search))
+ (let* ((regexp
+ (hi-lock-regexp-okay
+ (read-regexp "Regexp to highlight" 'regexp-history-last)))
+ (face (hi-lock-read-face-name))
+ (case-fold
+ (if search-upper-case
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
+ (list regexp face case-fold)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern regexp face case-fold))
@@ -531,10 +536,17 @@ hi-lock--regexps-at-point
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
- (let ((regexp (car hi-lock-pattern)))
- (if (string-match regexp hi-text)
- (push regexp regexps)))))))
- regexps))
+ (let ((regexp-or-fn (car hi-lock-pattern)))
+ (cond ((stringp regexp-or-fn)
+ (when (string-match regexp-or-fn hi-text)
+ (push regexp-or-fn regexps)))
+ (t
+ (with-temp-buffer
+ (insert hi-text)
+ (goto-char 1)
+ (when (funcall regexp-or-fn nil)
+ (push regexp-or-fn regexps)))))))
+ ))) regexps))
(defvar-local hi-lock--unused-faces nil
"List of faces that is not used and is available for highlighting new text.
@@ -562,13 +574,15 @@ hi-lock-unface-buffer
(cons
`keymap
(cons "Select Pattern to Unhighlight"
- (mapcar (lambda (pattern)
- (list (car pattern)
- (format
- "%s (%s)" (car pattern)
- (hi-lock-keyword->face pattern))
- (cons nil nil)
- (car pattern)))
+ (mapcar (lambda (pattern)
+ (let ((regexp (or (car-safe (car pattern))
+ (car pattern))))
+ (list regexp
+ (format
+ "%s (%s)" regexp
+ (hi-lock-keyword->face pattern))
+ (cons nil nil)
+ regexp)))
hi-lock-interactive-patterns))))
;; If the user clicks outside the menu, meaning that they
;; change their mind, x-popup-menu returns nil, and
@@ -582,16 +596,30 @@ hi-lock-unface-buffer
(error "No highlighting to remove"))
;; Infer the regexp to un-highlight based on cursor position.
(let* ((defaults (or (hi-lock--regexps-at-point)
- (mapcar #'car hi-lock-interactive-patterns))))
- (list
- (completing-read (if (null defaults)
- "Regexp to unhighlight: "
- (format "Regexp to unhighlight (default %s): "
- (car defaults)))
- hi-lock-interactive-patterns
- nil t nil nil defaults))))))
- (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
- (list (assoc regexp hi-lock-interactive-patterns))))
+ (mapcar (lambda (x)
+ (or (car-safe (car x))
+ (car x)))
+ hi-lock-interactive-patterns)))
+ (regexp (completing-read (if (null defaults)
+ "Regexp to unhighlight: "
+ (format "Regexp to unhighlight (default %s): "
+ (car defaults)))
+ hi-lock-interactive-patterns
+ nil nil nil nil defaults)))
+ (when (and (or (not search-upper-case)
+ (isearch-no-upper-case-p regexp t))
+ case-fold-search
+ (not (hi-lock--case-insensitive-regexp-p regexp)))
+ (setq regexp (hi-lock--case-insensitive-regexp regexp)))
+ (list regexp)))))
+ (let* ((patterns hi-lock-interactive-patterns)
+ (keys (or (assoc regexp patterns)
+ (assoc
+ (assoc regexp (mapcar #'car patterns))
+ patterns))))
+ (dolist (keyword (if (eq regexp t)
+ patterns
+ (list keys)))
(when keyword
(let ((face (hi-lock-keyword->face keyword)))
;; Make `face' the next one to use by default.
@@ -606,8 +634,10 @@ hi-lock-unface-buffer
(setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
- nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword)))
- (font-lock-flush))))
+ nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons
+ (or (car-safe (car keyword))
+ (car keyword))))
+ (font-lock-flush)))))
;;;###autoload
(defun hi-lock-write-interactive-patterns ()
@@ -690,23 +720,67 @@ hi-lock-read-face-name
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
+(defun hi-lock--case-insensitive-regexp-p (regexp)
+ (let (case-fold-search)
+ (and (string-match-p regexp (downcase regexp))
+ (string-match-p regexp (upcase regexp)))))
+
+(defun hi-lock--case-insensitive-regexp (regexp)
+ "Turn regexp into a case-insensitive regexp."
+ (let ((count 0)
+ (upper-re "[[:upper:]]")
+ (slash-upper-re "\\(\\\\\\)\\([[:upper:]]\\)")
+ case-fold-search)
+ (cond ((or (hi-lock--case-insensitive-regexp-p regexp)
+ (and (string-match upper-re regexp)
+ (not (string-match slash-upper-re regexp))))
+ regexp)
+ (t
+ (let ((string regexp))
+ (while (string-match slash-upper-re string)
+ (setq string (replace-match "" t t string 1)))
+ (setq regexp string)
+ (mapconcat
+ (lambda (c)
+ (let ((s (string c)))
+ (cond ((or (eq c ?\\)
+ (and (= count 1) (string= s (upcase s))))
+ (setq count (1+ count)) s)
+ (t
+ (setq count 0)
+ (if (string-match "[[:alpha:]]" s)
+ (format "[%s%s]" (upcase s) (downcase s))
+ (regexp-quote s))))))
+ regexp ""))))))
+
(defun hi-lock-set-pattern (regexp face &optional case-fold)
- "Highlight REGEXP with face FACE."
+ "Highlight REGEXP with face FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
- (let ((pattern (list (if (eq case-fold 'undefined)
+ (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))))
+ (cons regexp
+ (byte-compile
+ `(lambda (limit)
+ (let ((case-fold-search ,case-fold))
+ (re-search-forward ,regexp limit t))))))
+ (list 0 (list 'quote face) 'prepend)))
+ (regexp-fold
+ (cond ((not (consp (car pattern)))
+ (car pattern))
+ (t
+ (if (not case-fold)
+ (caar pattern)
+ (hi-lock--case-insensitive-regexp (caar pattern)))))))
;; Refuse to highlight a text that is already highlighted.
- (if (assoc regexp hi-lock-interactive-patterns)
+ (if (or (assoc regexp hi-lock-interactive-patterns)
+ (assoc regexp-fold hi-lock-interactive-patterns)
+ (assoc regexp-fold (mapcar #'car hi-lock-interactive-patterns)))
(add-to-list 'hi-lock--unused-faces (face-name face))
- (push pattern hi-lock-interactive-patterns)
(if (and font-lock-mode (font-lock-specified-p major-mode))
- (progn
+ (progn
+ (setq pattern (list regexp-fold (list 0 (list 'quote face) 'prepend)))
(font-lock-add-keywords nil (list pattern) t)
(font-lock-flush))
(let* ((range-min (- (point) (/ hi-lock-highlight-range 2)))
@@ -725,7 +799,8 @@ hi-lock-set-pattern
(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))))))))))
+ (goto-char (match-end 0)))))))
+ (push pattern hi-lock-interactive-patterns))))
(defun hi-lock-set-file-patterns (patterns)
"Replace file patterns list with PATTERNS and refontify."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 250d37b45e..2496e092a6 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1940,15 +1940,7 @@ isearch-highlight-regexp
(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 ""))
+ isearch-string)
(t (regexp-quote isearch-string)))))
(hi-lock-face-buffer regexp (hi-lock-read-face-name)
(if (and (eq isearch-case-fold-search t)
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index 2cb662cfac..1d97e1f054 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -22,6 +22,7 @@
(require 'ert)
(require 'hi-lock)
+(eval-when-compile (require 'cl-lib))
(ert-deftest hi-lock-bug26666 ()
"Test for http://debbugs.gnu.org/26666 ."
@@ -29,12 +30,98 @@
(with-temp-buffer
(insert "a A b B\n")
(cl-letf (((symbol-function 'completing-read)
- (lambda (prompt coll x y z hist defaults)
- (car defaults))))
+ (lambda (prompt coll x y z hist defaults)
+ (car defaults))))
(dotimes (_ 2)
(let ((face (hi-lock-read-face-name)))
(hi-lock-set-pattern "a" face))))
(should (equal hi-lock--unused-faces (cdr faces))))))
+(defun hi-lock--count (face)
+ (let ((count 0))
+ (save-excursion
+ (goto-char (point-min))
+ (cond ((and font-lock-mode (font-lock-specified-p major-mode))
+ (when (and (consp (get-text-property (point) 'face))
+ (memq 'hi-yellow (get-text-property (point) 'face)))
+ (cl-incf count))
+ (while (next-property-change (point))
+ (goto-char (next-property-change (point)))
+ (when (and (consp (get-text-property (point) 'face))
+ (memq 'hi-yellow (get-text-property (point) 'face)))
+ (cl-incf count))))
+ (t
+ (dolist (ov (car (overlay-lists)))
+ (let ((props (memq 'face (overlay-properties ov))))
+ (when (eq (cadr props) face)
+ (cl-incf count)))))))
+ count))
+
+(defun hi-lock--highlight-and-count (regexp face case-fold)
+ "Highlight REGEXP with FACE with case fold CASE-FOLD.
+Return number of matches."
+ (hi-lock-unface-buffer t)
+ (should (eq 0 (hi-lock--count face)))
+ (hi-lock-face-buffer regexp face case-fold)
+ (hi-lock--count face))
+
+(defun hi-lock--interactive-test-1 (regexp face res ucase cfold)
+ (hi-lock-unface-buffer t)
+ (should (eq 0 (hi-lock--count face)))
+ (cl-letf (((symbol-function 'read-regexp)
+ (lambda (x y) (ignore x y) regexp))
+ ((symbol-function 'hi-lock-read-face-name)
+ (lambda () face)))
+ (setq search-upper-case ucase
+ case-fold-search cfold)
+ (call-interactively 'hi-lock-face-buffer)
+ (should (= res (hi-lock--count face)))))
+
+;; Interactive test should not depend on the major mode.
+(defun hi-lock--interactive-test (regexp face res ucase cfold)
+ (lisp-interaction-mode)
+ (hi-lock--interactive-test-1 regexp face res ucase cfold)
+ (fundamental-mode)
+ (hi-lock--interactive-test-1 regexp face res ucase cfold))
+
+;; In batch calls to `hi-lock-face-buffer', case is given by
+;; its third argument. In interactive calls, case depends
+;; on `search-upper-case' and `case-fold-search'.
+(ert-deftest hi-lock-face-buffer-test ()
+ "Test for http://debbugs.gnu.org/22541 ."
+ (let ((face 'hi-yellow)
+ (regexp "a")
+ case-fold-search search-upper-case)
+ (with-temp-buffer
+ (insert "a A\n")
+ (should (= 1 (hi-lock--highlight-and-count regexp face nil)))
+ (should (= 2 (hi-lock--highlight-and-count regexp face t)))
+ ;; Case depends on the regexp.
+ (hi-lock--interactive-test regexp face 2 t nil)
+ (hi-lock--interactive-test "A" face 1 t nil)
+ (hi-lock--interactive-test "\\A" face 2 t nil)
+ ;; Case depends on `case-fold-search'.
+ (hi-lock--interactive-test "a" face 1 nil nil)
+ (hi-lock--interactive-test "A" face 1 nil nil)
+ (hi-lock--interactive-test "\\A" face 1 nil nil)
+ ;;
+ (hi-lock--interactive-test "a" face 2 nil t)
+ (hi-lock--interactive-test "A" face 2 nil t)
+ (hi-lock--interactive-test "\\A" face 2 nil t))))
+
+(ert-deftest hi-lock-bug22520 ()
+ "Test for http://debbugs.gnu.org/22520 ."
+ (with-temp-buffer
+ (erase-buffer)
+ (insert "foo and Foo")
+ (dolist (ucase '(nil t))
+ (dolist (cfold '(nil t))
+ (let ((res (cond ((null ucase)
+ (if cfold 2 1))
+ (t 2))))
+ (hi-lock--interactive-test "f" 'hi-yellow res ucase cfold)
+ (hi-lock-unface-buffer "f")
+ (should (= 0 (hi-lock--count 'hi-yellow))))))))
+
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here
--
2.11.0
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-04-27
Repository revision: 79c5ea9911a9aba7db0ba0e367e06507cee2fc02
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Tue, 09 May 2017 22:13:02 GMT) Full text and rfc822 format available.Message #34 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: Tino Calancha <tino.calancha <at> gmail.com> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net> Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Wed, 10 May 2017 01:10:03 +0300
>>> @@ -1950,7 +1950,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))) >> >> If this works reliably, then we could remove that ugly hack >> from ‘isearch-highlight-regexp’, I mean the one with the comment >> “Turn isearch-string into a case-insensitive regexp”. > That's right. We don't need such trick here anymore. But this hack > turned ut to be useful in hi-lock.el. > > The new patch, in addition to fix this bug report, it also > helps with the 5. in bug#22520, that is: > emacs -Q > M-s hr t RET RET ; Highlight with regexp "[Tt]" > M-s hu t RET ; Unhighlight the buffer. Thanks, could you find more test cases that still don't work?
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Wed, 24 May 2017 13:36:01 GMT) Full text and rfc822 format available.Message #37 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: Juri Linkov <juri <at> linkov.net> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net> Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Wed, 24 May 2017 22:35:41 +0900
Juri Linkov <juri <at> linkov.net> writes: >> The new patch, in addition to fix this bug report, it also >> helps with the 5. in bug#22520, that is: >> emacs -Q >> M-s hr t RET RET ; Highlight with regexp "[Tt]" >> M-s hu t RET ; Unhighlight the buffer. > > Thanks, could you find more test cases that still don't work? Yes i did. We need to fold according with `search-upper-case' and `case-fold-search' for `hi-lock-face-phrase-buffer' and `hi-lock-line-face-buffer' as well. I am posting the updated patch in a few days after after test it.
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Thu, 25 May 2017 12:13:02 GMT) Full text and rfc822 format available.Message #40 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Tino Calancha <tino.calancha <at> gmail.com> To: Juri Linkov <juri <at> linkov.net> Cc: 22541 <at> debbugs.gnu.org, Dima Kogan <dima <at> secretsauce.net>, tino.calancha <at> gmail.com Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Thu, 25 May 2017 21:11:49 +0900
Tino Calancha <tino.calancha <at> gmail.com> writes:
> Juri Linkov <juri <at> linkov.net> writes:
>
>>> The new patch, in addition to fix this bug report, it also
>>> helps with the 5. in bug#22520, that is:
>>> emacs -Q
>>> M-s hr t RET RET ; Highlight with regexp "[Tt]"
>>> M-s hu t RET ; Unhighlight the buffer.
>>
>> Thanks, could you find more test cases that still don't work?
> Yes i did. We need to fold according with `search-upper-case' and
> `case-fold-search' for `hi-lock-face-phrase-buffer' and
> `hi-lock-line-face-buffer' as well.
> I am posting the updated patch in a few days after after test it.
Hi Juri,
I have updated the patch. It's harder than i expected.
Maybe I am missing something.
Could you take a look on it?
The new patch seems to handle `case-fold-search'
correctly for the 4 commands:
`hi-lock-face-buffer'
`hi-lock-line-face-buffer'
`hi-lock-face-symbol-at-point'
`hi-lock-face-phrase-buffer'.
That's seems true regardless of the value of
(font-lock-specified-p major-mode)
--8<-----------------------------cut here---------------start------------->8---
From 234c6189f9c6f978c7a4039cd2ff186805b1c3f3 Mon Sep 17 00:00:00 2001
From: Juri Linkov <juri <at> jurta.org>
Date: Thu, 25 May 2017 11:00:09 +0900
Subject: [PATCH 1/3] highlight-regexp: Honor case-fold-search
* lisp/hi-lock.el (hi-lock-face-buffer, hi-lock-set-pattern):
Add optional arg CASE-FOLD. All callers updated.
* lisp/isearch.el (isearch-highlight-regexp): Call hi-lock-face-buffer
with 3 arguments.
---
lisp/hi-lock.el | 30 +++++++++++++++++++-----------
lisp/isearch.el | 7 ++++++-
2 files changed, 25 insertions(+), 12 deletions(-)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 5139e01fa8..55ad3ccb58 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.
(if (assoc regexp hi-lock-interactive-patterns)
(add-to-list 'hi-lock--unused-faces (face-name face))
@@ -712,12 +719,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."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index c34739d638..250d37b45e 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1950,7 +1950,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)))
--
2.11.0
From 705f90014547c446cc7fd1df35f2d8d16e630771 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Thu, 25 May 2017 11:22:06 +0900
Subject: [PATCH 2/3] Fix hi-lock-unface-buffer from last commit
Perform the matches of REGEXP as `isearch-forward' i.e.,
in interactive calls determine the case fold with
`search-upper-case' and `case-fold-search' (Bug#22541).
A call to `hi-lock-unface-buffer' with the input used in
`hi-lock-face-buffer' must unhighlight that pattern,
regardless of the actual internal regexp used (Bug#22520).
* lisp/hi-lock.el (hi-lock-face-buffer): Update docstring.
Determine the case fold with `search-upper-case' and
`case-fold-search'.
(hi-lock--regexps-at-point, hi-lock-unface-buffer):
Handle when pattern is a cons (REGEXP . FUNCTION).
(hi-lock-read-face-name): Update docstring.
(hi-lock--case-insensitive-regexp,
hi-lock--case-insensitive-regexp-p): New defuns.
(hi-lock-set-pattern, hi-lock-unface-buffer): Use them.
* lisp/isearch.el (isearch-highlight-regexp): Delete hack for
case-insensitive search; this is now handled in
hi-lock-face-buffer.
---
lisp/hi-lock.el | 153 +++++++++++++++++++++++++++++++++++++++++---------------
lisp/isearch.el | 10 +---
2 files changed, 115 insertions(+), 48 deletions(-)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 55ad3ccb58..5862974844 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -434,6 +434,7 @@ 'highlight-regexp
;;;###autoload
(defun hi-lock-face-buffer (regexp &optional face case-fold)
"Set face of each match of REGEXP to FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
@@ -441,11 +442,15 @@ hi-lock-face-buffer
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
(interactive
- (list
- (hi-lock-regexp-okay
- (read-regexp "Regexp to highlight" 'regexp-history-last))
- (hi-lock-read-face-name)
- case-fold-search))
+ (let* ((regexp
+ (hi-lock-regexp-okay
+ (read-regexp "Regexp to highlight" 'regexp-history-last)))
+ (face (hi-lock-read-face-name))
+ (case-fold
+ (if search-upper-case
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
+ (list regexp face case-fold)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern regexp face case-fold))
@@ -531,10 +536,17 @@ hi-lock--regexps-at-point
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
- (let ((regexp (car hi-lock-pattern)))
- (if (string-match regexp hi-text)
- (push regexp regexps)))))))
- regexps))
+ (let ((regexp-or-fn (car hi-lock-pattern)))
+ (cond ((stringp regexp-or-fn)
+ (when (string-match regexp-or-fn hi-text)
+ (push regexp-or-fn regexps)))
+ (t
+ (with-temp-buffer
+ (insert hi-text)
+ (goto-char 1)
+ (when (funcall regexp-or-fn nil)
+ (push regexp-or-fn regexps)))))))
+ ))) regexps))
(defvar-local hi-lock--unused-faces nil
"List of faces that is not used and is available for highlighting new text.
@@ -562,13 +574,15 @@ hi-lock-unface-buffer
(cons
`keymap
(cons "Select Pattern to Unhighlight"
- (mapcar (lambda (pattern)
- (list (car pattern)
- (format
- "%s (%s)" (car pattern)
- (hi-lock-keyword->face pattern))
- (cons nil nil)
- (car pattern)))
+ (mapcar (lambda (pattern)
+ (let ((regexp (or (car-safe (car pattern))
+ (car pattern))))
+ (list regexp
+ (format
+ "%s (%s)" regexp
+ (hi-lock-keyword->face pattern))
+ (cons nil nil)
+ regexp)))
hi-lock-interactive-patterns))))
;; If the user clicks outside the menu, meaning that they
;; change their mind, x-popup-menu returns nil, and
@@ -582,16 +596,30 @@ hi-lock-unface-buffer
(error "No highlighting to remove"))
;; Infer the regexp to un-highlight based on cursor position.
(let* ((defaults (or (hi-lock--regexps-at-point)
- (mapcar #'car hi-lock-interactive-patterns))))
- (list
- (completing-read (if (null defaults)
- "Regexp to unhighlight: "
- (format "Regexp to unhighlight (default %s): "
- (car defaults)))
- hi-lock-interactive-patterns
- nil t nil nil defaults))))))
- (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
- (list (assoc regexp hi-lock-interactive-patterns))))
+ (mapcar (lambda (x)
+ (or (car-safe (car x))
+ (car x)))
+ hi-lock-interactive-patterns)))
+ (regexp (completing-read (if (null defaults)
+ "Regexp to unhighlight: "
+ (format "Regexp to unhighlight (default %s): "
+ (car defaults)))
+ hi-lock-interactive-patterns
+ nil nil nil nil defaults)))
+ (when (and (or (not search-upper-case)
+ (isearch-no-upper-case-p regexp t))
+ case-fold-search
+ (not (hi-lock--case-insensitive-regexp-p regexp)))
+ (setq regexp (hi-lock--case-insensitive-regexp regexp)))
+ (list regexp)))))
+ (let* ((patterns hi-lock-interactive-patterns)
+ (keys (or (assoc regexp patterns)
+ (assoc
+ (assoc regexp (mapcar #'car patterns))
+ patterns))))
+ (dolist (keyword (if (eq regexp t)
+ patterns
+ (list keys)))
(when keyword
(let ((face (hi-lock-keyword->face keyword)))
;; Make `face' the next one to use by default.
@@ -606,8 +634,10 @@ hi-lock-unface-buffer
(setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
- nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword)))
- (font-lock-flush))))
+ nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons
+ (or (car-safe (car keyword))
+ (car keyword))))
+ (font-lock-flush)))))
;;;###autoload
(defun hi-lock-write-interactive-patterns ()
@@ -690,23 +720,67 @@ hi-lock-read-face-name
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
+(defun hi-lock--case-insensitive-regexp-p (regexp)
+ (let (case-fold-search)
+ (and (string-match-p regexp (downcase regexp))
+ (string-match-p regexp (upcase regexp)))))
+
+(defun hi-lock--case-insensitive-regexp (regexp)
+ "Turn regexp into a case-insensitive regexp."
+ (let ((count 0)
+ (upper-re "[[:upper:]]")
+ (slash-upper-re "\\(\\\\\\)\\([[:upper:]]\\)")
+ case-fold-search)
+ (cond ((or (hi-lock--case-insensitive-regexp-p regexp)
+ (and (string-match upper-re regexp)
+ (not (string-match slash-upper-re regexp))))
+ regexp)
+ (t
+ (let ((string regexp))
+ (while (string-match slash-upper-re string)
+ (setq string (replace-match "" t t string 1)))
+ (setq regexp string)
+ (mapconcat
+ (lambda (c)
+ (let ((s (string c)))
+ (cond ((or (eq c ?\\)
+ (and (= count 1) (string= s (upcase s))))
+ (setq count (1+ count)) s)
+ (t
+ (setq count 0)
+ (if (string-match "[[:alpha:]]" s)
+ (format "[%s%s]" (upcase s) (downcase s))
+ (regexp-quote s))))))
+ regexp ""))))))
+
(defun hi-lock-set-pattern (regexp face &optional case-fold)
- "Highlight REGEXP with face FACE."
+ "Highlight REGEXP with face FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
- (let ((pattern (list (if (eq case-fold 'undefined)
+ (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))))
+ (cons regexp
+ (byte-compile
+ `(lambda (limit)
+ (let ((case-fold-search ,case-fold))
+ (re-search-forward ,regexp limit t))))))
+ (list 0 (list 'quote face) 'prepend)))
+ (regexp-fold
+ (cond ((not (consp (car pattern)))
+ (car pattern))
+ (t
+ (if (not case-fold)
+ (caar pattern)
+ (hi-lock--case-insensitive-regexp (caar pattern)))))))
;; Refuse to highlight a text that is already highlighted.
- (if (assoc regexp hi-lock-interactive-patterns)
+ (if (or (assoc regexp hi-lock-interactive-patterns)
+ (assoc regexp-fold hi-lock-interactive-patterns)
+ (assoc regexp-fold (mapcar #'car hi-lock-interactive-patterns)))
(add-to-list 'hi-lock--unused-faces (face-name face))
- (push pattern hi-lock-interactive-patterns)
(if (and font-lock-mode (font-lock-specified-p major-mode))
- (progn
+ (progn
+ (setq pattern (list regexp-fold (list 0 (list 'quote face) 'prepend)))
(font-lock-add-keywords nil (list pattern) t)
(font-lock-flush))
(let* ((range-min (- (point) (/ hi-lock-highlight-range 2)))
@@ -725,7 +799,8 @@ hi-lock-set-pattern
(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))))))))))
+ (goto-char (match-end 0)))))))
+ (push pattern hi-lock-interactive-patterns))))
(defun hi-lock-set-file-patterns (patterns)
"Replace file patterns list with PATTERNS and refontify."
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 250d37b45e..2496e092a6 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1940,15 +1940,7 @@ isearch-highlight-regexp
(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 ""))
+ isearch-string)
(t (regexp-quote isearch-string)))))
(hi-lock-face-buffer regexp (hi-lock-read-face-name)
(if (and (eq isearch-case-fold-search t)
--
2.11.0
From 6f6cdbfe8e825ed1906194fd32542c1c93d94e47 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha <at> gmail.com>
Date: Thu, 25 May 2017 20:51:55 +0900
Subject: [PATCH 3/3] Honor case-fold-search in all kind of matches
Perform the matches of REGEXP in `hi-lock-line-face-buffer',
`hi-lock-face-phrase-buffer' and `hi-lock-face-symbol-at-point'
as in `hi-lock-face-buffer'.
* lisp/hi-lock.el (hi-lock--deduce-case-fold-from-regexp): New defun.
(hi-lock-line-face-buffer, hi-lock-face-phrase-buffer)
(hi-lock-face-symbol-at-point): Perform the matches of REGEXP
as `hi-lock-face-buffer'.
(hi-lock--regexps-in-pattern-p): New defun.
(hi-lock-unface-buffer): Use it.
---
lisp/hi-lock.el | 162 ++++++++++++++++++++++++++++++++------------------------
1 file changed, 94 insertions(+), 68 deletions(-)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 5862974844..21a170f4db 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -88,6 +88,7 @@
;;; Code:
(require 'font-lock)
+(eval-when-compile (require 'cl-lib))
(defgroup hi-lock nil
"Interactively add and remove font-lock patterns for highlighting text."
@@ -405,11 +406,17 @@ turn-on-hi-lock-if-enabled
(unless (memq major-mode hi-lock-exclude-modes)
(hi-lock-mode 1)))
+(defun hi-lock--deduce-case-fold-from-regexp (regexp)
+ (if search-upper-case
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search))
+
;;;###autoload
(defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
;;;###autoload
-(defun hi-lock-line-face-buffer (regexp &optional face)
+(defun hi-lock-line-face-buffer (regexp &optional face case-fold)
"Set face of all lines containing a match of REGEXP to FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
@@ -417,16 +424,19 @@ hi-lock-line-face-buffer
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
(interactive
- (list
- (hi-lock-regexp-okay
- (read-regexp "Regexp to highlight line" 'regexp-history-last))
- (hi-lock-read-face-name)))
+ (let* ((regexp
+ (hi-lock-regexp-okay
+ (read-regexp "Regexp to highlight line" 'regexp-history-last)))
+ (face (hi-lock-read-face-name))
+ (case-fold
+ (hi-lock--deduce-case-fold-from-regexp regexp)))
+ (list regexp face case-fold)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern
;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
;; or a trailing $ in REGEXP will be interpreted correctly.
- (concat "^.*\\(?:" regexp "\\).*$") face))
+ (concat "^.*\\(?:" regexp "\\).*$") face case-fold))
;;;###autoload
@@ -447,9 +457,7 @@ hi-lock-face-buffer
(read-regexp "Regexp to highlight" 'regexp-history-last)))
(face (hi-lock-read-face-name))
(case-fold
- (if search-upper-case
- (isearch-no-upper-case-p regexp t)
- case-fold-search)))
+ (hi-lock--deduce-case-fold-from-regexp regexp)))
(list regexp face case-fold)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
@@ -458,8 +466,9 @@ hi-lock-face-buffer
;;;###autoload
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
;;;###autoload
-(defun hi-lock-face-phrase-buffer (regexp &optional face)
+(defun hi-lock-face-phrase-buffer (regexp &optional face case-fold)
"Set face of each match of phrase REGEXP to FACE.
+If optional arg CASE-FOLD is non-nil, then bind `case-fold-search' to it.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
@@ -471,14 +480,19 @@ hi-lock-face-phrase-buffer
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
(interactive
- (list
- (hi-lock-regexp-okay
- (hi-lock-process-phrase
- (read-regexp "Phrase to highlight" 'regexp-history-last)))
- (hi-lock-read-face-name)))
+ (let* ((regexp
+ (hi-lock-regexp-okay
+ (read-regexp "Phrase to highlight" 'regexp-history-last)))
+ (face (hi-lock-read-face-name))
+ (case-fold
+ (hi-lock--deduce-case-fold-from-regexp regexp)))
+ (setq regexp
+ (hi-lock-regexp-okay
+ (hi-lock-process-phrase regexp case-fold)))
+ (list regexp face case-fold)))
(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-symbol-at-point 'hi-lock-face-symbol-at-point)
@@ -495,10 +509,12 @@ hi-lock-face-symbol-at-point
(let* ((regexp (hi-lock-regexp-okay
(find-tag-default-as-symbol-regexp)))
(hi-lock-auto-select-face t)
- (face (hi-lock-read-face-name)))
+ (face (hi-lock-read-face-name))
+ (case-fold
+ (hi-lock--deduce-case-fold-from-regexp regexp)))
(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)))
(defun hi-lock-keyword->face (keyword)
(cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...).
@@ -552,6 +568,12 @@ hi-lock--unused-faces
"List of faces that is not used and is available for highlighting new text.
Face names from this list come from `hi-lock-face-defaults'.")
+(defun hi-lock--regexps-in-pattern-p (pattern &rest regexps)
+ (cl-some (lambda (reg)
+ (or (assoc reg pattern)
+ (assoc (assoc reg (mapcar #'car pattern)) pattern)))
+ regexps))
+
;;;###autoload
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
;;;###autoload
@@ -574,15 +596,15 @@ hi-lock-unface-buffer
(cons
`keymap
(cons "Select Pattern to Unhighlight"
- (mapcar (lambda (pattern)
- (let ((regexp (or (car-safe (car pattern))
- (car pattern))))
- (list regexp
- (format
- "%s (%s)" regexp
- (hi-lock-keyword->face pattern))
- (cons nil nil)
- regexp)))
+ (mapcar (lambda (pattern)
+ (let ((regexp (or (car-safe (car pattern))
+ (car pattern))))
+ (list regexp
+ (format
+ "%s (%s)" regexp
+ (hi-lock-keyword->face pattern))
+ (cons nil nil)
+ regexp)))
hi-lock-interactive-patterns))))
;; If the user clicks outside the menu, meaning that they
;; change their mind, x-popup-menu returns nil, and
@@ -599,45 +621,53 @@ hi-lock-unface-buffer
(mapcar (lambda (x)
(or (car-safe (car x))
(car x)))
- hi-lock-interactive-patterns)))
+ hi-lock-interactive-patterns)))
(regexp (completing-read (if (null defaults)
"Regexp to unhighlight: "
(format "Regexp to unhighlight (default %s): "
(car defaults)))
hi-lock-interactive-patterns
nil nil nil nil defaults)))
- (when (and (or (not search-upper-case)
- (isearch-no-upper-case-p regexp t))
- case-fold-search
- (not (hi-lock--case-insensitive-regexp-p regexp)))
- (setq regexp (hi-lock--case-insensitive-regexp regexp)))
(list regexp)))))
(let* ((patterns hi-lock-interactive-patterns)
- (keys (or (assoc regexp patterns)
- (assoc
- (assoc regexp (mapcar #'car patterns))
- patterns))))
+ (keys (or (eq regexp t)
+ (let* ((case-fold (hi-lock--deduce-case-fold-from-regexp regexp))
+ (case-in-regexp
+ (and (or (not search-upper-case)
+ (isearch-no-upper-case-p regexp t))
+ case-fold-search
+ (not (hi-lock--case-insensitive-regexp-p regexp))
+ (hi-lock--case-insensitive-regexp regexp)))
+ (xregexp (or case-in-regexp regexp)))
+ ;; Match a regexp.
+ (or (hi-lock--regexps-in-pattern-p patterns regexp xregexp)
+ ;; Match a line.
+ (let ((line-re (format "^.*\\(?:%s\\).*$" xregexp)))
+ (hi-lock--regexps-in-pattern-p patterns line-re))
+ ;; Match a phrase.
+ (let ((phrase-re (hi-lock-process-phrase regexp case-fold)))
+ (hi-lock--regexps-in-pattern-p patterns phrase-re)))))))
(dolist (keyword (if (eq regexp t)
patterns
(list keys)))
- (when keyword
- (let ((face (hi-lock-keyword->face keyword)))
- ;; Make `face' the next one to use by default.
- (when (symbolp face) ;Don't add it if it's a list (bug#13297).
- (add-to-list 'hi-lock--unused-faces (face-name face))))
- ;; FIXME: Calling `font-lock-remove-keywords' causes
- ;; `font-lock-specified-p' to go from nil to non-nil (because it
- ;; calls font-lock-set-defaults). This is yet-another bug in
- ;; font-lock-add/remove-keywords, which we circumvent here by
- ;; testing `font-lock-fontified' (bug#19796).
- (if font-lock-fontified (font-lock-remove-keywords nil (list keyword)))
- (setq hi-lock-interactive-patterns
- (delq keyword hi-lock-interactive-patterns))
- (remove-overlays
- nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons
- (or (car-safe (car keyword))
- (car keyword))))
- (font-lock-flush)))))
+ (when keyword
+ (let ((face (hi-lock-keyword->face keyword)))
+ ;; Make `face' the next one to use by default.
+ (when (symbolp face) ;Don't add it if it's a list (bug#13297).
+ (add-to-list 'hi-lock--unused-faces (face-name face))))
+ ;; FIXME: Calling `font-lock-remove-keywords' causes
+ ;; `font-lock-specified-p' to go from nil to non-nil (because it
+ ;; calls font-lock-set-defaults). This is yet-another bug in
+ ;; font-lock-add/remove-keywords, which we circumvent here by
+ ;; testing `font-lock-fontified' (bug#19796).
+ (if font-lock-fontified (font-lock-remove-keywords nil (list keyword)))
+ (setq hi-lock-interactive-patterns
+ (delq keyword hi-lock-interactive-patterns))
+ (remove-overlays
+ nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons
+ (or (car-safe (car keyword))
+ (car keyword))))
+ (font-lock-flush)))))
;;;###autoload
(defun hi-lock-write-interactive-patterns ()
@@ -662,20 +692,16 @@ hi-lock-write-interactive-patterns
;; Implementation Functions
-(defun hi-lock-process-phrase (phrase)
+(defun hi-lock-process-phrase (phrase &optional case-fold)
"Convert regexp PHRASE to a regexp that matches phrases.
-Blanks in PHRASE replaced by regexp that matches arbitrary whitespace
-and initial lower-case letters made case insensitive."
- (let ((mod-phrase nil))
- ;; FIXME fragile; better to just bind case-fold-search? (Bug#7161)
- (setq mod-phrase
- (replace-regexp-in-string
- "\\(^\\|\\s-\\)\\([a-z]\\)"
- (lambda (m) (format "%s[%s%s]"
- (match-string 1 m)
- (upcase (match-string 2 m))
- (match-string 2 m))) phrase))
+If optional arg CASE-FOLD is non-nil, then transform PHRASE into a case
+insensitive pattern.
+Blanks in PHRASE replaced by regexp that matches arbitrary whitespace."
+ ;; FIXME fragile; better to just bind case-fold-search? (Bug#7161)
+ (let ((mod-phrase (if case-fold
+ (hi-lock--case-insensitive-regexp phrase)
+ phrase)))
;; FIXME fragile; better to use search-spaces-regexp?
(setq mod-phrase
(replace-regexp-in-string
@@ -750,7 +776,7 @@ hi-lock--case-insensitive-regexp
(setq count 0)
(if (string-match "[[:alpha:]]" s)
(format "[%s%s]" (upcase s) (downcase s))
- (regexp-quote s))))))
+ s)))))
regexp ""))))))
(defun hi-lock-set-pattern (regexp face &optional case-fold)
--
2.11.0
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-05-25
Repository revision: b2ec91db89739153b39d10c15701b57aae7e251c
bug-gnu-emacs <at> gnu.org:bug#22541; Package emacs.
(Thu, 21 May 2020 23:34:02 GMT) Full text and rfc822 format available.Message #43 received at 22541 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> linkov.net> To: Dima Kogan <dima <at> secretsauce.net> Cc: 22541 <at> debbugs.gnu.org Subject: Re: bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Date: Fri, 22 May 2020 02:23:22 +0300
tags 22541 fixed close 22541 28.0.50 thanks >> Hi. Sorry it took me so long to reply to this. I haven't looked at >> isearch specifically in enough detail to comment on this, but if it >> makes this better, then I'm all for it :) > > Fortunately, I'll have more time in May to help in fixing this. Indeed, I had more time in May, but another year, and now this is implemented in bug#40337.
Juri Linkov <juri <at> linkov.net>
to control <at> debbugs.gnu.org.
(Thu, 21 May 2020 23:34:03 GMT) Full text and rfc822 format available.Juri Linkov <juri <at> linkov.net>
to control <at> debbugs.gnu.org.
(Thu, 21 May 2020 23:34:03 GMT) Full text and rfc822 format available.Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Fri, 19 Jun 2020 11:24:05 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.