* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active
@ 2016-02-03 6:29 Dima Kogan
2016-03-01 0:14 ` Juri Linkov
0 siblings, 1 reply; 13+ messages in thread
From: Dima Kogan @ 2016-02-03 6:29 UTC (permalink / raw)
To: 22541
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ªà-åāăąǎȁȃȧᵃḁạảₐⓐa𝐚𝑎𝒂𝒶𝓪𝔞𝕒𝖆𝖺𝗮𝘢𝙖𝚊]\)\(?:b[̣̱̇]\|[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.
^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2016-02-03 6:29 bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Dima Kogan @ 2016-03-01 0:14 ` Juri Linkov 2016-04-27 5:02 ` Dima Kogan 2017-04-22 12:31 ` Tino Calancha 0 siblings, 2 replies; 13+ messages in thread From: Juri Linkov @ 2016-03-01 0:14 UTC (permalink / raw) To: Dima Kogan; +Cc: 22541 > 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ªà-åāăąǎȁȃȧᵃḁạảₐⓐa𝐚𝑎𝒂𝒶𝓪𝔞𝕒𝖆𝖺𝗮𝘢𝙖𝚊]\)\(?:b[̣̱̇]\|[bᵇḃḅḇⓑb𝐛𝑏𝒃𝒷𝓫𝔟𝕓𝖇𝖻𝗯𝘣𝙗𝚋]\) > > This clearly has no case-folding active on top of the char-folding. But > the isearch had both, so the regex should get both. This would make the > regex twice as long, but it would be right, at least. > > If we turn off char-folding (but leave case-folding alone; on) by adding > a step > > 2.5: M-s ' > > then the regex we get is > > [Aa][Bb] > > which clearly has the case-folding, and works the way we expect. The problem is that with introduction of char-folding, a hack responsible for case-folding in isearch-highlight-regexp that turns isearch-string into a case-insensitive regexp is not used anymore, i.e. it's overridden by isearch-regexp-function. (Also note a FIXME comment in hi-lock-process-phrase) Since we can't change the value of font-lock-keywords-case-fold-search for font-lock based highlighting in hi-lock for individual regexps, the best solution is to rely on the feature allowing MATCHER in font-lock-keywords to be a function. So we can let-bind case-fold-search in its lambda. Now the remaining problem is how to transfer case-fold from isearch-highlight-regexp down to hi-lock-set-pattern. Implementing pcre-style embedded modifiers is a good long-term goal, but we need to fix this for the next release. What options do we have now? I see no other way than adding new argument to the chain of calls: diff --git a/lisp/isearch.el b/lisp/isearch.el index 2efa4c7..f77ef19 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1906,7 +1906,12 @@ isearch-highlight-regexp (regexp-quote s)))) isearch-string "")) (t (regexp-quote isearch-string))))) - (hi-lock-face-buffer regexp (hi-lock-read-face-name))) + (hi-lock-face-buffer regexp (hi-lock-read-face-name) + (if (and (eq isearch-case-fold-search t) + search-upper-case) + (isearch-no-upper-case-p + isearch-string isearch-regexp) + isearch-case-fold-search))) (and isearch-recursive-edit (exit-recursive-edit))) \f diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index ec14e0b..27a2ae6 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -432,7 +432,7 @@ hi-lock-line-face-buffer ;;;###autoload (defalias 'highlight-regexp 'hi-lock-face-buffer) ;;;###autoload -(defun hi-lock-face-buffer (regexp &optional face) +(defun hi-lock-face-buffer (regexp &optional face case-fold) "Set face of each match of REGEXP to FACE. Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. @@ -444,10 +444,11 @@ hi-lock-face-buffer (list (hi-lock-regexp-okay (read-regexp "Regexp to highlight" 'regexp-history-last)) - (hi-lock-read-face-name))) + (hi-lock-read-face-name) + case-fold-search)) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) - (hi-lock-set-pattern regexp face)) + (hi-lock-set-pattern regexp face case-fold)) ;;;###autoload (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -689,11 +690,17 @@ hi-lock-read-face-name (add-to-list 'hi-lock-face-defaults face t)) (intern face))) -(defun hi-lock-set-pattern (regexp face) +(defun hi-lock-set-pattern (regexp face &optional case-fold) "Highlight REGEXP with face FACE." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) - (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend)))) + (let ((pattern (list (if (eq case-fold 'undefined) + regexp + (byte-compile + `(lambda (limit) + (let ((case-fold-search ,case-fold)) + (re-search-forward ,regexp limit t))))) + (list 0 (list 'quote face) 'prepend)))) ;; Refuse to highlight a text that is already highlighted. (unless (assoc regexp hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns) @@ -711,12 +718,13 @@ hi-lock-set-pattern (+ range-max (max 0 (- (point-min) range-min)))))) (save-excursion (goto-char search-start) - (while (re-search-forward regexp search-end t) - (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) - (overlay-put overlay 'hi-lock-overlay t) - (overlay-put overlay 'hi-lock-overlay-regexp regexp) - (overlay-put overlay 'face face)) - (goto-char (match-end 0))))))))) + (let ((case-fold-search case-fold)) + (while (re-search-forward regexp search-end t) + (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) + (overlay-put overlay 'hi-lock-overlay t) + (overlay-put overlay 'hi-lock-overlay-regexp regexp) + (overlay-put overlay 'face face)) + (goto-char (match-end 0)))))))))) (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2016-03-01 0:14 ` Juri Linkov @ 2016-04-27 5:02 ` Dima Kogan 2016-04-30 20:07 ` Juri Linkov 2017-04-22 12:31 ` Tino Calancha 1 sibling, 1 reply; 13+ messages in thread From: Dima Kogan @ 2016-04-27 5:02 UTC (permalink / raw) To: Juri Linkov; +Cc: 22541 Juri Linkov <juri@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 ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2016-04-27 5:02 ` Dima Kogan @ 2016-04-30 20:07 ` Juri Linkov 2020-05-21 23:23 ` Juri Linkov 0 siblings, 1 reply; 13+ messages in thread From: Juri Linkov @ 2016-04-30 20:07 UTC (permalink / raw) To: Dima Kogan; +Cc: 22541 >>>> > 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 :) ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2016-04-30 20:07 ` Juri Linkov @ 2020-05-21 23:23 ` Juri Linkov 0 siblings, 0 replies; 13+ messages in thread From: Juri Linkov @ 2020-05-21 23:23 UTC (permalink / raw) To: Dima Kogan; +Cc: 22541 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. ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2016-03-01 0:14 ` Juri Linkov 2016-04-27 5:02 ` Dima Kogan @ 2017-04-22 12:31 ` Tino Calancha 2017-04-23 23:18 ` Juri Linkov 1 sibling, 1 reply; 13+ messages in thread From: Tino Calancha @ 2017-04-22 12:31 UTC (permalink / raw) To: Juri Linkov; +Cc: 22541, Dima Kogan, tino.calancha Juri Linkov <juri@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@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))) \f --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 ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2017-04-22 12:31 ` Tino Calancha @ 2017-04-23 23:18 ` Juri Linkov 2017-04-25 5:22 ` Tino Calancha 0 siblings, 1 reply; 13+ messages in thread From: Juri Linkov @ 2017-04-23 23:18 UTC (permalink / raw) To: Tino Calancha; +Cc: 22541, Dima Kogan > 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. ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2017-04-23 23:18 ` Juri Linkov @ 2017-04-25 5:22 ` Tino Calancha 2017-04-25 20:52 ` Juri Linkov 0 siblings, 1 reply; 13+ messages in thread From: Tino Calancha @ 2017-04-25 5:22 UTC (permalink / raw) To: Juri Linkov; +Cc: 22541, Dima Kogan, tino.calancha Juri Linkov <juri@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@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@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))) \f -- 2.11.0 From f0f68d2a2049b549a6690f411dd746cb4333f99b Mon Sep 17 00:00:00 2001 From: Tino Calancha <tino.calancha@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@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 ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2017-04-25 5:22 ` Tino Calancha @ 2017-04-25 20:52 ` Juri Linkov 2017-04-27 14:22 ` Tino Calancha 0 siblings, 1 reply; 13+ messages in thread From: Juri Linkov @ 2017-04-25 20:52 UTC (permalink / raw) To: Tino Calancha; +Cc: 22541, Dima Kogan > 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@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@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”. ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2017-04-25 20:52 ` Juri Linkov @ 2017-04-27 14:22 ` Tino Calancha 2017-05-09 22:10 ` Juri Linkov 0 siblings, 1 reply; 13+ messages in thread From: Tino Calancha @ 2017-04-27 14:22 UTC (permalink / raw) To: Juri Linkov; +Cc: 22541, Dima Kogan, tino.calancha Juri Linkov <juri@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@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))) \f -- 2.11.0 From 32ec762b9459cf2a1b50217fa061c70541c0a241 Mon Sep 17 00:00:00 2001 From: Tino Calancha <tino.calancha@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 ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2017-04-27 14:22 ` Tino Calancha @ 2017-05-09 22:10 ` Juri Linkov 2017-05-24 13:35 ` Tino Calancha 0 siblings, 1 reply; 13+ messages in thread From: Juri Linkov @ 2017-05-09 22:10 UTC (permalink / raw) To: Tino Calancha; +Cc: 22541, Dima Kogan >>> @@ -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? ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2017-05-09 22:10 ` Juri Linkov @ 2017-05-24 13:35 ` Tino Calancha 2017-05-25 12:11 ` Tino Calancha 0 siblings, 1 reply; 13+ messages in thread From: Tino Calancha @ 2017-05-24 13:35 UTC (permalink / raw) To: Juri Linkov; +Cc: 22541, Dima Kogan Juri Linkov <juri@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. ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active 2017-05-24 13:35 ` Tino Calancha @ 2017-05-25 12:11 ` Tino Calancha 0 siblings, 0 replies; 13+ messages in thread From: Tino Calancha @ 2017-05-25 12:11 UTC (permalink / raw) To: Juri Linkov; +Cc: 22541, Dima Kogan, tino.calancha Tino Calancha <tino.calancha@gmail.com> writes: > Juri Linkov <juri@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@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))) \f -- 2.11.0 From 705f90014547c446cc7fd1df35f2d8d16e630771 Mon Sep 17 00:00:00 2001 From: Tino Calancha <tino.calancha@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@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 ^ permalink raw reply related [flat|nested] 13+ messages in thread
end of thread, other threads:[~2020-05-21 23:23 UTC | newest] Thread overview: 13+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2016-02-03 6:29 bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive even if case-fold is active Dima Kogan 2016-03-01 0:14 ` Juri Linkov 2016-04-27 5:02 ` Dima Kogan 2016-04-30 20:07 ` Juri Linkov 2020-05-21 23:23 ` Juri Linkov 2017-04-22 12:31 ` Tino Calancha 2017-04-23 23:18 ` Juri Linkov 2017-04-25 5:22 ` Tino Calancha 2017-04-25 20:52 ` Juri Linkov 2017-04-27 14:22 ` Tino Calancha 2017-05-09 22:10 ` Juri Linkov 2017-05-24 13:35 ` Tino Calancha 2017-05-25 12:11 ` Tino Calancha
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/emacs.git https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.