branch: master
commit 7010772be1f7dc9e67673cac53c7f9b305f4e89f
Author: Oleh Krehel <ohwoeo...@gmail.com>
Commit: Oleh Krehel <ohwoeo...@gmail.com>
hydra.el (hydra--head-color): Improve
* hydra.el (hydra--face): Second arg should be BODY.
(hydra--head-color): Second arg should be BODY.
---
hydra.el | 45 +++++++++++++++++++--------------------------
1 files changed, 19 insertions(+), 26 deletions(-)
diff --git a/hydra.el b/hydra.el
index 67fe34c..6b73627 100644
--- a/hydra.el
+++ b/hydra.el
@@ -223,24 +223,24 @@ Return DEFAULT if PROP is not in H."
(plist-get plist prop)
default)))
-(defun hydra--head-color (h body-color)
- "Return the color of a Hydra head H with BODY-COLOR."
+(defun hydra--head-color (h body)
+ "Return the color of a Hydra head H with BODY."
(let ((color (hydra--head-property h :color))
- (exit (hydra--head-property h :exit 'default))
+ (exit (or (plist-get (cddr body) :exit)
+ (hydra--head-property h :exit 'default)))
(nonheads (plist-get (cddr body) :nonheads)))
(cond ((null (cadr h))
'blue)
((eq exit t)
'blue)
- ((null exit)
- (cond ((eq nonheads 'warn)
- 'amaranth)
- ((eq nonheads 'run)
- 'pink)
- (t
- 'red)))
+ ((eq nonheads 'run)
+ 'pink)
+ ((eq nonheads 'warn)
+ (if (eq exit t)
+ 'teal
+ 'amaranth))
((null color)
- body-color)
+ (hydra--body-color body))
(t
color))))
@@ -257,9 +257,9 @@ BODY is the second argument to `defhydra'"
(color color)
(t 'red))))
-(defun hydra--face (h body-color)
- "Return the face for a Hydra head H with BODY-COLOR."
- (cl-case (hydra--head-color h body-color)
+(defun hydra--face (h body)
+ "Return the face for a Hydra head H with BODY."
+ (cl-case (hydra--head-color h body)
(blue 'hydra-face-blue)
(red 'hydra-face-red)
(amaranth 'hydra-face-amaranth)
@@ -304,12 +304,11 @@ Otherwise, add PREFIX to the symbol name."
(defun hydra--hint (name body docstring heads)
"Generate a hint for the echo area.
NAME, BODY, DOCSTRING and HEADS are parameters to `defhydra'."
- (let ((body-color (hydra--body-color body))
- alist)
+ (let (alist)
(dolist (h heads)
(let ((val (assoc (cadr h) alist))
(pstr (propertize (car h) 'face
- (hydra--face h body-color))))
+ (hydra--face h body))))
(unless (and (> (length h) 2)
(null (cl-caddr h)))
(if val
@@ -354,7 +353,7 @@ The expressions can be auto-expanded according to NAME."
(head (assoc key heads)))
(if head
(setq str (replace-match
- (propertize key 'face (hydra--face head body-color))
+ (propertize key 'face (hydra--face head body))
nil nil str))
(error "Unrecognized key: _%s_" key))))
`(format ,str ,@(nreverse varlist))))
@@ -442,15 +441,9 @@ BODY-COLOR, BODY-PRE, BODY-POST, and OTHER-POST are used
as well."
(body-post (plist-get (cddr body) :post)))
(when (memq body-color '(amaranth pink teal))
(if (cl-some `(lambda (h)
- (eq (hydra--head-color h ',body-color) 'blue))
+ (eq (hydra--head-color h body) 'blue))
heads)
(progn
- ;; (when (cl-some `(lambda (h)
- ;; (eq (hydra--head-color h ',body-color) 'red))
- ;; heads)
- ;; (warn
- ;; "%S body color: upgrading all red heads to %S"
- ;; body-color body-color))
(define-key keymap [t]
`(lambda ()
(interactive)
@@ -568,7 +561,7 @@ result of `defhydra'."
(lambda (head name)
(hydra--make-defun
name (hydra--make-callable
- (cadr head)) (hydra--head-color head body-color)
+ (cadr head)) (hydra--head-color head body)
(format "%s\n\nCall the head: `%S'." doc (cadr head))
hint-name keymap
body-color body-pre body-post))
