[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 9f5f089 2/4: Allow head-hint to be dynamic
From: |
Oleh Krehel |
Subject: |
[elpa] master 9f5f089 2/4: Allow head-hint to be dynamic |
Date: |
Fri, 30 Oct 2015 09:46:28 +0000 |
branch: master
commit 9f5f089af4627f100f8ae453773aa6382fee44d1
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
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
---
hydra.el | 92 ++++++++++++++++++++++++++++++++++++-------------------------
1 files changed, 54 insertions(+), 38 deletions(-)
diff --git a/hydra.el b/hydra.el
index 37a0871..16d44b0 100644
--- a/hydra.el
+++ b/hydra.el
@@ -452,6 +452,11 @@ Return DEFAULT if PROP is not in H."
(format (format "%%%ds: %%%ds" key-width (- -1 doc-width))
key doc))
+(defun hydra--to-string (x)
+ (if (stringp x)
+ x
+ (eval x)))
+
(defun hydra--hint (body heads)
"Generate a hint for the echo area.
BODY, and HEADS are parameters to `defhydra'."
@@ -467,41 +472,48 @@ BODY, and HEADS are parameters to `defhydra'."
(cons (cadr h)
(cons pstr (cl-caddr h)))
alist)))))
-
(let ((keys (nreverse (mapcar #'cdr alist)))
- (n-cols (plist-get (cddr body) :columns)))
- (if n-cols
- (let ((n-rows (1+ (/ (length keys) n-cols)))
- (max-key-len (apply #'max (mapcar (lambda (x) (length (car
x))) keys)))
- (max-doc-len (apply #'max (mapcar (lambda (x) (length (cdr
x))) keys))))
- (concat
- "\n"
- (mapconcat #'identity
- (mapcar
- (lambda (x)
- (mapconcat
- (lambda (y)
- (and y
- (funcall hydra-key-doc-function
- (car y)
- max-key-len
- (cdr y)
- max-doc-len))) x ""))
- (hydra--matrix keys n-cols n-rows))
- "\n")))
-
-
- (concat
- (mapconcat
- (lambda (x)
- (format
- (if (> (length (cdr x)) 0)
- (concat hydra-head-format (cdr x))
- "%s")
- (car x)))
- keys
- ", ")
- (if keys "." ""))))))
+ (n-cols (plist-get (cddr body) :columns))
+ res)
+ (setq res
+ (if n-cols
+ (let ((n-rows (1+ (/ (length keys) n-cols)))
+ (max-key-len (apply #'max (mapcar (lambda (x) (length
(car x))) keys)))
+ (max-doc-len (apply #'max (mapcar (lambda (x)
+ (length
(hydra--to-string (cdr x)))) keys))))
+ `(concat
+ "\n"
+ (mapconcat #'identity
+ (mapcar
+ (lambda (x)
+ (mapconcat
+ (lambda (y)
+ (and y
+ (funcall hydra-key-doc-function
+ (car y)
+ ,max-key-len
+ (hydra--to-string (cdr y))
+ ,max-doc-len))) x ""))
+ ',(hydra--matrix keys n-cols n-rows))
+ "\n")))
+
+
+ `(concat
+ (mapconcat
+ (lambda (x)
+ (let ((str (hydra--to-string (cdr x))))
+ (format
+ (if (> (length str) 0)
+ (concat hydra-head-format str)
+ "%s")
+ (car x))))
+ ',keys
+ ", ")
+ ,(if keys "." ""))))
+ (if (cl-every #'stringp
+ (mapcar 'cddr alist))
+ (eval res)
+ res))))
(defvar hydra-fontify-head-function nil
"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))
`(concat (format ,(substring docstring 1) ,@(nreverse varlist))
,rest)
- `(format ,(replace-regexp-in-string
+ (let ((r `(replace-regexp-in-string
" +$" ""
- (concat docstring ": "
+ (concat ,docstring ": "
(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)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."
@@ -964,7 +979,8 @@ result of `defhydra'."
(t
(let ((hint (cl-caddr h)))
(unless (or (null hint)
- (stringp hint))
+ (stringp hint)
+ (stringp (eval hint)))
(setcdr (cdr h) (cons
(hydra-plist-get-default body-plist
:hint "")
(cddr h)))))