diff options
author | Juri Linkov <juri@linkov.net> | 2020-04-13 02:40:56 +0300 |
---|---|---|
committer | Juri Linkov <juri@linkov.net> | 2020-04-13 02:40:56 +0300 |
commit | 91e4acf7c736dfdb2673dc33c9303b5284e925df (patch) | |
tree | e72ce8d84512ee75701424fdac26560c94ee88f7 /lisp/hi-lock.el | |
parent | 68ffe4a3c9a001db528b057109d11de71471e4ff (diff) | |
download | emacs-91e4acf7c736dfdb2673dc33c9303b5284e925df.tar.gz |
Fix hi-lock test and add new test for case-fold (bug#40337)
* lisp/hi-lock.el (hi-lock--regexps-at-point): Handle font-lock faces.
(hi-lock-unface-buffer): Simplify default value handling.
(hi-lock-set-pattern): Add either lighter or regexp to
hi-lock-interactive-lighters.
(hi-lock-set-pattern): Put overlay prop hi-lock-overlay-regexp to
either lighter or regexp.
* test/lisp/hi-lock-tests.el (hi-lock-bug26666): Use "b" instead of "a".
(hi-lock-case-fold): New test.
Diffstat (limited to 'lisp/hi-lock.el')
-rw-r--r-- | lisp/hi-lock.el | 37 |
1 files changed, 18 insertions, 19 deletions
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index d5e46651a50..1d8dc0624ba 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -564,13 +564,15 @@ in which case the highlighting will not update as you type." (let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp))) (when regexp (push regexp regexps))) ;; With font-locking on, check if the cursor is on a highlighted text. - (let ((face-after (get-text-property (point) 'face)) - (face-before - (unless (bobp) (get-text-property (1- (point)) 'face))) - (faces (mapcar #'hi-lock-keyword->face - hi-lock-interactive-patterns))) - (unless (memq face-before faces) (setq face-before nil)) - (unless (memq face-after faces) (setq face-after nil)) + (let* ((faces-after (get-text-property (point) 'face)) + (faces-before + (unless (bobp) (get-text-property (1- (point)) 'face))) + (faces-after (if (consp faces-after) faces-after (list faces-after))) + (faces-before (if (consp faces-before) faces-before (list faces-before))) + (faces (mapcar #'hi-lock-keyword->face + hi-lock-interactive-patterns)) + (face-after (seq-some (lambda (face) (car (memq face faces))) faces-after)) + (face-before (seq-some (lambda (face) (car (memq face faces))) faces-before))) (when (and face-before face-after (not (eq face-before face-after))) (setq face-before nil)) (when (or face-after face-before) @@ -588,7 +590,8 @@ in which case the highlighting will not update as you type." ;; 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))) + (let ((regexp (or (car (rassq hi-lock-pattern hi-lock-interactive-lighters)) + (car hi-lock-pattern)))) (if (string-match regexp hi-text) (push regexp regexps))))))) regexps)) @@ -642,15 +645,10 @@ then remove all hi-lock highlighting." (user-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)))) - (setq defaults - (mapcar (lambda (default) - (or (car (rassq default - (mapcar (lambda (a) - (cons (car a) (cadr a))) - hi-lock-interactive-lighters))) - default)) - defaults)) + (mapcar (lambda (pattern) + (or (car (rassq pattern hi-lock-interactive-lighters)) + (car pattern))) + hi-lock-interactive-patterns)))) (list (completing-read (if (null defaults) "Regexp to unhighlight: " @@ -767,7 +765,8 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." (list subexp (list 'quote face) 'prepend))) (no-matches t)) ;; Refuse to highlight a text that is already highlighted. - (if (assoc regexp hi-lock-interactive-patterns) + (if (or (assoc regexp hi-lock-interactive-patterns) + (assoc (or lighter regexp) hi-lock-interactive-lighters)) (add-to-list 'hi-lock--unused-faces (face-name face)) (push pattern hi-lock-interactive-patterns) (push (cons (or lighter regexp) pattern) hi-lock-interactive-lighters) @@ -792,7 +791,7 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." (let ((overlay (make-overlay (match-beginning subexp) (match-end subexp)))) (overlay-put overlay 'hi-lock-overlay t) - (overlay-put overlay 'hi-lock-overlay-regexp regexp) + (overlay-put overlay 'hi-lock-overlay-regexp (or lighter regexp)) (overlay-put overlay 'face face)) (goto-char (match-end 0))) (when no-matches |