procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/hi-lock.el (hi-lock--regexps-at-point): Fix bug (bug#60241).

Browse source 
Handle two cases: when a pattern is a regexp or a function.
This commit is contained in:
Juri Linkov 2022-12-29 19:45:12 +02:00
parent 60418e6f09
commit 0aea1cf819
1 changed files with 19 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

23
lisp/hi-lock.el
View file

@ -569,24 +569,29 @@ the major mode specifies support for Font Lock."
(when (and face-before face-after (not (eq face-before face-after))) (when (and face-before face-after (not (eq face-before face-after)))
(setq face-before nil)) (setq face-before nil))
(when (or face-after face-before) (when (or face-after face-before)
(let* ((hi-text (let* ((beg (if face-before
(buffer-substring-no-properties
(if face-before
(or (previous-single-property-change (point) 'face) (or (previous-single-property-change (point) 'face)
(point-min)) (point-min))
(point)) (point)))
(if face-after (end (if face-after
(or (next-single-property-change (point) 'face) (or (next-single-property-change (point) 'face)
(point-max)) (point-max))
(point))))) (point))))
;; Compute hi-lock patterns that match the ;; Compute hi-lock patterns that match the
;; highlighted text at point. Use this later in ;; highlighted text at point. Use this later in
;; during completing-read. ;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns) (dolist (hi-lock-pattern hi-lock-interactive-patterns)
(let ((regexp (or (car (rassq hi-lock-pattern hi-lock-interactive-lighters)) (let ((pattern (or (rassq hi-lock-pattern hi-lock-interactive-lighters)
(car hi-lock-pattern)))) (car hi-lock-pattern))))
(if (string-match regexp hi-text) (cond
(push regexp regexps))))))) ((stringp pattern)
(when (string-match pattern (buffer-substring-no-properties beg end))
(push pattern regexps)))
((functionp (cadr pattern))
(save-excursion
(goto-char beg)
(when (funcall (cadr pattern) end)
(push (car pattern) regexps))))))))))
regexps)) regexps))
(defvar-local hi-lock--unused-faces nil (defvar-local hi-lock--unused-faces nil