wilderjds
/
hydra
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Allow access to the current hydra body

Browse Source 
* 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
master
Oleh Krehel 11 years ago
parent 2d458392f9
commit 900ca3426c
2 changed files with 100 additions and 56 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 66
      hydra-test.el
  2. 90
      hydra.el

66
hydra-test.el
Unescape View File

@ -115,7 +115,9 @@ Call the head: `first-error'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore t)) (let ((hydra--ignore t))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-error/body)))
(condition-case err (condition-case err
(progn (progn
(setq this-command (setq this-command
@ -151,7 +153,9 @@ Call the head: `next-error'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore t)) (let ((hydra--ignore t))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-error/body)))
(condition-case err (condition-case err
(progn (progn
(setq this-command (setq this-command
@ -187,7 +191,9 @@ Call the head: `previous-error'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore t)) (let ((hydra--ignore t))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-error/body)))
(condition-case err (condition-case err
(progn (progn
(setq this-command (setq this-command
@ -236,7 +242,9 @@ The body can be accessed via `hydra-error/body'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore nil)) (let ((hydra--ignore nil))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-error/body)))
(when hydra-is-helpful (when hydra-is-helpful
(if hydra-lv (if hydra-lv
(lv-message (lv-message
@ -336,6 +344,8 @@ Call the head: `toggle-truncate-lines'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(hydra-keyboard-quit) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-toggle/body))
(progn (progn
(setq this-command (setq this-command
(quote toggle-truncate-lines)) (quote toggle-truncate-lines))
@ -356,6 +366,8 @@ Call the head: `auto-fill-mode'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(hydra-keyboard-quit) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-toggle/body))
(progn (progn
(setq this-command (setq this-command
(quote auto-fill-mode)) (quote auto-fill-mode))
@ -375,6 +387,8 @@ Call the head: `abbrev-mode'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(hydra-keyboard-quit) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-toggle/body))
(progn (progn
(setq this-command (setq this-command
(quote abbrev-mode)) (quote abbrev-mode))
@ -393,7 +407,9 @@ The body can be accessed via `hydra-toggle/body'.
Call the head: `nil'." Call the head: `nil'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-toggle/body)))
(defun hydra-toggle/body nil (defun hydra-toggle/body nil
"Create a hydra with no body and the heads: "Create a hydra with no body and the heads:
@ -406,7 +422,9 @@ The body can be accessed via `hydra-toggle/body'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore nil)) (let ((hydra--ignore nil))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-toggle/body)))
(when hydra-is-helpful (when hydra-is-helpful
(if hydra-lv (if hydra-lv
(lv-message (lv-message
@ -501,7 +519,9 @@ Call the head: `next-line'."
(hydra-default-pre) (hydra-default-pre)
(set-cursor-color "#e52b50") (set-cursor-color "#e52b50")
(let ((hydra--ignore t)) (let ((hydra--ignore t))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-vi/body)))
(condition-case err (condition-case err
(progn (progn
(setq this-command (setq this-command
@ -536,7 +556,9 @@ Call the head: `previous-line'."
(hydra-default-pre) (hydra-default-pre)
(set-cursor-color "#e52b50") (set-cursor-color "#e52b50")
(let ((hydra--ignore t)) (let ((hydra--ignore t))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-vi/body)))
(condition-case err (condition-case err
(progn (progn
(setq this-command (setq this-command
@ -570,7 +592,9 @@ Call the head: `nil'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(set-cursor-color "#e52b50") (set-cursor-color "#e52b50")
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-vi/body)))
(defun hydra-vi/body nil (defun hydra-vi/body nil
"Create a hydra with no body and the heads: "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) (hydra-default-pre)
(set-cursor-color "#e52b50") (set-cursor-color "#e52b50")
(let ((hydra--ignore nil)) (let ((hydra--ignore nil))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-vi/body)))
(when hydra-is-helpful (when hydra-is-helpful
(if hydra-lv (if hydra-lv
(lv-message (lv-message
@ -676,7 +702,9 @@ Call the head: `(text-scale-set 0)'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore t)) (let ((hydra--ignore t))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
(condition-case err (condition-case err
(call-interactively (call-interactively
(function (function
@ -711,6 +739,8 @@ Call the head: `(text-scale-set 0)'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(hydra-keyboard-quit) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body))
(call-interactively (call-interactively
(function (function
(lambda nil (lambda nil
@ -727,7 +757,9 @@ The body can be accessed via `hydra-zoom/body'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore nil)) (let ((hydra--ignore nil))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
(when hydra-is-helpful (when hydra-is-helpful
(if hydra-lv (if hydra-lv
(lv-message (lv-message
@ -821,7 +853,9 @@ Call the head: `(text-scale-set 0)'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore t)) (let ((hydra--ignore t))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
(condition-case err (condition-case err
(call-interactively (call-interactively
(function (function
@ -856,6 +890,8 @@ Call the head: `(text-scale-set 0)'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(hydra-keyboard-quit) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body))
(call-interactively (call-interactively
(function (function
(lambda nil (lambda nil
@ -872,7 +908,9 @@ The body can be accessed via `hydra-zoom/body'."
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
(let ((hydra--ignore nil)) (let ((hydra--ignore nil))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
(when hydra-is-helpful (when hydra-is-helpful
(if hydra-lv (if hydra-lv
(lv-message (lv-message

90
hydra.el
Unescape View File

@ -88,6 +88,9 @@
(defvar hydra-curr-foreign-keys nil (defvar hydra-curr-foreign-keys nil
"The current :foreign-keys behavior.") "The current :foreign-keys behavior.")
(defvar hydra-curr-body-fn nil
"The current hydra-.../body function.")
(defvar hydra-deactivate nil (defvar hydra-deactivate nil
"If a Hydra head sets this to t, exit the Hydra. "If a Hydra head sets this to t, exit the Hydra.
This will be done even if the head wasn't designated for exiting.") 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") "0.13.1")
(defface hydra-face-red (defface hydra-face-red
'((t (:foreground "#FF0000" :bold t))) '((t (:foreground "#FF0000" :bold t)))
"Red Hydra heads don't exit the Hydra. "Red Hydra heads don't exit the Hydra.
Every other command exits the Hydra." Every other command exits the Hydra."
:group 'hydra) :group 'hydra)
(defface hydra-face-blue (defface hydra-face-blue
'((t (:foreground "#0000FF" :bold t))) '((t (:foreground "#0000FF" :bold t)))
"Blue Hydra heads exit the Hydra. "Blue Hydra heads exit the Hydra.
Every other command exits as well.") Every other command exits as well.")
(defface hydra-face-amaranth (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. "Amaranth body has red heads and warns on intercepting non-heads.
Exitable only through a blue head.") Exitable only through a blue head.")
(defface hydra-face-pink (defface hydra-face-pink
'((t (:foreground "#FF6EB4" :bold t))) '((t (:foreground "#FF6EB4" :bold t)))
"Pink body has red heads and runs intercepted non-heads. "Pink body has red heads and runs intercepted non-heads.
Exitable only through a blue head.") Exitable only through a blue head.")
(defface hydra-face-teal (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. "Teal body has blue heads and warns on intercepting non-heads.
Exitable only through a blue head.") Exitable only through a blue head.")
@ -405,9 +408,9 @@ Return DEFAULT if PROP is not in H."
(cancel-timer hydra-message-timer) (cancel-timer hydra-message-timer)
(unless (and hydra--ignore (unless (and hydra--ignore
(null hydra--work-around-dedicated)) (null hydra--work-around-dedicated))
(if hydra-lv (if hydra-lv
(lv-delete-window) (lv-delete-window)
(message ""))) (message "")))
nil) nil)
(defun hydra--hint (body heads) (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")) (hydra--complain "nil cmd can only be blue"))
(propertize (if (string= (car head) "%") (propertize (if (string= (car head) "%")
"%%" "%%"
(car head)) 'face (car head))
'face
(cl-case head-color (cl-case head-color
(blue 'hydra-face-blue) (blue 'hydra-face-blue)
(red 'hydra-face-red) (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-PRE is added to the start of the wrapper.
BODY-BEFORE-EXIT will be called before the hydra quits. BODY-BEFORE-EXIT will be called before the hydra quits.
BODY-AFTER-EXIT is added to the end of the wrapper." 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) (cmd (when (car head)
(hydra--make-callable (hydra--make-callable
(cadr head)))) (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-foreign-keys (hydra--body-foreign-keys body))
(body-timeout (plist-get body :timeout)) (body-timeout (plist-get body :timeout))
(body-idle (plist-get body :idle))) (body-idle (plist-get body :idle)))
`(defun ,name () `(defun ,cmd-name ()
,doc ,doc
(interactive) (interactive)
(hydra-default-pre) (hydra-default-pre)
,@(when body-pre (list body-pre)) ,@(when body-pre (list body-pre))
,@(if (hydra--head-property head :exit) ,@(if (hydra--head-property head :exit)
`((hydra-keyboard-quit) `((hydra-keyboard-quit)
(setq hydra-curr-body-fn ',(intern (format "%S/body" name)))
,@(if body-after-exit ,@(if body-after-exit
`((unwind-protect `((unwind-protect
,(when cmd ,(when cmd
(hydra--call-interactively cmd (cadr head))) (hydra--call-interactively cmd (cadr head)))
,body-after-exit)) ,body-after-exit))
(when cmd (when cmd
`(,(hydra--call-interactively cmd (cadr head)))))) `(,(hydra--call-interactively cmd (cadr head))))))
(delq (delq
nil nil
`((let ((hydra--ignore ,(not (eq (cadr head) 'body)))) `((let ((hydra--ignore ,(not (eq (cadr head) 'body))))
(hydra-keyboard-quit)) (hydra-keyboard-quit)
,(when cmd (setq hydra-curr-body-fn ',(intern (format "%S/body" name))))
`(condition-case err ,(when cmd
,(hydra--call-interactively cmd (cadr head)) `(condition-case err
((quit error) ,(hydra--call-interactively cmd (cadr head))
(message "%S" err) ((quit error)
(unless hydra-lv (message "%S" err)
(sit-for 0.8))))) (unless hydra-lv
,(if (and body-idle (eq (cadr head) 'body)) (sit-for 0.8)))))
`(hydra-idle-message ,body-idle ,hint) ,(if (and body-idle (eq (cadr head) 'body))
`(when hydra-is-helpful `(hydra-idle-message ,body-idle ,hint)
(if hydra-lv `(when hydra-is-helpful
(lv-message (eval ,hint)) (if hydra-lv
(message (eval ,hint))))) (lv-message (eval ,hint))
(hydra-set-transient-map (message (eval ,hint)))))
,keymap (hydra-set-transient-map
(lambda () (hydra-keyboard-quit) ,body-before-exit) ,keymap
,(when body-foreign-keys (lambda () (hydra-keyboard-quit) ,body-before-exit)
(list 'quote body-foreign-keys))) ,(when body-foreign-keys
,body-after-exit (list 'quote body-foreign-keys)))
,(when body-timeout ,body-after-exit
`(hydra-timeout ,body-timeout)))))))) ,(when body-timeout
`(hydra-timeout ,body-timeout))))))))
(defmacro hydra--make-funcall (sym) (defmacro hydra--make-funcall (sym)
"Transform SYM into a `funcall' to call it." "Transform SYM into a `funcall' to call it."
@ -788,7 +794,7 @@ Cancel the previous `hydra-timeout'."
hydra-timeout-timer hydra-timeout-timer
`(lambda () `(lambda ()
,(when function ,(when function
`(funcall ,function)) `(funcall ,function))
(hydra-keyboard-quit))) (hydra-keyboard-quit)))
(timer-activate hydra-timeout-timer)) (timer-activate hydra-timeout-timer))
@ -956,8 +962,8 @@ result of `defhydra'."
,@(unless (or (null body-key) ,@(unless (or (null body-key)
(null body-map) (null body-map)
(hydra--callablep body-map)) (hydra--callablep body-map))
`((unless (keymapp (lookup-key ,body-map (kbd ,body-key))) `((unless (keymapp (lookup-key ,body-map (kbd ,body-key)))
(define-key ,body-map (kbd ,body-key) nil)))) (define-key ,body-map (kbd ,body-key) nil))))
;; bind keys ;; bind keys
,@(delq nil ,@(delq nil
(mapcar (mapcar

Write Preview
Loading…
Cancel
Save