branch: master
commit 843bc709a31691e8049ccb1e75d87514f42c9c99
Author: Oleh Krehel <ohwoeo...@gmail.com>
Commit: Oleh Krehel <ohwoeo...@gmail.com>
Add amaranth (immortal) Hydras
* hydra.el (hydra-face-amaranth): New face.
(hydra--face): Update.
(defhydra): If the body color is amaranth, it's only possible to exit
this Hydra through a blue head. None of the other key bindings, even
"C-g" will work. There's a check in place that the current Hydra should
have at least one blue head.
Re #17.
Example:
(defhydra hydra-vi
(:pre
(set-cursor-color "#40e0d0")
:post
(set-cursor-color "#ffffff")
:color amaranth)
"vi"
("l" forward-char)
("h" backward-char)
("j" next-line)
("k" previous-line)
("q" nil "quit"))
(global-set-key (kbd "C-z") 'hydra-vi/body)
---
hydra.el | 18 ++++++++++++++++++
1 files changed, 18 insertions(+), 0 deletions(-)
diff --git a/hydra.el b/hydra.el
index 23b563d..1049bfb 100644
--- a/hydra.el
+++ b/hydra.el
@@ -89,6 +89,10 @@
'((t (:foreground "#758BC6" :bold t)))
"Blue Hydra heads will vanquish the Hydra.")
+(defface hydra-face-amaranth
+ '((t (:foreground "#E52B50" :bold t)))
+ "Amaranth Hydra can exit only through a blue head.")
+
;;* Universal Argument
(defvar hydra-base-map
(let ((map (make-sparse-keymap)))
@@ -168,6 +172,7 @@
(cl-case (hydra--color h body-color)
(blue 'hydra-face-blue)
(red 'hydra-face-red)
+ (amaranth 'hydra-face-amaranth)
(t (error "Unknown color for %S" h))))
(defun hydra--hint (docstring heads body-color)
@@ -308,6 +313,19 @@ in turn can be either red or blue."
(when (and (or body-pre body-post)
(version< emacs-version "24.4"))
(error "At least Emacs 24.4 is needed for :pre and :post"))
+ (when (eq body-color 'amaranth)
+ (if (cl-some `(lambda (h)
+ (eq (hydra--color h ',body-color) 'blue))
+ heads)
+ (define-key keymap [t]
+ `(lambda ()
+ (interactive)
+ (message "An amaranth Hydra can only exit through a blue head")
+ (hydra-set-transient-map hydra-curr-map t)
+ (when hydra-is-helpful
+ (sit-for 0.8)
+ (message ,hint))))
+ (error "An amaranth Hydra must have at least one blue head in order to
exit")))
`(progn
,@(cl-mapcar
(lambda (head name)
