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.
master
Oleh Krehel 11 years ago
parent a4c4eb6acb
commit 0f733d8efc
  1. 18
      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)

Loading…
Cancel
Save