Alias :post to :before-exit, and add :after-exit

* hydra.el (hydra--make-defun): Update.
(hydra--make-funcall): Update doc.
(defhydra): Update.

Re #90
master
Oleh Krehel 11 years ago
parent 986226f865
commit 51e7753aea
  1. 38
      hydra.el

@ -551,13 +551,15 @@ HEADS is a list of heads."
(format "The body can be accessed via `%S'." body-name))) (format "The body can be accessed via `%S'." body-name)))
(defun hydra--make-defun (name body doc head (defun hydra--make-defun (name body doc head
keymap body-pre body-post &optional other-post) keymap body-pre body-before-exit
&optional body-after-exit)
"Make a defun wrapper, using NAME, BODY, DOC, HEAD, and KEYMAP. "Make a defun wrapper, using NAME, BODY, DOC, HEAD, and KEYMAP.
NAME and BODY are the arguments to `defhydra'. NAME and BODY are the arguments to `defhydra'.
DOC was generated with `hydra--doc'. DOC was generated with `hydra--doc'.
HEAD is one of the HEADS passed to `defhydra'. HEAD is one of the HEADS passed to `defhydra'.
BODY-PRE and BODY-POST are pre-processed in `defhydra'. BODY-PRE is added to the start of the wrapper.
OTHER-POST is an optional extension to the :post key of BODY." 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 body)) (let ((name (hydra--head-name head name body))
(cmd (when (car head) (cmd (when (car head)
(hydra--make-callable (hydra--make-callable
@ -577,7 +579,8 @@ OTHER-POST is an optional extension to the :post key of BODY."
,@(when body-pre (list body-pre)) ,@(when body-pre (list body-pre))
,@(if (memq color '(blue teal)) ,@(if (memq color '(blue teal))
`((hydra-keyboard-quit) `((hydra-keyboard-quit)
,(when cmd `(call-interactively #',cmd))) ,(when cmd `(call-interactively #',cmd))
,@(when body-after-exit (list body-after-exit)))
(delq (delq
nil nil
`(,(when cmd `(,(when cmd
@ -591,7 +594,7 @@ OTHER-POST is an optional extension to the :post key of BODY."
(,hint)) (,hint))
(hydra-set-transient-map (hydra-set-transient-map
,keymap ,keymap
(lambda () (hydra-keyboard-quit) ,body-post) (lambda () (hydra-keyboard-quit) ,body-before-exit)
,(cond ,(cond
((memq body-color '(amaranth teal)) ((memq body-color '(amaranth teal))
''warn) ''warn)
@ -599,12 +602,12 @@ OTHER-POST is an optional extension to the :post key of BODY."
''run) ''run)
(t (t
nil))) nil)))
,(or other-post ,body-after-exit
(when body-timeout ,(when body-timeout
`(hydra-timeout ,body-timeout))))))))) `(hydra-timeout ,body-timeout))))))))
(defmacro hydra--make-funcall (sym) (defmacro hydra--make-funcall (sym)
"Transform SYM into a `funcall' that calls it." "Transform SYM into a `funcall' to call it."
`(when (and ,sym (symbolp ,sym)) `(when (and ,sym (symbolp ,sym))
(setq ,sym `(funcall #',,sym)))) (setq ,sym `(funcall #',,sym))))
@ -762,7 +765,7 @@ BODY-MAP is a keymap; `global-map' is used quite often. Each
function generated from HEADS will be bound in BODY-MAP to function generated from HEADS will be bound in BODY-MAP to
BODY-KEY + KEY (both are strings passed to `kbd'), and will set BODY-KEY + KEY (both are strings passed to `kbd'), and will set
the transient map so that all following heads can be called the transient map so that all following heads can be called
though KEY only. BODY-KEY can be an empty string. though KEY only. BODY-KEY can be an empty string.
CMD is a callable expression: either an interactive function CMD is a callable expression: either an interactive function
name, or an interactive lambda, or a single sexp (it will be name, or an interactive lambda, or a single sexp (it will be
@ -807,9 +810,12 @@ result of `defhydra'."
(plist-get body-plist :bind))) (plist-get body-plist :bind)))
(body-pre (plist-get body-plist :pre)) (body-pre (plist-get body-plist :pre))
(body-body-pre (plist-get body-plist :body-pre)) (body-body-pre (plist-get body-plist :body-pre))
(body-post (plist-get body-plist :post)) (body-before-exit (or (plist-get body-plist :post)
(plist-get body-plist :before-exit)))
(body-after-exit (plist-get body-plist :after-exit))
(body-color (hydra--body-color body))) (body-color (hydra--body-color body)))
(hydra--make-funcall body-post) (hydra--make-funcall body-before-exit)
(hydra--make-funcall body-after-exit)
(dolist (h heads) (dolist (h heads)
(let ((len (length h))) (let ((len (length h)))
(cond ((< len 2) (cond ((< len 2)
@ -862,7 +868,9 @@ result of `defhydra'."
,@(mapcar ,@(mapcar
(lambda (head) (lambda (head)
(hydra--make-defun name body doc head keymap-name (hydra--make-defun name body doc head keymap-name
body-pre body-post)) body-pre
body-before-exit
body-after-exit))
heads-nodup) heads-nodup)
;; free up keymap prefix ;; free up keymap prefix
,@(unless (or (null body-key) ,@(unless (or (null body-key)
@ -891,14 +899,14 @@ result of `defhydra'."
t)) t))
`(define-key ,bind ,final-key (function ,name))) `(define-key ,bind ,final-key (function ,name)))
(t (t
(error "Invalid :bind property `%S' for head %S" bind head))))))) (error "Invalid :bind property `%S' for head %S" bind head)))))))
heads)) heads))
(defun ,(intern (format "%S/hint" name)) () (defun ,(intern (format "%S/hint" name)) ()
,(hydra--message name body docstring heads)) ,(hydra--message name body docstring heads))
,(hydra--make-defun ,(hydra--make-defun
name body doc '(nil body) name body doc '(nil body)
keymap-name keymap-name
(or body-body-pre body-pre) body-post (or body-body-pre body-pre) body-before-exit
'(setq prefix-arg current-prefix-arg)))))) '(setq prefix-arg current-prefix-arg))))))
(defmacro defhydradio (name _body &rest heads) (defmacro defhydradio (name _body &rest heads)

Loading…
Cancel
Save