[elpa] master 0f733d8 37/72: Add an option to fontify heads in a custom way

[Oleh Krehel]

branch: master
commit 0f733d8efcce7e82126282bcdfc92c4c7d25b273
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    Add an option to fontify heads in a custom way
    
    * hydra.el (hydra--hint): Forward to `hydra-fontify-head'.
    (hydra-fontify-head-function): New defvar.
    (hydra-fontify-head-default): New defun that represents the classic
    fontification behavior.
    (hydra-fontify-head): Fontification dispatch - use
    `hydra-fontify-head-default'
    unless `hydra-fontify-head-function' is set.
    (hydra--format): Forward to `hydra-fontify-head'.
    
    Example:
    
        (setq hydra-fontify-head-function
              (lambda (head body)
                (let ((color (hydra--head-color head body)))
                  (format
                   (if (eq color 'blue)
                       "[%s]"
                     "{%s}") (car head)))))
    
    Call `defhydra' here, then reset:
    
        (setq hydra-fontify-head-function nil)
    
    Call another `defhydra' here.
---
 hydra.el |   18 +++++++++++++++---
 1 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/hydra.el b/hydra.el
index 578d879..7f90315 100644
--- a/hydra.el
+++ b/hydra.el
@@ -310,8 +310,7 @@ NAME, BODY, DOCSTRING and HEADS are parameters to 
`defhydra'."
   (let (alist)
     (dolist (h heads)
       (let ((val (assoc (cadr h) alist))
-            (pstr (propertize (car h) 'face
-                              (hydra--face h body))))
+            (pstr (hydra-fontify-head h body)))
         (unless (and (> (length h) 2)
                      (null (cl-caddr h)))
           (if val
@@ -332,6 +331,19 @@ NAME, BODY, DOCSTRING and HEADS are parameters to 
`defhydra'."
      (nreverse (mapcar #'cdr alist))
      ", ")))
 
+(defvar hydra-fontify-head-function nil
+  "Possible replacement for `hydra-fontify-head-default'.")
+
+(defun hydra-fontify-head-default (head body)
+  "Produce a pretty string from HEAD and BODY.
+HEAD's binding is returned as a string with a colored face."
+  (propertize (car head) 'face (hydra--face head body)))
+
+(defun hydra-fontify-head (head body)
+  "Produce a pretty string from HEAD and BODY."
+  (funcall (or hydra-fontify-head-function 'hydra-fontify-head-default)
+           head body))
+
 (defun hydra--format (name body docstring heads)
   "Generate a `format' statement from STR.
 \"%`...\" expressions are extracted into \"%S\".
@@ -352,7 +364,7 @@ The expressions can be auto-expanded according to NAME."
                  (head (assoc key heads)))
             (if head
                 (progn
-                  (push (propertize key 'face (hydra--face head body)) varlist)
+                  (push (hydra-fontify-head head body) varlist)
                   (setq docstring (replace-match "% 3s" nil nil docstring)))
               (error "Unrecognized key: _%s_" key)))
         (push (hydra--unalias-var (match-string 2 docstring) prefix) varlist)