diff options
| author | Juri Linkov <juri@linkov.net> | 2022-12-29 19:45:12 +0200 |
|---|---|---|
| committer | Juri Linkov <juri@linkov.net> | 2022-12-29 19:45:12 +0200 |
| commit | 0aea1cf8190aa804a0d11a67b4a3cb4b715ae82d (patch) | |
| tree | c70601b2ba5ada45987c3c1f6f06ee96c88e531d /lisp/hi-lock.el | |
| parent | 60418e6f09c67924e3e05eb4948e109d8f7c4073 (diff) | |
| download | emacs-0aea1cf8190aa804a0d11a67b4a3cb4b715ae82d.tar.gz emacs-0aea1cf8190aa804a0d11a67b4a3cb4b715ae82d.tar.bz2 emacs-0aea1cf8190aa804a0d11a67b4a3cb4b715ae82d.zip | |
* lisp/hi-lock.el (hi-lock--regexps-at-point): Fix bug (bug#60241).
Handle two cases: when a pattern is a regexp or a function.
Diffstat (limited to 'lisp/hi-lock.el')
| -rw-r--r-- | lisp/hi-lock.el | 33 |
1 files changed, 19 insertions, 14 deletions
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index a45e74eca26..bc631747e6d 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -569,24 +569,29 @@ the major mode specifies support for Font Lock." (when (and face-before face-after (not (eq face-before face-after))) (setq face-before nil)) (when (or face-after face-before) - (let* ((hi-text - (buffer-substring-no-properties - (if face-before - (or (previous-single-property-change (point) 'face) - (point-min)) - (point)) - (if face-after - (or (next-single-property-change (point) 'face) - (point-max)) - (point))))) + (let* ((beg (if face-before + (or (previous-single-property-change (point) 'face) + (point-min)) + (point))) + (end (if face-after + (or (next-single-property-change (point) 'face) + (point-max)) + (point)))) ;; Compute hi-lock patterns that match the ;; highlighted text at point. Use this later in ;; during completing-read. (dolist (hi-lock-pattern hi-lock-interactive-patterns) - (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))))))) + (let ((pattern (or (rassq hi-lock-pattern hi-lock-interactive-lighters) + (car hi-lock-pattern)))) + (cond + ((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)) (defvar-local hi-lock--unused-faces nil |