Package: emacs;
Reported by: Jonas Bernoulli <jonas <at> bernoul.li>
Date: Fri, 28 Dec 2012 20:23:01 UTC
Severity: normal
Done: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
Bug is archived. No further changes may be made.
Message #11 received at 13297 <at> debbugs.gnu.org (full text, mbox):
From: Jambunathan K <kjambunathan <at> gmail.com> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: Jonas Bernoulli <jonas <at> bernoul.li>, 13297 <at> debbugs.gnu.org Subject: Re: bug#13297: hi-lock-unface-buffer fails on face lists Date: Thu, 17 Jan 2013 13:20:09 +0530
Stefan Monnier <monnier <at> iro.umontreal.ca> writes:
>> Before commit 111129 hi-lock-unface-buffer could handle face symbols as
>> well as face lists. After this commit it fails on lists.
>> Third-party library highlight-symbol uses hi-lock-set-pattern passing it
>> a face list. The above change breaks this usage which isn't disallowed
>> in hi-lock-set-pattern's doc-string. As a result this library cannot
>> remove the highlights it added with the help of hi-lock.
>
> I don't understand exactly what you're referring to. In which way does
> it break it? Do you get an error? Or is the regexp's highlight just
> sticks around without signaling any error?
> Can you show some specific recipe to reproduce the problem?
highlight-symbol is at
http://nschum.de/src/emacs/highlight-symbol/highlight-symbol.el
To higlight use
M-x highlight-symbol-at-point RET
To un-highlight use
M-x highlight-symbol-at-point RET
That library uses anonymous faces (as opposed to a pre-defined face) for
highlighting.
,---- hi-lock-interactive-patterns
|
| (("\\_<completing-read\\_>"
| (0
| '((background-color . "cyan") <====== anonymous face
| . #1=((foreground-color . "black")))
| t))
| ("\\_<keyword\\_>"
| (0
| '((background-color . "DeepPink")
| . #1#)
| t)))
|
`----
The problem is due to the mistaken assumption about the nature of face,
as captured by the comment line below.
,----
| (defun hi-lock-keyword->face (keyword)
| (cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...).
`----
A simple check in `hi-lock-unface-buffer' will make the problem
disappear. However, I have a gut feeling that management of
`hi-lock--unused-faces' could be improved.
,----
| (when keyword
| (let ((face (hi-lock-keyword->face keyword)))
| (when (member face hi-lock-face-defaults) <== Use facep instead
| ;; Make `face' the next one to use by default.
| (add-to-list 'hi-lock--unused-faces (face-name face))))
`----
--8<---------------cut here---------------start------------->8---
Debugger entered--Lisp error: (error "Not a face: ((background-color . DeepPink) (foreground-color . black))")
signal(error ("Not a face: ((background-color . DeepPink) (foreground-color . black))"))
error("Not a face: %s" ((background-color . "DeepPink") (foreground-color . "black")))
check-face(((background-color . "DeepPink") (foreground-color . "black")))
face-name(((background-color . "DeepPink") (foreground-color . "black")))
(add-to-list (quote hi-lock--unused-faces) (face-name face))
(let ((face (hi-lock-keyword->face keyword))) (add-to-list (quote hi-lock--unused-faces) (face-name face)))
(progn (let ((face (hi-lock-keyword->face keyword))) (add-to-list (quote hi-lock--unused-faces) (face-name face))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil (quote hi-lock-overlay-regexp) (hi-lock--hashcons (car keyword))) (if font-lock-fontified (progn (font-lock-fontify-buffer))))
(if keyword (progn (let ((face (hi-lock-keyword->face keyword))) (add-to-list (quote hi-lock--unused-faces) (face-name face))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil (quote hi-lock-overlay-regexp) (hi-lock--hashcons (car keyword))) (if font-lock-fontified (progn (font-lock-fontify-buffer)))))
(let ((keyword (car --dolist-tail--))) (if keyword (progn (let ((face (hi-lock-keyword->face keyword))) (add-to-list (quote hi-lock--unused-faces) (face-name face))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil (quote hi-lock-overlay-regexp) (hi-lock--hashcons (car keyword))) (if font-lock-fontified (progn (font-lock-fontify-buffer))))) (setq --dolist-tail-- (cdr --dolist-tail--)))
(while --dolist-tail-- (let ((keyword (car --dolist-tail--))) (if keyword (progn (let ((face (hi-lock-keyword->face keyword))) (add-to-list (quote hi-lock--unused-faces) (face-name face))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil (quote hi-lock-overlay-regexp) (hi-lock--hashcons (car keyword))) (if font-lock-fontified (progn (font-lock-fontify-buffer))))) (setq --dolist-tail-- (cdr --dolist-tail--))))
(let ((--dolist-tail-- (if (eq regexp t) hi-lock-interactive-patterns (list (assoc regexp hi-lock-interactive-patterns))))) (while --dolist-tail-- (let ((keyword (car --dolist-tail--))) (if keyword (progn (let ((face ...)) (add-to-list (quote hi-lock--unused-faces) (face-name face))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil (quote hi-lock-overlay-regexp) (hi-lock--hashcons (car keyword))) (if font-lock-fontified (progn (font-lock-fontify-buffer))))) (setq --dolist-tail-- (cdr --dolist-tail--)))))
(progn (let ((--dolist-tail-- (if (eq regexp t) hi-lock-interactive-patterns (list (assoc regexp hi-lock-interactive-patterns))))) (while --dolist-tail-- (let ((keyword (car --dolist-tail--))) (if keyword (progn (let (...) (add-to-list ... ...)) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil (quote hi-lock-overlay-regexp) (hi-lock--hashcons ...)) (if font-lock-fontified (progn ...)))) (setq --dolist-tail-- (cdr --dolist-tail--))))))
hi-lock-unface-buffer("\\_<keyword\\_>")
(progn (setq highlight-symbol-list (delete symbol highlight-symbol-list)) (hi-lock-unface-buffer symbol))
(if (member symbol highlight-symbol-list) (progn (setq highlight-symbol-list (delete symbol highlight-symbol-list)) (hi-lock-unface-buffer symbol)) (if (equal symbol highlight-symbol) (progn (highlight-symbol-mode-remove-temp))) (let ((color (nth highlight-symbol-color-index highlight-symbol-colors))) (if color (setq highlight-symbol-color-index (1+ highlight-symbol-color-index)) (setq highlight-symbol-color-index 1 color (car highlight-symbol-colors))) (setq color (cons (cons (quote background-color) color) (quote ((foreground-color . "black"))))) (with-no-warnings (if (< emacs-major-version 22) (hi-lock-set-pattern (list symbol (cons 0 (cons ... ...)))) (hi-lock-set-pattern symbol color))) (setq highlight-symbol-list (cons symbol highlight-symbol-list))))
(let ((symbol (highlight-symbol-get-symbol))) (if symbol nil (error "No symbol at point")) (if hi-lock-mode nil (hi-lock-mode 1)) (if (member symbol highlight-symbol-list) (progn (setq highlight-symbol-list (delete symbol highlight-symbol-list)) (hi-lock-unface-buffer symbol)) (if (equal symbol highlight-symbol) (progn (highlight-symbol-mode-remove-temp))) (let ((color (nth highlight-symbol-color-index highlight-symbol-colors))) (if color (setq highlight-symbol-color-index (1+ highlight-symbol-color-index)) (setq highlight-symbol-color-index 1 color (car highlight-symbol-colors))) (setq color (cons (cons (quote background-color) color) (quote ((foreground-color . "black"))))) (with-no-warnings (if (< emacs-major-version 22) (hi-lock-set-pattern (list symbol (cons 0 ...))) (hi-lock-set-pattern symbol color))) (setq highlight-symbol-list (cons symbol highlight-symbol-list)))))
highlight-symbol-at-point()
call-interactively(highlight-symbol-at-point record nil)
command-execute(highlight-symbol-at-point record)
execute-extended-command(nil "highlight-symbol-at-point")
call-interactively(execute-extended-command nil nil)
--8<---------------cut here---------------end--------------->8---
--
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.