bug#6279: Resolve alias face in htmlfontify.el

[Masatake YAMATO]

This is a bug report with a patch. Please review the patch and
merge it to the emacs official source tree if appreciated.


To reproduce a bug:

1. Make a new verilog-mode buffer and put following small code to the buffer:
--------------------------------<cut begin>-
// -*- verilog -*-
function x;
endfunction
--------------------------------<cut end>---

2. M-x toggle-debug-on-error
3. M-x htmlfontify-buffer

You will get following backtrace.
--------------------------------<cut begin>-
Debugger entered--Lisp error: (wrong-type-argument listp 
font-lock-reference-face)
  car(font-lock-reference-face)
  (let ((key ...) (val ...) (next ...) (that nil) (this nil) \
(parent nil)) (if (eq key :inherit) (let ... ...) (setq this ...)) \
(setq that (hfy-face-to-style-i next)) (nconc this that parent))
  (progn (let (... ... ... ... ... ...) (if ... ... ...) (setq that ...) (nconc 
this that parent)))
  (if fn (progn (let ... ... ... ...)))
  (when fn (let (... ... ... ... ... ...) (if ... ... ...) (setq that ...) 
(nconc this that parent)))
  hfy-face-to-style-i(font-lock-reference-face)
  (hfy-flatten-style (hfy-face-to-style-i face-def))
  (setq final-style (hfy-flatten-style (hfy-face-to-style-i face-def)))
  (let ((face-def ...) (final-style nil)) (setq final-style (hfy-flatten-style 
...)) \
(if (not ...) (progn ...)) final-style)
  hfy-face-to-style(font-lock-reference-face)
  (setq css-list (hfy-face-to-style fn))
  (let ((css-list nil) (css-text nil) (seen nil)) (setq css-list 
(hfy-face-to-style fn)) \
(setq css-text (mapcar ... css-list)) (cons (hfy-css-name fn) (format "{%s}" 
...)))
  hfy-face-to-css(font-lock-reference-face)
  (cons fn (hfy-face-to-css fn))
  (cons (cons fn (hfy-face-to-css fn)) style)
  (setq style (cons (cons fn ...) style))
  (push (cons fn (hfy-face-to-css fn)) style)
  (if (and (setq fn ...) (not ...)) (push (cons fn ...) style))
  (while (< pt (point-max)) (if (and ... ...) (push ... style)) (setq pt 
(next-char-property-change pt)))
  (save-excursion (goto-char pt) (while (< pt ...) (if ... ...) (setq pt ...)))
  (let ((pt ...) (fn nil) (style nil)) (save-excursion (goto-char pt) (while 
... ... ...)) (push (cons ... ...) style))
  hfy-compile-stylesheet()
  (setq css-sheet (hfy-compile-stylesheet) css-map (hfy-compile-face-map) 
invis-ranges (hfy-find-invisible-ranges))
  (let* ((html-buffer ...) (css-sheet nil) (css-map nil) (invis-ranges nil) 
(rovl nil) \
(orig-ovls ...) (rmin ...) (rmax ...)) (when (and mark-active 
transient-mark-mode) \
...
  hfy-fontify-buffer(nil "foo.v")
  (switch-to-buffer (hfy-fontify-buffer srcdir file))
  (if (interactive-p) (switch-to-buffer (hfy-fontify-buffer srcdir file)) 
(hfy-fontify-buffer srcdir file))
  htmlfontify-buffer()
  call-interactively(htmlfontify-buffer t nil)
  execute-extended-command(nil)
  call-interactively(execute-extended-command nil nil)
--------------------------------<cut end>---
(Some newlines are inserted. A line started with `...' is truncated.)

It seems that htmlfontify.el doesn't consider face alias which
is used to mark obsolete face like `font-lock-reference-face'.


2010-05-27  Masatake YAMATO  <yamato@redhat.com>

        * htmlfontify.el (hfy-face-resolve-face): New function to
        resolve alias faces.
        (hfy-face-to-style): Use `hfy-face-resolve-face'

=== modified file 'lisp/htmlfontify.el'
*** lisp/htmlfontify.el 2010-04-24 02:36:43 +0000
--- lisp/htmlfontify.el 2010-05-27 14:42:16 +0000
***************
*** 1026,1039 ****
      (setq  n (apply '* m))
      (nconc r (hfy-size (if x (round n) (* n 1.0)))) ))
  
  (defun hfy-face-to-style (fn)
    "Take FN, a font or `defface' style font specification,
  \(as returned by `face-attr-construct' or `hfy-face-attr-for-class')
  and return a `hfy-style-assoc'.\n
  See also `hfy-face-to-style-i', `hfy-flatten-style'."
    ;;(message "hfy-face-to-style");;DBUG
!   (let ((face-def (if (facep fn)
!                       (hfy-face-attr-for-class fn hfy-display-class) fn))
          (final-style nil))
  
      (setq final-style (hfy-flatten-style (hfy-face-to-style-i face-def)))
--- 1030,1057 ----
      (setq  n (apply '* m))
      (nconc r (hfy-size (if x (round n) (* n 1.0)))) ))
  
+ (defun hfy-face-resolve-face (fn)
+   (cond
+    ((facep fn)
+     (hfy-face-attr-for-class fn hfy-display-class))
+    ((symbolp fn)
+     ;; Obsolte face like `font-lock-reference-face' is defined
+     ;; as an alias for another face. Following
+     ;; expression tries to resolve the alias.
+     (let ((new-fn (symbol-value fn)))
+       (if (eq new-fn fn)
+         fn
+       (hfy-face-resolve-face new-fn))))
+    (t
+     fn)))
+ 
  (defun hfy-face-to-style (fn)
    "Take FN, a font or `defface' style font specification,
  \(as returned by `face-attr-construct' or `hfy-face-attr-for-class')
  and return a `hfy-style-assoc'.\n
  See also `hfy-face-to-style-i', `hfy-flatten-style'."
    ;;(message "hfy-face-to-style");;DBUG
!   (let ((face-def (hfy-face-resolve-face fn))
          (final-style nil))
  
      (setq final-style (hfy-flatten-style (hfy-face-to-style-i face-def)))