From 900ca3426c3fde82c40d3edc74893d8b61d1cec6 Mon Sep 17 00:00:00 2001 From: Oleh Krehel Date: Tue, 19 May 2015 18:50:32 +0200 Subject: [PATCH] Allow access to the current hydra body * hydra.el (hydra-curr-body-fn): New defvar. (hydra--make-defun): All hydra heads will set `hydra-curr-body-fn' to their respective "hydra.../body" function. Users may read `hydra-curr-body-fn' from any head. Re #127 --- hydra-test.el | 66 +++++++++++++++++++++++++++++-------- hydra.el | 90 +++++++++++++++++++++++++++------------------------ 2 files changed, 100 insertions(+), 56 deletions(-) diff --git a/hydra-test.el b/hydra-test.el index 0fc82a1..b55f3ef 100644 --- a/hydra-test.el +++ b/hydra-test.el @@ -115,7 +115,9 @@ Call the head: `first-error'." (interactive) (hydra-default-pre) (let ((hydra--ignore t)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) (condition-case err (progn (setq this-command @@ -151,7 +153,9 @@ Call the head: `next-error'." (interactive) (hydra-default-pre) (let ((hydra--ignore t)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) (condition-case err (progn (setq this-command @@ -187,7 +191,9 @@ Call the head: `previous-error'." (interactive) (hydra-default-pre) (let ((hydra--ignore t)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) (condition-case err (progn (setq this-command @@ -236,7 +242,9 @@ The body can be accessed via `hydra-error/body'." (interactive) (hydra-default-pre) (let ((hydra--ignore nil)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) (when hydra-is-helpful (if hydra-lv (lv-message @@ -336,6 +344,8 @@ Call the head: `toggle-truncate-lines'." (interactive) (hydra-default-pre) (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) (progn (setq this-command (quote toggle-truncate-lines)) @@ -356,6 +366,8 @@ Call the head: `auto-fill-mode'." (interactive) (hydra-default-pre) (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) (progn (setq this-command (quote auto-fill-mode)) @@ -375,6 +387,8 @@ Call the head: `abbrev-mode'." (interactive) (hydra-default-pre) (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) (progn (setq this-command (quote abbrev-mode)) @@ -393,7 +407,9 @@ The body can be accessed via `hydra-toggle/body'. Call the head: `nil'." (interactive) (hydra-default-pre) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body))) (defun hydra-toggle/body nil "Create a hydra with no body and the heads: @@ -406,7 +422,9 @@ The body can be accessed via `hydra-toggle/body'." (interactive) (hydra-default-pre) (let ((hydra--ignore nil)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body))) (when hydra-is-helpful (if hydra-lv (lv-message @@ -501,7 +519,9 @@ Call the head: `next-line'." (hydra-default-pre) (set-cursor-color "#e52b50") (let ((hydra--ignore t)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) (condition-case err (progn (setq this-command @@ -536,7 +556,9 @@ Call the head: `previous-line'." (hydra-default-pre) (set-cursor-color "#e52b50") (let ((hydra--ignore t)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) (condition-case err (progn (setq this-command @@ -570,7 +592,9 @@ Call the head: `nil'." (interactive) (hydra-default-pre) (set-cursor-color "#e52b50") - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) (defun hydra-vi/body nil "Create a hydra with no body and the heads: @@ -583,7 +607,9 @@ The body can be accessed via `hydra-vi/body'." (hydra-default-pre) (set-cursor-color "#e52b50") (let ((hydra--ignore nil)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) (when hydra-is-helpful (if hydra-lv (lv-message @@ -676,7 +702,9 @@ Call the head: `(text-scale-set 0)'." (interactive) (hydra-default-pre) (let ((hydra--ignore t)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) (condition-case err (call-interactively (function @@ -711,6 +739,8 @@ Call the head: `(text-scale-set 0)'." (interactive) (hydra-default-pre) (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body)) (call-interactively (function (lambda nil @@ -727,7 +757,9 @@ The body can be accessed via `hydra-zoom/body'." (interactive) (hydra-default-pre) (let ((hydra--ignore nil)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) (when hydra-is-helpful (if hydra-lv (lv-message @@ -821,7 +853,9 @@ Call the head: `(text-scale-set 0)'." (interactive) (hydra-default-pre) (let ((hydra--ignore t)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) (condition-case err (call-interactively (function @@ -856,6 +890,8 @@ Call the head: `(text-scale-set 0)'." (interactive) (hydra-default-pre) (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body)) (call-interactively (function (lambda nil @@ -872,7 +908,9 @@ The body can be accessed via `hydra-zoom/body'." (interactive) (hydra-default-pre) (let ((hydra--ignore nil)) - (hydra-keyboard-quit)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) (when hydra-is-helpful (if hydra-lv (lv-message diff --git a/hydra.el b/hydra.el index 67a345e..16261dc 100644 --- a/hydra.el +++ b/hydra.el @@ -88,6 +88,9 @@ (defvar hydra-curr-foreign-keys nil "The current :foreign-keys behavior.") +(defvar hydra-curr-body-fn nil + "The current hydra-.../body function.") + (defvar hydra-deactivate nil "If a Hydra head sets this to t, exit the Hydra. This will be done even if the head wasn't designated for exiting.") @@ -205,28 +208,28 @@ When nil, you can specify your own at each location like this: _ 5a_.") "0.13.1") (defface hydra-face-red - '((t (:foreground "#FF0000" :bold t))) + '((t (:foreground "#FF0000" :bold t))) "Red Hydra heads don't exit the Hydra. Every other command exits the Hydra." :group 'hydra) (defface hydra-face-blue - '((t (:foreground "#0000FF" :bold t))) + '((t (:foreground "#0000FF" :bold t))) "Blue Hydra heads exit the Hydra. Every other command exits as well.") (defface hydra-face-amaranth - '((t (:foreground "#E52B50" :bold t))) + '((t (:foreground "#E52B50" :bold t))) "Amaranth body has red heads and warns on intercepting non-heads. Exitable only through a blue head.") (defface hydra-face-pink - '((t (:foreground "#FF6EB4" :bold t))) + '((t (:foreground "#FF6EB4" :bold t))) "Pink body has red heads and runs intercepted non-heads. Exitable only through a blue head.") (defface hydra-face-teal - '((t (:foreground "#367588" :bold t))) + '((t (:foreground "#367588" :bold t))) "Teal body has blue heads and warns on intercepting non-heads. Exitable only through a blue head.") @@ -405,9 +408,9 @@ Return DEFAULT if PROP is not in H." (cancel-timer hydra-message-timer) (unless (and hydra--ignore (null hydra--work-around-dedicated)) - (if hydra-lv - (lv-delete-window) - (message ""))) + (if hydra-lv + (lv-delete-window) + (message ""))) nil) (defun hydra--hint (body heads) @@ -458,7 +461,8 @@ HEAD's binding is returned as a string with a colored face." (hydra--complain "nil cmd can only be blue")) (propertize (if (string= (car head) "%") "%%" - (car head)) 'face + (car head)) + 'face (cl-case head-color (blue 'hydra-face-blue) (red 'hydra-face-red) @@ -585,7 +589,7 @@ HEAD is one of the HEADS passed to `defhydra'. BODY-PRE is added to the start of the wrapper. BODY-BEFORE-EXIT will be called before the hydra quits. BODY-AFTER-EXIT is added to the end of the wrapper." - (let ((name (hydra--head-name head name)) + (let ((cmd-name (hydra--head-name head name)) (cmd (when (car head) (hydra--make-callable (cadr head)))) @@ -596,45 +600,47 @@ BODY-AFTER-EXIT is added to the end of the wrapper." (body-foreign-keys (hydra--body-foreign-keys body)) (body-timeout (plist-get body :timeout)) (body-idle (plist-get body :idle))) - `(defun ,name () + `(defun ,cmd-name () ,doc (interactive) (hydra-default-pre) ,@(when body-pre (list body-pre)) ,@(if (hydra--head-property head :exit) `((hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name))) ,@(if body-after-exit `((unwind-protect ,(when cmd - (hydra--call-interactively cmd (cadr head))) + (hydra--call-interactively cmd (cadr head))) ,body-after-exit)) - (when cmd - `(,(hydra--call-interactively cmd (cadr head)))))) - (delq - nil - `((let ((hydra--ignore ,(not (eq (cadr head) 'body)))) - (hydra-keyboard-quit)) - ,(when cmd - `(condition-case err - ,(hydra--call-interactively cmd (cadr head)) - ((quit error) - (message "%S" err) - (unless hydra-lv - (sit-for 0.8))))) - ,(if (and body-idle (eq (cadr head) 'body)) - `(hydra-idle-message ,body-idle ,hint) - `(when hydra-is-helpful - (if hydra-lv - (lv-message (eval ,hint)) - (message (eval ,hint))))) - (hydra-set-transient-map - ,keymap - (lambda () (hydra-keyboard-quit) ,body-before-exit) - ,(when body-foreign-keys - (list 'quote body-foreign-keys))) - ,body-after-exit - ,(when body-timeout - `(hydra-timeout ,body-timeout)))))))) + (when cmd + `(,(hydra--call-interactively cmd (cadr head)))))) + (delq + nil + `((let ((hydra--ignore ,(not (eq (cadr head) 'body)))) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name)))) + ,(when cmd + `(condition-case err + ,(hydra--call-interactively cmd (cadr head)) + ((quit error) + (message "%S" err) + (unless hydra-lv + (sit-for 0.8))))) + ,(if (and body-idle (eq (cadr head) 'body)) + `(hydra-idle-message ,body-idle ,hint) + `(when hydra-is-helpful + (if hydra-lv + (lv-message (eval ,hint)) + (message (eval ,hint))))) + (hydra-set-transient-map + ,keymap + (lambda () (hydra-keyboard-quit) ,body-before-exit) + ,(when body-foreign-keys + (list 'quote body-foreign-keys))) + ,body-after-exit + ,(when body-timeout + `(hydra-timeout ,body-timeout)))))))) (defmacro hydra--make-funcall (sym) "Transform SYM into a `funcall' to call it." @@ -788,7 +794,7 @@ Cancel the previous `hydra-timeout'." hydra-timeout-timer `(lambda () ,(when function - `(funcall ,function)) + `(funcall ,function)) (hydra-keyboard-quit))) (timer-activate hydra-timeout-timer)) @@ -956,8 +962,8 @@ result of `defhydra'." ,@(unless (or (null body-key) (null body-map) (hydra--callablep body-map)) - `((unless (keymapp (lookup-key ,body-map (kbd ,body-key))) - (define-key ,body-map (kbd ,body-key) nil)))) + `((unless (keymapp (lookup-key ,body-map (kbd ,body-key))) + (define-key ,body-map (kbd ,body-key) nil)))) ;; bind keys ,@(delq nil (mapcar