Support custom faces everywhere.

Author: eigengrau

hydra.el

@@ -209,32 +209,54 @@ When nil, you can specify your own at each location like this: _ 5a_.")
  "Since the docstrings are aligned by hand anyway, this isn't very useful."
  "0.13.1")
 
+(defface hydra-default-face
+  '((t (:inherit default)))
+  "Face from which all Hydra faces inherit."
+  :group 'hydra)
+
+(defface hydra-docstring-face
+  '((t (:inherit hydra-default-face)))
+  "Face used for the header of the hydra menu."
+  :group 'hydra)
+
+(defface hydra-item-face
+  '((t (:inherit hydra-default-face)))
+  "Face used or individual Hydra entries, i. e, selection prompts
+and docstrings."
+  :group 'hydra)
+
+(defface hydra-selection-face
+  '((t (:inherit hydra-item-face)))
+  "Face from which the red, blue, pink and amaranth selection
+prompts inherit."
+  :group 'hydra)
+
 (defface hydra-face-red
-  '((t (:foreground "#FF0000" :bold t)))
+  '((t (:inherit hydra-selection-face :foreground "#FF0000" :bold t)))
   "Red Hydra heads don't exit the Hydra.
 Every other command exits the Hydra."
   :group 'hydra)
 
 (defface hydra-face-blue
   '((((class color) (background light))
-     :foreground "#0000FF" :bold t)
+     :inherit hydra-selection-face :foreground "#0000FF" :bold t)
     (((class color) (background dark))
-     :foreground "#8ac6f2" :bold t))
+     :inherit hydra-selection-face :foreground "#8ac6f2" :bold t))
   "Blue Hydra heads exit the Hydra.
 Every other command exits as well.")
 
 (defface hydra-face-amaranth
-  '((t (:foreground "#E52B50" :bold t)))
+  '((t (:inherit hydra-selection-face :foreground "#E52B50" :bold t)))
   "Amaranth body has red heads and warns on intercepting non-heads.
 Exitable only through a blue head.")
 
 (defface hydra-face-pink
-  '((t (:foreground "#FF6EB4" :bold t)))
+  '((t (:inherit hydra-selection-face  :foreground "#FF6EB4" :bold t)))
   "Pink body has red heads and runs intercepted non-heads.
 Exitable only through a blue head.")
 
 (defface hydra-face-teal
-  '((t (:foreground "#367588" :bold t)))
+  '((t (:inherit hydra-selection-face :foreground "#367588" :bold t)))
   "Teal body has blue heads and warns on intercepting non-heads.
 Exitable only through a blue head.")
 
@@ -439,11 +461,11 @@ BODY, and HEADS are parameters to `defhydra'."
        (lambda (x)
          (format
           (if (> (length (cdr x)) 0)
-              (concat "[%s]: " (cdr x))
+              (propertize (concat "[%s]: " (cdr x)) 'face 'hydra-item-face)
             "%s")
           (car x)))
        keys
-       ", "))))
+       (propertize ", " 'face 'hydra-default-face)))))
 
 (defvar hydra-fontify-head-function nil
   "Possible replacement for `hydra-fontify-head-default'.")
@@ -506,7 +528,8 @@ HEAD's binding is returned as a string wrapped with [] or {}."
 \"%`...\" expressions are extracted into \"%S\".
 _NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'.
 The expressions can be auto-expanded according to NAME."
-  (setq docstring (hydra--strip-align-markers docstring))
+  (setq docstring (propertize (hydra--strip-align-markers docstring)
+                              'face 'hydra-docstring-face))
   (let ((rest (hydra--hint body heads))
         (start 0)
         varlist
@@ -544,14 +567,26 @@ The expressions can be auto-expanded according to NAME."
                          (/= (aref spec (1- (length spec))) ?s))
                  (setq spec (concat spec "S")))
                (setq docstring
-                     (concat
-                      (substring docstring 0 start)
-                      "%" spec
-                      (substring docstring (+ start offset 1 lspec varp))))))))
+                     (propertize
+                      (concat
+                       (substring docstring 0 start)
+                       "%" spec
+                       (substring docstring (+ start offset 1 lspec varp)))
+                      'face 'hydra-docstring-face))))))
     (if (eq ?\n (aref docstring 0))
-        `(concat (format ,(substring docstring 1) ,@(nreverse varlist))
-                 ,rest)
-      `(format ,(concat docstring ": " rest ".")))))
+        `(let ((format-statement
+                (concat (format ,(substring docstring 1)
+                                ,@(nreverse varlist)) ,rest)))
+           (loop for i from 0 to (- (length format-statement) 1) do
+                 (when (eq (get-char-property i 'face format-statement) nil)
+                   (add-text-properties i (+ i 1)
+                                        '(face hydra-default-face)
+                                        format-statement)))
+           format-statement)
+      `(format ,(concat (propertize (concat docstring ": ")
+                                    'face 'hydra-docstring-face)
+                        rest
+                        (propertize "." 'face 'hydra-default-face))))))
 
 (defun hydra--complain (format-string &rest args)
   "Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."