branch: master
commit a867927a10728ad57f9c8e4dd3953d20c3bb6cfd
Author: Oleh Krehel <ohwoeo...@gmail.com>
Commit: Oleh Krehel <ohwoeo...@gmail.com>
"C-g" (`hydra-keyboard-quit' ) should run :post
* hydra.el (hydra--handle-nonhead): Bind the plain `hydra-keyboard-quit'
only when there's no :post.
(defhydra): When there's :post, add another head for keyboard quit.
* hydra-test.el (hydra-amaranth-vi): Update test.
Fixes #67.
---
hydra-test.el | 225 +++++++++++++++++++++++++++++++--------------------------
hydra.el | 191 +++++++++++++++++++++++++------------------------
2 files changed, 221 insertions(+), 195 deletions(-)
diff --git a/hydra-test.el b/hydra-test.el
index 754984d..9203a47 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -396,8 +396,29 @@ The body can be accessed via `hydra-toggle/body'."
("k" previous-line)
("q" nil "quit")))
'(progn
+ (defun hydra-vi/hydra-keyboard-quit nil "Create a hydra with no body and
the heads:
+
+\"\": `hydra-keyboard-quit',
+\"j\": `next-line',
+\"k\": `previous-line',
+\"q\": `nil'
+
+The body can be accessed via `hydra-vi/body'.
+
+Call the head: `hydra-keyboard-quit'."
+ (interactive)
+ (set-cursor-color "#e52b50")
+ (hydra-disable)
+ (hydra-cleanup)
+ (catch
+ (quote hydra-disable)
+
+ (call-interactively
+ (function hydra-keyboard-quit))
+ (set-cursor-color "#ffffff")))
(defun hydra-vi/next-line nil "Create a hydra with no body and the heads:
+\"\": `hydra-keyboard-quit',
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
@@ -410,49 +431,50 @@ Call the head: `next-line'."
(hydra-disable)
(catch (quote hydra-disable)
(condition-case err (prog1 t (call-interactively (function
next-line)))
- ((quit error) (message "%S" err)
+ ((quit error)
+ (message "%S" err)
(unless hydra-lv (sit-for 0.8))
nil))
(when hydra-is-helpful (hydra-vi/hint))
(setq hydra-last
(hydra-set-transient-map
(setq hydra-curr-map
- (quote
- (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can only
exit through a blue head")
- (hydra-set-transient-map
hydra-curr-map t)
- (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (7 . hydra-keyboard-quit)
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (kp-subtract . hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
+ (quote (keymap (t lambda nil (interactive)
+ (message "An amaranth Hydra can
only exit through a blue head")
+ (hydra-set-transient-map
hydra-curr-map t)
+ (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
+ (hydra-vi/hint)))
+ (113 . hydra-vi/nil)
+ (107 . hydra-vi/previous-line)
+ (106 . hydra-vi/next-line)
+ (7 . hydra-vi/hydra-keyboard-quit)
+ (kp-subtract .
hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra--digit-argument)
+ (48 . hydra--digit-argument)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
t (lambda nil (hydra-cleanup))))))
(defun hydra-vi/previous-line nil "Create a hydra with no body and the
heads:
+\"\": `hydra-keyboard-quit',
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
@@ -465,49 +487,50 @@ Call the head: `previous-line'."
(hydra-disable)
(catch (quote hydra-disable)
(condition-case err (prog1 t (call-interactively (function
previous-line)))
- ((quit error) (message "%S" err)
+ ((quit error)
+ (message "%S" err)
(unless hydra-lv (sit-for 0.8))
nil))
(when hydra-is-helpful (hydra-vi/hint))
(setq hydra-last
(hydra-set-transient-map
(setq hydra-curr-map
- (quote
- (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can only
exit through a blue head")
- (hydra-set-transient-map
hydra-curr-map t)
- (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (7 . hydra-keyboard-quit)
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (kp-subtract . hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
+ (quote (keymap (t lambda nil (interactive)
+ (message "An amaranth Hydra can
only exit through a blue head")
+ (hydra-set-transient-map
hydra-curr-map t)
+ (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
+ (hydra-vi/hint)))
+ (113 . hydra-vi/nil)
+ (107 . hydra-vi/previous-line)
+ (106 . hydra-vi/next-line)
+ (7 . hydra-vi/hydra-keyboard-quit)
+ (kp-subtract .
hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra--digit-argument)
+ (48 . hydra--digit-argument)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
t (lambda nil (hydra-cleanup))))))
(defun hydra-vi/nil nil "Create a hydra with no body and the heads:
+\"\": `hydra-keyboard-quit',
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
@@ -530,6 +553,7 @@ Call the head: `nil'."
11 12 (face hydra-face-blue))))))
(defun hydra-vi/body nil "Create a hydra with no body and the heads:
+\"\": `hydra-keyboard-quit',
\"j\": `next-line',
\"k\": `previous-line',
\"q\": `nil'
@@ -543,39 +567,38 @@ The body can be accessed via `hydra-vi/body'."
(setq hydra-last
(hydra-set-transient-map
(setq hydra-curr-map
- (quote
- (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can only
exit through a blue head")
- (hydra-set-transient-map
hydra-curr-map t)
- (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (7 . hydra-keyboard-quit)
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (kp-subtract . hydra--negative-argument)
- (kp-9 . hydra--digit-argument)
- (kp-8 . hydra--digit-argument)
- (kp-7 . hydra--digit-argument)
- (kp-6 . hydra--digit-argument)
- (kp-5 . hydra--digit-argument)
- (kp-4 . hydra--digit-argument)
- (kp-3 . hydra--digit-argument)
- (kp-2 . hydra--digit-argument)
- (kp-1 . hydra--digit-argument)
- (kp-0 . hydra--digit-argument)
- (57 . hydra--digit-argument)
- (56 . hydra--digit-argument)
- (55 . hydra--digit-argument)
- (54 . hydra--digit-argument)
- (53 . hydra--digit-argument)
- (52 . hydra--digit-argument)
- (51 . hydra--digit-argument)
- (50 . hydra--digit-argument)
- (49 . hydra--digit-argument)
- (48 . hydra--digit-argument)
- (45 . hydra--negative-argument)
- (21 . hydra--universal-argument))))
+ (quote (keymap (t lambda nil (interactive)
+ (message "An amaranth Hydra can
only exit through a blue head")
+ (hydra-set-transient-map
hydra-curr-map t)
+ (when hydra-is-helpful (unless
hydra-lv (sit-for 0.8))
+ (hydra-vi/hint)))
+ (113 . hydra-vi/nil)
+ (107 . hydra-vi/previous-line)
+ (106 . hydra-vi/next-line)
+ (7 . hydra-vi/hydra-keyboard-quit)
+ (kp-subtract .
hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra--digit-argument)
+ (48 . hydra--digit-argument)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
t (lambda nil (hydra-cleanup))))
(setq prefix-arg current-prefix-arg)))))))
diff --git a/hydra.el b/hydra.el
index 55e8440..9639a57 100644
--- a/hydra.el
+++ b/hydra.el
@@ -628,10 +628,11 @@ OTHER-POST is an optional extension to the :post key of
BODY."
NAME, BODY and HEADS are parameters to `defhydra'."
(let ((body-color (hydra--body-color body))
(body-post (plist-get (cddr body) :post)))
- (when (and body-post (symbolp body-post))
- (setq body-post `(funcall #',body-post)))
- (when hydra-keyboard-quit
- (define-key keymap hydra-keyboard-quit #'hydra-keyboard-quit))
+ (if body-post
+ (when (symbolp body-post)
+ (setq body-post `(funcall #',body-post)))
+ (when hydra-keyboard-quit
+ (define-key keymap hydra-keyboard-quit #'hydra-keyboard-quit)))
(when (memq body-color '(amaranth pink teal))
(if (cl-some `(lambda (h)
(memq (hydra--head-color h body) '(blue teal)))
@@ -841,96 +842,98 @@ result of `defhydra'."
(setq docstring "hydra")))
(when (keywordp (car body))
(setq body (cons nil (cons nil body))))
- (dolist (h heads)
- (let ((len (length h))
- (cmd-name (hydra--head-name h name)))
- (cond ((< len 2)
- (error "Each head should have at least two items: %S" h))
- ((= len 2)
- (setcdr (cdr h)
- (list
- (hydra-plist-get-default (cddr body) :hint "")
- :cmd-name cmd-name)))
- (t
- (let ((hint (cl-caddr h)))
- (unless (or (null hint)
- (stringp hint))
- (setcdr (cdr h) (cons
- (hydra-plist-get-default (cddr body) :hint
"")
- (cddr h))))
- (setcdr (cddr h) `(:cmd-name ,cmd-name ,@(cl-cdddr h))))))))
- (let* ((keymap (copy-keymap hydra-base-map))
- (body-name (intern (format "%S/body" name)))
- (body-key (unless (hydra--callablep body)
- (cadr body)))
- (body-color (hydra--body-color body))
- (body-pre (plist-get (cddr body) :pre))
- (body-body-pre (plist-get (cddr body) :body-pre))
- (body-post (plist-get (cddr body) :post))
- (method (or (plist-get body :bind)
- (car body)))
- (doc (hydra--doc body-key body-name heads))
- (heads-nodup (hydra--delete-duplicates heads)))
- (mapc
- (lambda (x)
- (define-key keymap (kbd (car x))
- (plist-get (cl-cdddr x) :cmd-name)))
- heads)
- (when (and body-pre (symbolp body-pre))
- (setq body-pre `(funcall #',body-pre)))
- (when (and body-body-pre (symbolp body-body-pre))
- (setq body-body-pre `(funcall #',body-body-pre)))
- (when (and body-post (symbolp body-post))
- (setq body-post `(funcall #',body-post)))
- (hydra--handle-nonhead keymap name body heads)
- `(progn
- ,@(mapcar
- (lambda (head)
- (hydra--make-defun name body doc head keymap
- body-pre body-post))
- heads-nodup)
- ,@(unless (or (null body-key)
- (null method)
- (hydra--callablep method))
- `((unless (keymapp (lookup-key ,method (kbd ,body-key)))
- (define-key ,method (kbd ,body-key) nil))))
- ,@(delq nil
- (cl-mapcar
- (lambda (head)
- (let ((name (hydra--head-property head :cmd-name)))
- (when (cadr head)
- (when (or body-key method)
- (let ((bind (hydra--head-property head :bind 'default))
- (final-key
- (if body-key
- (vconcat (kbd body-key) (kbd (car head)))
- (kbd (car head)))))
- (cond ((null bind) nil)
-
- ((eq bind 'default)
- (list
- (if (hydra--callablep method)
- 'funcall
- 'define-key)
- method
- final-key
- (list 'function name)))
-
- ((hydra--callablep bind)
- `(funcall (function ,bind)
- ,final-key
- (function ,name)))
-
- (t
- (error "Invalid :bind property %S"
head))))))))
- heads))
- (defun ,(intern (format "%S/hint" name)) ()
- ,(hydra--message name body docstring heads))
- ,(hydra--make-defun
- name body doc '(nil body)
- keymap
- (or body-body-pre body-pre) body-post
- '(setq prefix-arg current-prefix-arg)))))
+ (let ((keymap (copy-keymap hydra-base-map))
+ (body-name (intern (format "%S/body" name)))
+ (body-key (cadr body))
+ (body-color (hydra--body-color body))
+ (body-pre (plist-get (cddr body) :pre))
+ (body-body-pre (plist-get (cddr body) :body-pre))
+ (body-post (plist-get (cddr body) :post))
+ (method (or (plist-get body :bind)
+ (car body))))
+ (when body-post
+ (when (symbolp body-post)
+ (setq body-post `(funcall #',body-post)))
+ (setq heads (cons (list hydra-keyboard-quit #'hydra-keyboard-quit nil
:exit t)
+ heads)))
+ (dolist (h heads)
+ (let ((len (length h))
+ (cmd-name (hydra--head-name h name)))
+ (cond ((< len 2)
+ (error "Each head should have at least two items: %S" h))
+ ((= len 2)
+ (setcdr (cdr h)
+ (list
+ (hydra-plist-get-default (cddr body) :hint "")
+ :cmd-name cmd-name)))
+ (t
+ (let ((hint (cl-caddr h)))
+ (unless (or (null hint)
+ (stringp hint))
+ (setcdr (cdr h) (cons
+ (hydra-plist-get-default (cddr body) :hint
"")
+ (cddr h))))
+ (setcdr (cddr h) `(:cmd-name ,cmd-name ,@(cl-cdddr h))))))))
+ (let ((doc (hydra--doc body-key body-name heads))
+ (heads-nodup (hydra--delete-duplicates heads)))
+ (mapc
+ (lambda (x)
+ (define-key keymap (kbd (car x))
+ (plist-get (cl-cdddr x) :cmd-name)))
+ heads)
+ (when (and body-pre (symbolp body-pre))
+ (setq body-pre `(funcall #',body-pre)))
+ (when (and body-body-pre (symbolp body-body-pre))
+ (setq body-body-pre `(funcall #',body-body-pre)))
+ (hydra--handle-nonhead keymap name body heads)
+ `(progn
+ ,@(mapcar
+ (lambda (head)
+ (hydra--make-defun name body doc head keymap
+ body-pre body-post))
+ heads-nodup)
+ ,@(unless (or (null body-key)
+ (null method)
+ (hydra--callablep method))
+ `((unless (keymapp (lookup-key ,method (kbd ,body-key)))
+ (define-key ,method (kbd ,body-key) nil))))
+ ,@(delq nil
+ (cl-mapcar
+ (lambda (head)
+ (let ((name (hydra--head-property head :cmd-name)))
+ (when (cadr head)
+ (when (or body-key method)
+ (let ((bind (hydra--head-property head :bind
'default))
+ (final-key
+ (if body-key
+ (vconcat (kbd body-key) (kbd (car head)))
+ (kbd (car head)))))
+ (cond ((null bind) nil)
+
+ ((eq bind 'default)
+ (list
+ (if (hydra--callablep method)
+ 'funcall
+ 'define-key)
+ method
+ final-key
+ (list 'function name)))
+
+ ((hydra--callablep bind)
+ `(funcall (function ,bind)
+ ,final-key
+ (function ,name)))
+
+ (t
+ (error "Invalid :bind property %S"
head))))))))
+ heads))
+ (defun ,(intern (format "%S/hint" name)) ()
+ ,(hydra--message name body docstring heads))
+ ,(hydra--make-defun
+ name body doc '(nil body)
+ keymap
+ (or body-body-pre body-pre) body-post
+ '(setq prefix-arg current-prefix-arg))))))
(defmacro defhydradio (name body &rest heads)
"Create radios with prefix NAME.
