[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#22541: 25.0.50; highlight-regexp from isearch has is case-sensitive
|
From: |
Tino Calancha |
|
Subject: |
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 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) |
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)))
--
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