Function: hfy-face-attr-for-class

hfy-face-attr-for-class is a byte-compiled function defined in htmlfontify.el.gz.

Signature

(hfy-face-attr-for-class FACE &optional CLASS)

Documentation

Return the face attributes for FACE.

If CLASS is set, it must be a defface alist key [see below], in which case the first face specification returned by hfy-combined-face-spec which *doesn't* clash with CLASS is returned.

(A specification with a class of t is considered to match any class you
specify - this matches Emacs's behavior when deciding on which face attributes to use, to the best of my understanding).

If CLASS is nil, then you just get whatever face-attr-construct returns, ie the current specification in effect for FACE.

*NOTE*: This function forces any face that is not default and which has
no :inherit property to inherit from default (this is because default is magical in that Emacs's fonts behave as if they inherit implicitly from default, but no such behavior exists in HTML/CSS).

See also hfy-display-class for details of valid values for CLASS.

Source Code

;; Defined in /usr/src/emacs/lisp/htmlfontify.el.gz
(defun hfy-face-attr-for-class (face &optional class)
  "Return the face attributes for FACE.
If CLASS is set, it must be a `defface' alist key [see below],
in which case the first face specification returned by `hfy-combined-face-spec'
which *doesn't* clash with CLASS is returned.

\(A specification with a class of t is considered to match any class you
specify - this matches Emacs's behavior when deciding on which face attributes
to use, to the best of my understanding).

If CLASS is nil, then you just get whatever `face-attr-construct' returns,
ie the current specification in effect for FACE.

*NOTE*: This function forces any face that is not `default' and which has
no :inherit property to inherit from `default' (this is because `default'
is magical in that Emacs's fonts behave as if they inherit implicitly from
`default', but no such behavior exists in HTML/CSS).

See also `hfy-display-class' for details of valid values for CLASS."
  (let ((face-spec
         (if class
             (let ((face-props (hfy-combined-face-spec face))
                   (face-specn nil)
                   (face-class nil)
                   (face-attrs nil)
                   (face-score  -1)
                   (face-match nil))
               (while face-props
                 (setq face-specn (car face-props)
                       face-class (car face-specn)
                       face-attrs (cdr face-specn)
                       face-props (cdr face-props))
                 ;; if the current element CEL of CLASS is t we match
                 ;; if the current face-class is t, we match
                 ;; if the cdr of CEL has a non-nil
                 ;;   intersection with the cdr of the first member of
                 ;;   the current face-class with the same car as CEL, we match
                 ;; if we actually clash, then we can't match
                 (let ((cbuf class)
                       (cel    nil)
                       (key    nil)
                       (val    nil)
                       (x      nil)
                       (next   nil)
                       (score    0))
                   (while (and cbuf (not next))
                     (setq cel  (car cbuf)
                           cbuf (cdr cbuf)
                           key  (car  cel)
                           val  (cdr  cel)
                           val  (if (listp val) val (list val)))
                     (cond
                      ((or (eq cel t)
                           (memq face-class '(t default))) ;Default match.
                       (setq score 0) (ignore "t match"))
                      ((not (cdr (assq key face-class))) ;Neither good nor bad.
                       nil (ignore "non match, non collision"))
                      ((setq x (nreverse
                                (seq-intersection val (cdr (assq key face-class))
                                                  #'eq)))
                       (setq score (+ score (length x)))
                       (ignore "intersection"))
                      (t ;; nope.
                       (setq next t score -10) (ignore "collision")) ))
                   (if (> score face-score)
                       (progn
                         (setq face-match face-attrs
                               face-score score     )
                         (ignore "%d << %S/%S" score face-class class))
                     (ignore "--- %d ---- (insufficient)" score)) ))
               ;; matched ? last attrs : nil
               (if face-match
                   (if (listp (car face-match)) (car face-match) face-match)
                 nil))
           ;; Unfortunately the default face returns a
           ;; :background. Fortunately we can remove it, but how do we do
           ;; that in a non-system specific way?
           (let ((spec (face-attr-construct face))
                 (new-spec nil))
             (if (not (memq :background spec))
                 spec
               (while spec
                 (let ((a (nth 0 spec))
                       (b (nth 1 spec)))
                   (unless (and (eq a :background)
                                (stringp b)
                                (string= b "SystemWindow"))
                     (setq new-spec (cons a (cons b new-spec)))))
                 (setq spec (cddr spec)))
               new-spec)))))
    (if (or (memq :inherit face-spec) (eq 'default face))
        face-spec
      (append face-spec (list :inherit 'default)))))