Allow head-hint to be dynamic

Instead of only a string like before, the head-hint can be anything that
evaluates to a string.

Example:

(defhydra hydra-test (:columns 2)
  "Test"
  ("j" next-line (format-time-string "%H:%M:%S" (current-time)))
  ("k" previous-line (format-time-string "%H:%M:%S" (current-time)))
  ("h" backward-char (format-time-string "%H:%M:%S" (current-time)))
  ("l" forward-char (format-time-string "%H:%M:%S" (current-time))))

Pressing "hjkl" will refresh the hint, and thus update the current time.
Note that the hint needs to evaluate to a string at both compile-time
and run-time. The column formatting depends on the compile-time result.

Fixes #160
master
Oleh Krehel 11 years ago
parent 0712176e9b
commit 9f5f089af4
  1. 92
      hydra.el

@ -452,6 +452,11 @@ Return DEFAULT if PROP is not in H."
(format (format "%%%ds: %%%ds" key-width (- -1 doc-width)) (format (format "%%%ds: %%%ds" key-width (- -1 doc-width))
key doc)) key doc))
(defun hydra--to-string (x)
(if (stringp x)
x
(eval x)))
(defun hydra--hint (body heads) (defun hydra--hint (body heads)
"Generate a hint for the echo area. "Generate a hint for the echo area.
BODY, and HEADS are parameters to `defhydra'." BODY, and HEADS are parameters to `defhydra'."
@ -467,41 +472,48 @@ BODY, and HEADS are parameters to `defhydra'."
(cons (cadr h) (cons (cadr h)
(cons pstr (cl-caddr h))) (cons pstr (cl-caddr h)))
alist))))) alist)))))
(let ((keys (nreverse (mapcar #'cdr alist))) (let ((keys (nreverse (mapcar #'cdr alist)))
(n-cols (plist-get (cddr body) :columns))) (n-cols (plist-get (cddr body) :columns))
(if n-cols res)
(let ((n-rows (1+ (/ (length keys) n-cols))) (setq res
(max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys))) (if n-cols
(max-doc-len (apply #'max (mapcar (lambda (x) (length (cdr x))) keys)))) (let ((n-rows (1+ (/ (length keys) n-cols)))
(concat (max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys)))
"\n" (max-doc-len (apply #'max (mapcar (lambda (x)
(mapconcat #'identity (length (hydra--to-string (cdr x)))) keys))))
(mapcar `(concat
(lambda (x) "\n"
(mapconcat (mapconcat #'identity
(lambda (y) (mapcar
(and y (lambda (x)
(funcall hydra-key-doc-function (mapconcat
(car y) (lambda (y)
max-key-len (and y
(cdr y) (funcall hydra-key-doc-function
max-doc-len))) x "")) (car y)
(hydra--matrix keys n-cols n-rows)) ,max-key-len
"\n"))) (hydra--to-string (cdr y))
,max-doc-len))) x ""))
',(hydra--matrix keys n-cols n-rows))
(concat "\n")))
(mapconcat
(lambda (x)
(format `(concat
(if (> (length (cdr x)) 0) (mapconcat
(concat hydra-head-format (cdr x)) (lambda (x)
"%s") (let ((str (hydra--to-string (cdr x))))
(car x))) (format
keys (if (> (length str) 0)
", ") (concat hydra-head-format str)
(if keys "." "")))))) "%s")
(car x))))
',keys
", ")
,(if keys "." ""))))
(if (cl-every #'stringp
(mapcar 'cddr alist))
(eval res)
res))))
(defvar hydra-fontify-head-function nil (defvar hydra-fontify-head-function nil
"Possible replacement for `hydra-fontify-head-default'.") "Possible replacement for `hydra-fontify-head-default'.")
@ -612,11 +624,14 @@ The expressions can be auto-expanded according to NAME."
(if (eq ?\n (aref docstring 0)) (if (eq ?\n (aref docstring 0))
`(concat (format ,(substring docstring 1) ,@(nreverse varlist)) `(concat (format ,(substring docstring 1) ,@(nreverse varlist))
,rest) ,rest)
`(format ,(replace-regexp-in-string (let ((r `(replace-regexp-in-string
" +$" "" " +$" ""
(concat docstring ": " (concat ,docstring ": "
(replace-regexp-in-string (replace-regexp-in-string
"\\(%\\)" "\\1\\1" rest))))))) "\\(%\\)" "\\1\\1" ,rest)))))
(if (stringp rest)
`(format ,(eval r))
`(format ,r))))))
(defun hydra--complain (format-string &rest args) (defun hydra--complain (format-string &rest args)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil." "Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."
@ -964,7 +979,8 @@ result of `defhydra'."
(t (t
(let ((hint (cl-caddr h))) (let ((hint (cl-caddr h)))
(unless (or (null hint) (unless (or (null hint)
(stringp hint)) (stringp hint)
(stringp (eval hint)))
(setcdr (cdr h) (cons (setcdr (cdr h) (cons
(hydra-plist-get-default body-plist :hint "") (hydra-plist-get-default body-plist :hint "")
(cddr h))))) (cddr h)))))

Loading…
Cancel
Save