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

Keep face available if there are no matches

Browse source 
If font-lock-mode is disabled in the current buffer, and
there are no matches for REGEXP, then keep FACE available
for a next search.
* lisp/hi-lock.el (hi-lock-set-pattern): Add FACE into
hi-lock--unused-faces if font-lock-mode is disabled and
there are no matches.
* test/lisp/hi-lock-tests.el (hi-lock-test-set-pattern): Add test.
This commit is contained in:
Tino Calancha 2017-08-25 00:00:20 +09:00
parent 0332a0ef2b
commit 303481b4ec
2 changed files with 18 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/hi-lock.el
View file

@ -693,7 +693,8 @@ with completion and history."
"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 regexp (list 0 (list 'quote face) 'prepend)))
(no-matches t))
;; 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))
@ -713,11 +714,14 @@ with completion and history."
(save-excursion
(goto-char search-start)
(while (re-search-forward regexp search-end t)
(when no-matches (setq no-matches nil))
(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)))))))))
(goto-char (match-end 0)))
(when no-matches
(add-to-list 'hi-lock--unused-faces (face-name face)))))))))
(defun hi-lock-set-file-patterns (patterns)
"Replace file patterns list with PATTERNS and refontify."

12
test/lisp/hi-lock-tests.el
View file

@ -36,5 +36,17 @@
(hi-lock-set-pattern "a" face))))
(should (equal hi-lock--unused-faces (cdr faces))))))
(ert-deftest hi-lock-test-set-pattern ()
(let ((faces hi-lock-face-defaults))
(with-temp-buffer
(insert "foo bar")
(cl-letf (((symbol-function 'completing-read)
(lambda (prompt coll x y z hist defaults)
(car defaults))))
(hi-lock-set-pattern "9999" (hi-lock-read-face-name)) ; No match
(hi-lock-set-pattern "foo" (hi-lock-read-face-name)))
;; Only one match, then we have used just 1 face
(should (equal hi-lock--unused-faces (cdr faces))))))
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here