Function: defhydra
defhydra is an autoloaded macro defined in hydra.el.
Signature
(defhydra NAME BODY &optional DOCSTRING &rest HEADS)
Documentation
Create a Hydra - a family of functions with prefix NAME.
NAME should be a symbol, it will be the prefix of all functions defined here.
BODY has the format:
(BODY-MAP BODY-KEY &rest BODY-PLIST)
DOCSTRING will be displayed in the echo area to identify the
Hydra. When DOCSTRING starts with a newline, special Ruby-style
substitution will be performed by hydra--format.
Functions are created on basis of HEADS, each of which has the format:
(KEY CMD &optional HINT &rest PLIST)
BODY-MAP is a keymap; global-map is used quite often. Each
function generated from HEADS will be bound in BODY-MAP to
BODY-KEY + KEY (both are strings passed to kbd), and will set
the transient map so that all following heads can be called
though KEY only. BODY-KEY can be an empty string.
CMD is a callable expression: either an interactive function name, or an interactive lambda, or a single sexp (it will be wrapped in an interactive lambda).
HINT is a short string that identifies its head. It will be
printed beside KEY in the echo erea if hydra-is-helpful is not
nil. If you don't even want the KEY to be printed, set HINT
explicitly to nil.
The heads inherit their PLIST from BODY-PLIST and are allowed to
override some keys. The keys recognized are :exit, :bind, and :column.
:exit can be:
- nil (default): this head will continue the Hydra state.
- t: this head will stop the Hydra state.
:bind can be:
- nil: this head will not be bound in BODY-MAP.
- a lambda taking KEY and CMD used to bind a head.
:column is a string that sets the column for all subsequent heads.
It is possible to omit both BODY-MAP and BODY-KEY if you don't
want to bind anything. In that case, typically you will bind the
generated NAME/body command. This command is also the return
result of defhydra.
Source Code
;; Defined in ~/.emacs.d/elpa/hydra-20250316.1254/hydra.el
;;* Macros
;;;###autoload
(defmacro defhydra (name body &optional docstring &rest heads)
"Create a Hydra - a family of functions with prefix NAME.
NAME should be a symbol, it will be the prefix of all functions
defined here.
BODY has the format:
(BODY-MAP BODY-KEY &rest BODY-PLIST)
DOCSTRING will be displayed in the echo area to identify the
Hydra. When DOCSTRING starts with a newline, special Ruby-style
substitution will be performed by `hydra--format'.
Functions are created on basis of HEADS, each of which has the
format:
(KEY CMD &optional HINT &rest PLIST)
BODY-MAP is a keymap; `global-map' is used quite often. Each
function generated from HEADS will be bound in BODY-MAP to
BODY-KEY + KEY (both are strings passed to `kbd'), and will set
the transient map so that all following heads can be called
though KEY only. BODY-KEY can be an empty string.
CMD is a callable expression: either an interactive function
name, or an interactive lambda, or a single sexp (it will be
wrapped in an interactive lambda).
HINT is a short string that identifies its head. It will be
printed beside KEY in the echo erea if `hydra-is-helpful' is not
nil. If you don't even want the KEY to be printed, set HINT
explicitly to nil.
The heads inherit their PLIST from BODY-PLIST and are allowed to
override some keys. The keys recognized are :exit, :bind, and :column.
:exit can be:
- nil (default): this head will continue the Hydra state.
- t: this head will stop the Hydra state.
:bind can be:
- nil: this head will not be bound in BODY-MAP.
- a lambda taking KEY and CMD used to bind a head.
:column is a string that sets the column for all subsequent heads.
It is possible to omit both BODY-MAP and BODY-KEY if you don't
want to bind anything. In that case, typically you will bind the
generated NAME/body command. This command is also the return
result of `defhydra'."
(declare (indent defun) (doc-string 3))
(setq heads (copy-tree heads))
(cond ((stringp docstring))
((and (consp docstring)
(memq (car docstring) '(hydra--table concat format)))
(setq docstring (concat "\n" (eval docstring))))
(t
(setq heads (cons docstring heads))
(setq docstring "")))
(when (keywordp (car body))
(setq body (cons nil (cons nil body))))
(setq body (hydra--normalize-body body))
(condition-case-unless-debug err
(let* ((keymap-name (intern (format "%S/keymap" name)))
(body-name (intern (format "%S/body" name)))
(body-key (cadr body))
(body-plist (cddr body))
(base-map (or (eval (plist-get body-plist :base-map))
hydra-base-map))
(keymap (copy-keymap base-map))
(body-map (or (car body)
(plist-get body-plist :bind)))
(body-pre (plist-get body-plist :pre))
(body-body-pre (plist-get body-plist :body-pre))
(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-inherit (plist-get body-plist :inherit))
(body-foreign-keys (hydra--body-foreign-keys body))
(body-exit (hydra--body-exit body)))
(dolist (base body-inherit)
(setq heads (append heads (copy-sequence (eval base)))))
(dolist (h heads)
(let ((len (length h)))
(cond ((< len 2)
(error "Each head should have at least two items: %S" h))
((= len 2)
(setcdr (cdr h)
(list
(hydra-plist-get-default
body-plist :hint hydra-default-hint)))
(setcdr (nthcdr 2 h) (list :exit body-exit)))
(t
(let ((hint (cl-caddr h)))
(unless (or (null hint)
(stringp hint)
(consp hint))
(let ((inherited-hint
(hydra-plist-get-default
body-plist :hint hydra-default-hint)))
(setcdr (cdr h) (cons
(if (eq 'none inherited-hint)
nil
inherited-hint)
(cddr h))))))
(let ((hint-and-plist (cddr h)))
(if (null (cdr hint-and-plist))
(setcdr hint-and-plist (list :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 (cl-cdddr h) :cmd-name (hydra--head-name h name))
(when (null (cadr h)) (plist-put (cl-cdddr h) :exit t)))
(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)
(hydra--make-funcall body-pre)
(hydra--make-funcall body-body-pre)
(hydra--make-funcall body-before-exit)
(hydra--make-funcall body-after-exit)
(when (memq body-foreign-keys '(run warn))
(unless (cl-some
(lambda (h)
(hydra--head-property h :exit))
heads)
(error
"An %S Hydra must have at least one blue head in order to exit"
body-foreign-keys)))
`(progn
(set (defvar ,(intern (format "%S/params" name))
nil
,(format "Params of %S." name))
',body)
(set (defvar ,(intern (format "%S/docstring" name))
nil
,(format "Docstring of %S." name))
,docstring)
(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 keymap
(set (defvar ,keymap-name
nil
,(format "Keymap for %S." name))
',keymap)
;; declare heads
(set
(defvar ,(intern (format "%S/hint" name)) nil
,(format "Dynamic hint for %S." name))
',(hydra--format name body docstring heads))
;; create defuns
,@(mapcar
(lambda (head)
(hydra--make-defun name body doc head keymap-name
body-pre
body-before-exit
body-after-exit))
heads-nodup)
;; free up keymap prefix
,@(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))))
;; bind keys
,@(delq nil
(mapcar
(lambda (head)
(let ((name (hydra--head-property head :cmd-name)))
(when (and (cadr head)
(or body-key body-map))
(let ((bind (hydra--head-property head :bind body-map))
(final-key
(if body-key
(vconcat (kbd body-key) (kbd (car head)))
(kbd (car head)))))
(cond ((null bind) nil)
((hydra--callablep bind)
`(funcall ,bind ,final-key (function ,name)))
((and (symbolp bind)
(if (boundp bind)
(keymapp (symbol-value bind))
t))
`(define-key ,bind ,final-key (quote ,name)))
(t
(error "Invalid :bind property `%S' for head %S" bind head)))))))
heads))
,(hydra--make-defun
name body doc '(nil body)
keymap-name
(or body-body-pre body-pre) body-before-exit
'(setq prefix-arg current-prefix-arg)))))
(error
(hydra--complain "Error in defhydra %S: %s" name (cdr err))
nil)))