branch: master
commit d3d435deb6e1405d846c2296f7e41a956c519b06
Author: Oleh Krehel <ohwoeo...@gmail.com>
Commit: Oleh Krehel <ohwoeo...@gmail.com>
Finalize head inheritance
* hydra.el (hydra--body-exit): New defun.
(defhydra): Ensure that each head doesn't need the :exit info from the
body any more by putting the aggregated :exit in the head's own plist.
* hydra-test.el: Update tests.
Each hydra will now declare its own heads as a variable `foo/heads`.
It's possible to inherit them like this:
(defhydra hydra-zoom-child (:inherit (hydra-zoom/heads))
"zoom"
("q" nil))
One hydra can inherit from multiple parents. This one just adds a single
"q" head to the familiar hydra-zoom.
Fixes #57.
---
hydra-test.el | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
hydra.el | 61 ++++++++++++++++++++++++++++-------------
2 files changed, 126 insertions(+), 19 deletions(-)
diff --git a/hydra-test.el b/hydra-test.el
index 54da5d0..fcb34c5 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -70,6 +70,27 @@
(48 . hydra--digit-argument)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-error/heads nil
+ "Heads for hydra-error.")
+ (quote
+ (("h"
+ first-error
+ "first"
+ :exit nil)
+ ("j"
+ next-error
+ "next"
+ :exit nil)
+ ("k"
+ previous-error
+ "prev"
+ :exit nil)
+ ("SPC"
+ hydra-repeat
+ "rep"
+ :bind nil
+ :exit nil))))
(defun hydra-error/first-error nil
"Create a hydra with a \"M-g\" body and the heads:
@@ -257,6 +278,23 @@ The body can be accessed via `hydra-error/body'."
(48 . hydra--digit-argument)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-toggle/heads nil
+ "Heads for hydra-toggle.")
+ (quote
+ (("t"
+ toggle-truncate-lines
+ "truncate"
+ :exit t)
+ ("f"
+ auto-fill-mode
+ "fill"
+ :exit t)
+ ("a"
+ abbrev-mode
+ "abbrev"
+ :exit t)
+ ("q" nil "cancel" :exit t))))
(defun hydra-toggle/toggle-truncate-lines-and-exit nil
"Create a hydra with no body and the heads:
@@ -403,6 +441,16 @@ The body can be accessed via `hydra-toggle/body'."
(48 . hydra--digit-argument)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-vi/heads nil
+ "Heads for hydra-vi.")
+ (quote
+ (("j" next-line "" :exit nil)
+ ("k"
+ previous-line
+ ""
+ :exit nil)
+ ("q" nil "quit" :exit nil))))
(defun hydra-vi/next-line nil
"Create a hydra with no body and the heads:
@@ -551,6 +599,24 @@ The body can be accessed via `hydra-vi/body'."
(48 . hydra-zoom/lambda-0-and-exit)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-zoom/heads nil
+ "Heads for hydra-zoom.")
+ (quote
+ (("r"
+ (text-scale-set 0)
+ "reset"
+ :exit nil)
+ ("0"
+ (text-scale-set 0)
+ ""
+ :bind nil
+ :exit t)
+ ("1"
+ (text-scale-set 0)
+ nil
+ :bind nil
+ :exit t))))
(defun hydra-zoom/lambda-r nil
"Create a hydra with no body and the heads:
@@ -674,6 +740,24 @@ The body can be accessed via `hydra-zoom/body'."
(48 . hydra-zoom/lambda-0-and-exit)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
+ (set
+ (defvar hydra-zoom/heads nil
+ "Heads for hydra-zoom.")
+ (quote
+ (("r"
+ (text-scale-set 0)
+ "reset"
+ :exit nil)
+ ("0"
+ (text-scale-set 0)
+ ""
+ :bind nil
+ :exit t)
+ ("1"
+ (text-scale-set 0)
+ nil
+ :bind nil
+ :exit nil))))
(defun hydra-zoom/lambda-r nil
"Create a hydra with no body and the heads:
diff --git a/hydra.el b/hydra.el
index 599ad47..1397035 100644
--- a/hydra.el
+++ b/hydra.el
@@ -380,6 +380,15 @@ Return DEFAULT if PROP is not in H."
((amaranth teal) 'warn)
(pink 'run)))))
+(defun hydra--body-exit (body)
+ "Return the exit behavior of BODY."
+ (or
+ (plist-get (cddr body) :exit)
+ (let ((color (plist-get (cddr body) :color)))
+ (cl-case color
+ ((blue teal) t)
+ (t nil)))))
+
(defvar hydra--input-method-function nil
"Store overridden `input-method-function' here.")
@@ -798,7 +807,8 @@ result of `defhydra'."
(plist-get body-plist :before-exit)))
(body-after-exit (plist-get body-plist :after-exit))
(body-inherit (plist-get body-plist :inherit))
- (body-foreign-keys (hydra--body-foreign-keys body)))
+ (body-foreign-keys (hydra--body-foreign-keys body))
+ (body-exit (hydra--body-exit body)))
(hydra--make-funcall body-before-exit)
(hydra--make-funcall body-after-exit)
(dolist (base body-inherit)
@@ -812,22 +822,35 @@ result of `defhydra'."
(list
(hydra-plist-get-default body-plist :hint "")))
(setcdr (nthcdr 2 h)
- (list :cmd-name (hydra--head-name h name body))))
+ (list :cmd-name (hydra--head-name h name body)
+ :exit body-exit)))
(t
(let ((hint (cl-caddr h)))
(unless (or (null hint)
(stringp hint))
(setcdr (cdr h) (cons
(hydra-plist-get-default body-plist
:hint "")
- (cddr h))))
- (let ((hint-and-plist (cddr h)))
- (if (null (cdr hint-and-plist))
- (setcdr hint-and-plist
- (list :cmd-name
- (hydra--head-name h name body)))
- (plist-put (cdr hint-and-plist)
- :cmd-name
- (hydra--head-name h name body)))))))))
+ (cddr h)))))
+ (let ((hint-and-plist (cddr h)))
+ (if (null (cdr hint-and-plist))
+ (setcdr hint-and-plist
+ (list :cmd-name (hydra--head-name h name body)
+ :exit body-exit))
+ (let* ((plist (cl-cdddr h))
+ (h-color (plist-get plist :color)))
+ (if h-color
+ (progn
+ (plist-put plist :exit
+ (cl-case h-color
+ ((blue teal) t)
+ (t nil)))
+ (cl-remf (cl-cdddr h) :color))
+ (let ((h-exit (hydra-plist-get-default plist :exit
'default)))
+ (plist-put plist :exit
+ (if (eq h-exit 'default)
+ body-exit
+ h-exit))))
+ (plist-put plist :cmd-name (hydra--head-name h name
body)))))))))
(let ((doc (hydra--doc body-key body-name heads))
(heads-nodup (hydra--delete-duplicates heads)))
(mapc
@@ -852,14 +875,14 @@ result of `defhydra'."
,(format "Keymap for %S." name))
',keymap)
;; declare heads
- ;; (set (defvar ,(intern (format "%S/heads" name))
- ;; nil
- ;; ,(format "Heads for %S." name))
- ;; ',(mapcar (lambda (h)
- ;; (let ((j (copy-sequence h)))
- ;; (cl-remf (cl-cdddr j) :cmd-name)
- ;; j))
- ;; heads))
+ (set (defvar ,(intern (format "%S/heads" name))
+ nil
+ ,(format "Heads for %S." name))
+ ',(mapcar (lambda (h)
+ (let ((j (copy-sequence h)))
+ (cl-remf (cl-cdddr j) :cmd-name)
+ j))
+ heads))
;; create defuns
,@(mapcar
(lambda (head)
