bug#13297: hi-lock-unface-buffer fails on face lists

[Jambunathan K <kjambunathan@gmail.com>]

Stefan Monnier <monnier@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-pa
 ttern 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---

--