Function: hfy-face-to-style-i

hfy-face-to-style-i is a byte-compiled function defined in htmlfontify.el.gz.

Signature

(hfy-face-to-style-i FN)

Documentation

The guts of hfy-face-to-style.

FN should be a defface font spec, as returned by face-attr-construct or hfy-face-attr-for-class. Note that this function does not get font-sizes right if they are based on inherited modifiers (via the :inherit) attribute, and any other modifiers that are cumulative if they appear multiple times need to be merged by the user - hfy-flatten-style should do this.

Source Code

;; Defined in /usr/src/emacs/lisp/htmlfontify.el.gz
;; construct an assoc of (css-tag-name . css-tag-value) pairs
;; from a face or assoc of face attributes:

;; Some tests etc:
;;  (mumamo-message-with-face "testing face" 'highlight)
;;  (mumamo-message-with-face "testing face" '(:foreground "red" :background "yellow"))
;;  (hfy-face-to-style-i '(:inherit default foreground-color "red"))
;;  default face=(:stipple nil :background "SystemWindow" :foreground
;;    "SystemWindowText" :inverse-video nil :box nil :strike-through
;;    nil :overline nil :underline nil :slant normal :weight normal
;;    :height 98 :width normal :family "outline-courier new")
(defun hfy-face-to-style-i (fn)
  "The guts of `hfy-face-to-style'.
FN should be a `defface' font spec, as returned by
`face-attr-construct' or `hfy-face-attr-for-class'.  Note that
this function does not get font-sizes right if they are based on
inherited modifiers (via the :inherit) attribute, and any other
modifiers that are cumulative if they appear multiple times need
to be merged by the user - `hfy-flatten-style' should do this."
  ;;(message "hfy-face-to-style-i");;DBUG

  ;; fn's value could be something like
  ;; (:inherit
  ;;  ((foreground-color . "blue"))
  ;;  (foreground-color . "blue")
  ;;  nil)

  (when fn
    (let ((key  (car  fn))
          (val  (cadr fn))
          (next (cddr fn))
          (that       nil)
          (this       nil)
          (parent     nil))
      (if (eq key :inherit)
        (let ((vs (if (listp val) val (list val))))
          ;; (let ((x '(a b))) (setq x (append '(c d) x)))
          ;; (let ((x '(a b))) (setq x (append '(c d) x)))
          (dolist (v vs)
            (setq parent
                  (append
                   parent
                   (hfy-face-to-style-i
                    (hfy-face-attr-for-class v hfy-display-class))))))
        (setq this
              (if val (cl-case key
                       (:family         (hfy-family    val))
                       (:width          (hfy-width     val))
                       (:weight         (hfy-weight    val))
                       (:slant          (hfy-slant     val))
                       (:foreground     (hfy-color     val))
                       (:background     (hfy-bgcol     val))
                       (:box            (hfy-box       val))
                       (:height         (hfy-size      val))
                       (:underline      (hfy-decor key val))
                       (:overline       (hfy-decor key val))
                       (:strike-through (hfy-decor key val))
                       (:invisible      (hfy-invisible val))
                       (:bold           (hfy-weight  'bold))
                       (:italic         (hfy-slant 'italic))))))
      (setq that (hfy-face-to-style-i next))
      ;;(lwarn t :warning "%S => %S" fn (nconc this that parent))
      (append this parent that))) )