branch: elpa/htmlize
commit 32c69e90953ec4b1001830c46a1b7b6002aa4c4e
Author: Hrvoje Niksic <[email protected]>
Commit: Hrvoje Niksic <[email protected]>
Add htmlize-face-overrides.
Originally contributed by Phillip Lord.
---
NEWS | 6 ++++++
htmlize.el | 35 ++++++++++++++++++++++++++++++++---
2 files changed, 38 insertions(+), 3 deletions(-)
diff --git a/NEWS b/NEWS
index 484fc7a..ad49e85 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,11 @@
htmlize NEWS -- history of user-visible changes.
+* Changes in htmlize 1.51
+
+** `htmlize-face-overrides' can be used to override Emacs's face
+definitions.
+
+
* Changes in htmlize 1.47
** GNU Emacs 21 is no longer supported.
diff --git a/htmlize.el b/htmlize.el
index 8159877..0a275ef 100644
--- a/htmlize.el
+++ b/htmlize.el
@@ -289,6 +289,23 @@ running Emacs on non-X11 systems), this option is ignored."
:type 'boolean
:group 'htmlize)
+(defvar htmlize-face-overrides nil
+ "Overrides for face definitions.
+
+Normally face definitions are taken from Emacs settings for fonts
+in the current frame. For faces present in this plist, the
+definitions will be used instead. Keys in the plist are symbols
+naming the face and values are the overriding definitions. For
+example:
+
+ (setq htmlize-face-overrides
+ '(font-lock-warning-face \"black\"
+ font-lock-function-name-face \"red\"
+ font-lock-comment-face \"blue\"
+ default (:foreground \"dark-green\" :background \"yellow\")))
+
+This variable can be also be `let' bound when running `htmlize-buffer'.")
+
(defcustom htmlize-html-major-mode nil
"The mode the newly created HTML buffer will be put in.
Set this to nil if you prefer the default (fundamental) mode."
@@ -1180,7 +1197,7 @@ If no rgb.txt file is found, return nil."
;; htmlize supports attrlist by converting them to fstructs, the same
;; as with regular faces.
-(defun htmlize-attrlist-to-fstruct (attrlist)
+(defun htmlize-attrlist-to-fstruct (attrlist &optional name)
;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
(let ((fstruct (make-htmlize-fstruct)))
(cond ((eq (car attrlist) 'foreground-color)
@@ -1198,7 +1215,7 @@ If no rgb.txt file is found, return nil."
(value (pop attrlist)))
(when (and value (not (eq value 'unspecified)))
(htmlize-face-set-from-keyword-attr fstruct attr value))))))
- (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST")
+ (setf (htmlize-fstruct-css-name fstruct) (or name "custom"))
fstruct))
(defun htmlize-decode-face-prop (prop)
@@ -1235,6 +1252,17 @@ If no rgb.txt file is found, return nil."
(t
(apply #'nconc (mapcar #'htmlize-decode-face-prop prop)))))
+(defun htmlize-get-override-fstruct (face)
+ (let* ((raw-def (plist-get htmlize-face-overrides face))
+ (def (cond ((stringp raw-def) (list :foreground raw-def))
+ ((listp raw-def) raw-def)
+ (t
+ (error (format (concat "face override must be an "
+ "attribute list or string, got %s")
+ raw-def))))))
+ (and def
+ (htmlize-attrlist-to-fstruct def (symbol-name face)))))
+
(defun htmlize-make-face-map (faces)
;; Return a hash table mapping Emacs faces to htmlize's fstructs.
;; The keys are either face symbols or attrlists, so the test
@@ -1246,7 +1274,8 @@ If no rgb.txt file is found, return nil."
;; Haven't seen FACE yet; convert it to an fstruct and cache
;; it.
(let ((fstruct (if (symbolp face)
- (htmlize-face-to-fstruct face)
+ (or (htmlize-get-override-fstruct face)
+ (htmlize-face-to-fstruct face))
(htmlize-attrlist-to-fstruct face))))
(setf (gethash face face-map) fstruct)
(let* ((css-name (htmlize-fstruct-css-name fstruct))
