branch: externals/hydra
commit 7081ee6d443dbf2b58e77fa7357c90e495173a2f
Merge: 4532f40ae4 f27fce1b2f
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Merge commit 'f27fce1b2f0a9162e159557bdeb2c0c94defb4d2' into externals/hydra
---
README.md | 13 +-
doc/Changelog.org | 69 +++++
hydra-examples.el | 11 +-
hydra-test.el | 783 ++++++++++++++++++++++++++++++++----------------------
hydra.el | 469 ++++++++++++++++++++------------
lv.el | 3 +
6 files changed, 866 insertions(+), 482 deletions(-)
diff --git a/README.md b/README.md
index d2237d8118..35aedcacfa 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,8 @@
+# Hydra
+
[](https://travis-ci.org/abo-abo/hydra)
+[](https://melpa.org/#/hydra)
+[](https://stable.melpa.org/#/hydra)
This is a package for GNU Emacs that can be used to tie related commands into
a family of short
bindings with a common prefix - a Hydra.
@@ -326,6 +330,9 @@ instead of `define-key` you can use this option.
The `:bind` key can be overridden by each head. This is useful if you want to
have a few heads that
are not bound outside the hydra.
+### `:base-map`
+Use this option if you want to override `hydra-base-map` for the current hydra.
+
## `awesome-docstring`
This can be a simple string used to build the final hydra hint. However, if
you start it with a
@@ -399,7 +406,7 @@ Here's an example of the last option:
### `head-hint`
In case of a large body docstring, you usually don't want the head hint to
show up, since
-you've already documented it the the body docstring.
+you've already documented it in the body docstring.
You can set the head hint to `nil` to do this.
Example:
@@ -420,3 +427,7 @@ Here's a list of body keys that can be overridden in each
head:
- `:exit`
- `:color`
- `:bind`
+- `:column`
+
+Use `:column` feature to have an aligned rectangular docstring without
defining it manually.
+See
[hydra-examples.el](https://github.com/abo-abo/hydra/blob/05871dd6c8af7b2268bd1a10eb9f8a3e423209cd/hydra-examples.el#L337)
for an example code.
diff --git a/doc/Changelog.org b/doc/Changelog.org
new file mode 100644
index 0000000000..429a7ddd8c
--- /dev/null
+++ b/doc/Changelog.org
@@ -0,0 +1,69 @@
+* 0.15.0
+** New Features
+
+*** defhydra
+
+**** New :base-map option in body plist
+In case your hydra conficts with el:hydra-base-map, you can now override it.
+
+Example:
+#+begin_src elisp
+(defhydra hydra-numbers (:base-map (make-sparse-keymap))
+ "test"
+ ("0" (message "zero"))
+ ("1" (message "one")))
+#+end_src
+See [[https://github.com/abo-abo/hydra/issues/285][#285]].
+
+**** Make no docstring equivalent to :hint nil
+Example:
+#+begin_src elisp
+(defhydra hydra-clock (:color blue)
+ ("q" nil "quit" :column "Clock")
+ ("c" org-clock-cancel "cancel" :color pink :column "Do")
+ ("d" org-clock-display "display")
+ ("e" org-clock-modify-effort-estimate "effort")
+ ("i" org-clock-in "in")
+ ("j" org-clock-goto "jump")
+ ("o" org-clock-out "out")
+ ("r" org-clock-report "report"))
+#+end_src
+See [[https://github.com/abo-abo/hydra/issues/291][#291]].
+
+**** Declare /params and /docstring
+See [[https://github.com/abo-abo/hydra/issues/185][#185]].
+
+**** Sexp hints are now supported for :columns
+Example
+#+begin_src elisp
+(defhydra hydra-test ()
+ "Test"
+ ("j" next-line (format-time-string "%H:%M:%S" (current-time)) :column "One")
+ ("k" previous-line (format-time-string "%H:%M:%S" (current-time)))
+ ("l" backward-char "back" :column "Two"))
+#+end_src
+See [[https://github.com/abo-abo/hydra/issues/311][#311]].
+
+
+*** defhydra+
+New macro. Allows to add heads to an existing hydra.
+
+Example:
+#+begin_src elisp
+(defhydra hydra-extendable ()
+ "extendable"
+ ("j" next-line "down"))
+
+(defhydra+ hydra-extendable ()
+ ("k" previous-line "up"))
+#+end_src
+See [[https://github.com/abo-abo/hydra/issues/185][#185]].
+
+*** el:hydra-hint-display-type
+Customize what to use to display the hint:
+- el:message
+- el:lv-message
+- posframe
+
+el:hydra-lv is now obsolete.
+See [[https://github.com/abo-abo/hydra/issues/317][#317]].
diff --git a/hydra-examples.el b/hydra-examples.el
index 70f75b0ea4..5262ec60cb 100644
--- a/hydra-examples.el
+++ b/hydra-examples.el
@@ -270,7 +270,7 @@ _v_ariable _u_ser-option
_h_ _l_ _o_k _y_ank
^_j_^ _n_ew-copy _r_eset
^^^^ _e_xchange _u_ndo
-^^^^ ^ ^ _p_aste
+^^^^ ^ ^ _x_kill
"
("h" rectangle-backward-char nil)
("l" rectangle-forward-char nil)
@@ -285,7 +285,7 @@ _h_ _l_ _o_k _y_ank
("y" yank-rectangle nil)
("u" undo nil)
("s" string-rectangle nil)
- ("p" kill-rectangle nil)
+ ("x" kill-rectangle nil)
("o" nil nil))
;; Recommended binding:
@@ -333,6 +333,13 @@ _y_: ?y? year _q_: quit _L__l__c_: log =
?l?"
;; Recommended binding:
;; (define-key org-agenda-mode-map "v" 'hydra-org-agenda-view/body)
+;;** Example 13: automatic columns
+(defhydra hydra-movement ()
+ ("j" next-line "down" :column "Vertical")
+ ("k" previous-line "up")
+ ("l" forward-char "forward" :column "Horizontal")
+ ("h" backward-char "back"))
+
;;* Helpers
(require 'windmove)
diff --git a/hydra-test.el b/hydra-test.el
index 4618d6b103..66f5c6e6ea 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -40,6 +40,35 @@
("k" previous-error "prev")
("SPC" hydra-repeat "rep" :bind nil)))
'(progn
+ (set
+ (defvar hydra-error/params nil
+ "Params of hydra-error.")
+ (quote (global-map "M-g")))
+ (set
+ (defvar hydra-error/docstring nil
+ "Docstring of hydra-error.")
+ "error")
+ (set
+ (defvar hydra-error/heads nil
+ "Heads for hydra-error.")
+ (quote
+ (("h"
+ first-error
+ "first"
+ :exit nil)
+ ("j"
+ next-error
+ "next"
+ :exit nil)
+ ("k"
+ previous-error
+ "prev"
+ :exit nil)
+ ("SPC"
+ hydra-repeat
+ "rep"
+ :bind nil
+ :exit nil))))
(set
(defvar hydra-error/keymap nil
"Keymap for hydra-error.")
@@ -72,27 +101,6 @@
(48 . hydra--digit-argument)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
- (set
- (defvar hydra-error/heads nil
- "Heads for hydra-error.")
- (quote
- (("h"
- first-error
- "first"
- :exit nil)
- ("j"
- next-error
- "next"
- :exit nil)
- ("k"
- previous-error
- "prev"
- :exit nil)
- ("SPC"
- hydra-repeat
- "rep"
- :bind nil
- :exit nil))))
(set
(defvar hydra-error/hint nil
"Dynamic hint for hydra-error.")
@@ -104,17 +112,18 @@
31 32 (face hydra-face-red)
42 45 (face hydra-face-red)))))
(defun hydra-error/first-error nil
- "Create a hydra with a \"M-g\" body and the heads:
+ "Call the head `first-error' in the \"hydra-error\" hydra.
+
+The heads for the associated hydra are:
\"h\": `first-error',
\"j\": `next-error',
\"k\": `previous-error',
\"SPC\": `hydra-repeat'
-The body can be accessed via `hydra-error/body'.
-
-Call the head: `first-error'."
+The body can be accessed via `hydra-error/body', which is bound to \"M-g\"."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore t))
(hydra-keyboard-quit)
@@ -128,8 +137,7 @@ Call the head: `first-error'."
(function first-error)))
((quit error)
(message
- (error-message-string err))
- (unless hydra-lv (sit-for 0.8))))
+ (error-message-string err))))
(hydra-show-hint
hydra-error/hint
(quote hydra-error))
@@ -140,17 +148,18 @@ Call the head: `first-error'."
nil)
nil))
(defun hydra-error/next-error nil
- "Create a hydra with a \"M-g\" body and the heads:
+ "Call the head `next-error' in the \"hydra-error\" hydra.
+
+The heads for the associated hydra are:
\"h\": `first-error',
\"j\": `next-error',
\"k\": `previous-error',
\"SPC\": `hydra-repeat'
-The body can be accessed via `hydra-error/body'.
-
-Call the head: `next-error'."
+The body can be accessed via `hydra-error/body', which is bound to \"M-g\"."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore t))
(hydra-keyboard-quit)
@@ -164,8 +173,7 @@ Call the head: `next-error'."
(function next-error)))
((quit error)
(message
- (error-message-string err))
- (unless hydra-lv (sit-for 0.8))))
+ (error-message-string err))))
(hydra-show-hint
hydra-error/hint
(quote hydra-error))
@@ -176,17 +184,18 @@ Call the head: `next-error'."
nil)
nil))
(defun hydra-error/previous-error nil
- "Create a hydra with a \"M-g\" body and the heads:
+ "Call the head `previous-error' in the \"hydra-error\" hydra.
+
+The heads for the associated hydra are:
\"h\": `first-error',
\"j\": `next-error',
\"k\": `previous-error',
\"SPC\": `hydra-repeat'
-The body can be accessed via `hydra-error/body'.
-
-Call the head: `previous-error'."
+The body can be accessed via `hydra-error/body', which is bound to \"M-g\"."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore t))
(hydra-keyboard-quit)
@@ -200,8 +209,7 @@ Call the head: `previous-error'."
(function previous-error)))
((quit error)
(message
- (error-message-string err))
- (unless hydra-lv (sit-for 0.8))))
+ (error-message-string err))))
(hydra-show-hint
hydra-error/hint
(quote hydra-error))
@@ -225,15 +233,18 @@ Call the head: `previous-error'."
(quote
hydra-error/previous-error))
(defun hydra-error/body nil
- "Create a hydra with a \"M-g\" body and the heads:
+ "Call the body in the \"hydra-error\" hydra.
+
+The heads for the associated hydra are:
\"h\": `first-error',
\"j\": `next-error',
\"k\": `previous-error',
\"SPC\": `hydra-repeat'
-The body can be accessed via `hydra-error/body'."
+The body can be accessed via `hydra-error/body', which is bound to \"M-g\"."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore nil))
(hydra-keyboard-quit)
@@ -262,6 +273,35 @@ The body can be accessed via `hydra-error/body'."
("a" abbrev-mode "abbrev")
("q" nil "cancel")))
'(progn
+ (set
+ (defvar hydra-toggle/params nil
+ "Params of hydra-toggle.")
+ (quote
+ (nil
+ nil
+ :exit t
+ :foreign-keys nil)))
+ (set
+ (defvar hydra-toggle/docstring nil
+ "Docstring of hydra-toggle.")
+ "toggle")
+ (set
+ (defvar hydra-toggle/heads nil
+ "Heads for hydra-toggle.")
+ (quote
+ (("t"
+ toggle-truncate-lines
+ "truncate"
+ :exit t)
+ ("f"
+ auto-fill-mode
+ "fill"
+ :exit t)
+ ("a"
+ abbrev-mode
+ "abbrev"
+ :exit t)
+ ("q" nil "cancel" :exit t))))
(set
(defvar hydra-toggle/keymap nil
"Keymap for hydra-toggle.")
@@ -294,23 +334,6 @@ The body can be accessed via `hydra-error/body'."
(48 . hydra--digit-argument)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
- (set
- (defvar hydra-toggle/heads nil
- "Heads for hydra-toggle.")
- (quote
- (("t"
- toggle-truncate-lines
- "truncate"
- :exit t)
- ("f"
- auto-fill-mode
- "fill"
- :exit t)
- ("a"
- abbrev-mode
- "abbrev"
- :exit t)
- ("q" nil "cancel" :exit t))))
(set
(defvar hydra-toggle/hint nil
"Dynamic hint for hydra-toggle.")
@@ -322,17 +345,18 @@ The body can be accessed via `hydra-error/body'."
35 36 (face hydra-face-blue)
48 49 (face hydra-face-blue)))))
(defun hydra-toggle/toggle-truncate-lines-and-exit nil
- "Create a hydra with no body and the heads:
+ "Call the head `toggle-truncate-lines' in the \"hydra-toggle\" hydra.
+
+The heads for the associated hydra are:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
\"a\": `abbrev-mode',
\"q\": nil
-The body can be accessed via `hydra-toggle/body'.
-
-Call the head: `toggle-truncate-lines'."
+The body can be accessed via `hydra-toggle/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
@@ -344,17 +368,18 @@ Call the head: `toggle-truncate-lines'."
(function
toggle-truncate-lines))))
(defun hydra-toggle/auto-fill-mode-and-exit nil
- "Create a hydra with no body and the heads:
+ "Call the head `auto-fill-mode' in the \"hydra-toggle\" hydra.
+
+The heads for the associated hydra are:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
\"a\": `abbrev-mode',
\"q\": nil
-The body can be accessed via `hydra-toggle/body'.
-
-Call the head: `auto-fill-mode'."
+The body can be accessed via `hydra-toggle/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
@@ -365,17 +390,18 @@ Call the head: `auto-fill-mode'."
(hydra--call-interactively-remap-maybe
(function auto-fill-mode))))
(defun hydra-toggle/abbrev-mode-and-exit nil
- "Create a hydra with no body and the heads:
+ "Call the head `abbrev-mode' in the \"hydra-toggle\" hydra.
+
+The heads for the associated hydra are:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
\"a\": `abbrev-mode',
\"q\": nil
-The body can be accessed via `hydra-toggle/body'.
-
-Call the head: `abbrev-mode'."
+The body can be accessed via `hydra-toggle/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
@@ -386,23 +412,26 @@ Call the head: `abbrev-mode'."
(hydra--call-interactively-remap-maybe
(function abbrev-mode))))
(defun hydra-toggle/nil nil
- "Create a hydra with no body and the heads:
+ "Call the head `nil' in the \"hydra-toggle\" hydra.
+
+The heads for the associated hydra are:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
\"a\": `abbrev-mode',
\"q\": nil
-The body can be accessed via `hydra-toggle/body'.
-
-Call the head: nil."
+The body can be accessed via `hydra-toggle/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(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:
+ "Call the body in the \"hydra-toggle\" hydra.
+
+The heads for the associated hydra are:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
@@ -411,6 +440,7 @@ Call the head: nil."
The body can be accessed via `hydra-toggle/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore nil))
(hydra-keyboard-quit)
@@ -443,6 +473,30 @@ The body can be accessed via `hydra-toggle/body'."
("k" previous-line)
("q" nil "quit")))
'(progn
+ (set
+ (defvar hydra-vi/params nil
+ "Params of hydra-vi.")
+ (quote
+ (nil
+ nil
+ :exit nil
+ :foreign-keys warn
+ :post (set-cursor-color "#ffffff")
+ :pre (set-cursor-color "#e52b50"))))
+ (set
+ (defvar hydra-vi/docstring nil
+ "Docstring of hydra-vi.")
+ "vi")
+ (set
+ (defvar hydra-vi/heads nil
+ "Heads for hydra-vi.")
+ (quote
+ (("j" next-line "" :exit nil)
+ ("k"
+ previous-line
+ ""
+ :exit nil)
+ ("q" nil "quit" :exit t))))
(set
(defvar hydra-vi/keymap nil
"Keymap for hydra-vi.")
@@ -474,16 +528,6 @@ The body can be accessed via `hydra-toggle/body'."
(48 . hydra--digit-argument)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
- (set
- (defvar hydra-vi/heads nil
- "Heads for hydra-vi.")
- (quote
- (("j" next-line "" :exit nil)
- ("k"
- previous-line
- ""
- :exit nil)
- ("q" nil "quit" :exit t))))
(set
(defvar hydra-vi/hint nil
"Dynamic hint for hydra-vi.")
@@ -494,16 +538,17 @@ The body can be accessed via `hydra-toggle/body'."
7 8 (face hydra-face-amaranth)
11 12 (face hydra-face-teal)))))
(defun hydra-vi/next-line nil
- "Create a hydra with no body and the heads:
+ "Call the head `next-line' in the \"hydra-vi\" hydra.
+
+The heads for the associated hydra are:
\"j\": `next-line',
\"k\": `previous-line',
\"q\": nil
-The body can be accessed via `hydra-vi/body'.
-
-Call the head: `next-line'."
+The body can be accessed via `hydra-vi/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(set-cursor-color "#e52b50")
(let ((hydra--ignore t))
@@ -518,8 +563,7 @@ Call the head: `next-line'."
(function next-line)))
((quit error)
(message
- (error-message-string err))
- (unless hydra-lv (sit-for 0.8))))
+ (error-message-string err))))
(hydra-show-hint
hydra-vi/hint
(quote hydra-vi))
@@ -530,16 +574,17 @@ Call the head: `next-line'."
(set-cursor-color "#ffffff"))
(quote warn)))
(defun hydra-vi/previous-line nil
- "Create a hydra with no body and the heads:
+ "Call the head `previous-line' in the \"hydra-vi\" hydra.
+
+The heads for the associated hydra are:
\"j\": `next-line',
\"k\": `previous-line',
\"q\": nil
-The body can be accessed via `hydra-vi/body'.
-
-Call the head: `previous-line'."
+The body can be accessed via `hydra-vi/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(set-cursor-color "#e52b50")
(let ((hydra--ignore t))
@@ -554,8 +599,7 @@ Call the head: `previous-line'."
(function previous-line)))
((quit error)
(message
- (error-message-string err))
- (unless hydra-lv (sit-for 0.8))))
+ (error-message-string err))))
(hydra-show-hint
hydra-vi/hint
(quote hydra-vi))
@@ -566,23 +610,26 @@ Call the head: `previous-line'."
(set-cursor-color "#ffffff"))
(quote warn)))
(defun hydra-vi/nil nil
- "Create a hydra with no body and the heads:
+ "Call the head `nil' in the \"hydra-vi\" hydra.
+
+The heads for the associated hydra are:
\"j\": `next-line',
\"k\": `previous-line',
\"q\": nil
-The body can be accessed via `hydra-vi/body'.
-
-Call the head: nil."
+The body can be accessed via `hydra-vi/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(set-cursor-color "#e52b50")
(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:
+ "Call the body in the \"hydra-vi\" hydra.
+
+The heads for the associated hydra are:
\"j\": `next-line',
\"k\": `previous-line',
@@ -590,6 +637,7 @@ Call the head: nil."
The body can be accessed via `hydra-vi/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(set-cursor-color "#e52b50")
(let ((hydra--ignore nil))
@@ -618,6 +666,32 @@ The body can be accessed via `hydra-vi/body'."
("0" (text-scale-set 0) :bind nil :exit t)
("1" (text-scale-set 0) nil :bind nil :exit t)))
'(progn
+ (set
+ (defvar hydra-zoom/params nil
+ "Params of hydra-zoom.")
+ (quote (nil nil)))
+ (set
+ (defvar hydra-zoom/docstring nil
+ "Docstring of hydra-zoom.")
+ "zoom")
+ (set
+ (defvar hydra-zoom/heads nil
+ "Heads for hydra-zoom.")
+ (quote
+ (("r"
+ (text-scale-set 0)
+ "reset"
+ :exit nil)
+ ("0"
+ (text-scale-set 0)
+ ""
+ :bind nil
+ :exit t)
+ ("1"
+ (text-scale-set 0)
+ nil
+ :bind nil
+ :exit t))))
(set
(defvar hydra-zoom/keymap nil
"Keymap for hydra-zoom.")
@@ -647,24 +721,6 @@ The body can be accessed via `hydra-vi/body'."
(48 . hydra-zoom/lambda-0-and-exit)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
- (set
- (defvar hydra-zoom/heads nil
- "Heads for hydra-zoom.")
- (quote
- (("r"
- (text-scale-set 0)
- "reset"
- :exit nil)
- ("0"
- (text-scale-set 0)
- ""
- :bind nil
- :exit t)
- ("1"
- (text-scale-set 0)
- nil
- :bind nil
- :exit t))))
(set
(defvar hydra-zoom/hint nil
"Dynamic hint for hydra-zoom.")
@@ -674,16 +730,17 @@ The body can be accessed via `hydra-vi/body'."
7 8 (face hydra-face-red)
9 10 (face hydra-face-blue)))))
(defun hydra-zoom/lambda-r nil
- "Create a hydra with no body and the heads:
+ "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra.
+
+The heads for the associated hydra are:
\"r\": `(text-scale-set 0)',
\"0\": `(text-scale-set 0)',
\"1\": `(text-scale-set 0)'
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
+The body can be accessed via `hydra-zoom/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore t))
(hydra-keyboard-quit)
@@ -697,8 +754,7 @@ Call the head: `(text-scale-set 0)'."
(text-scale-set 0))))
((quit error)
(message
- (error-message-string err))
- (unless hydra-lv (sit-for 0.8))))
+ (error-message-string err))))
(hydra-show-hint
hydra-zoom/hint
(quote hydra-zoom))
@@ -709,16 +765,17 @@ Call the head: `(text-scale-set 0)'."
nil)
nil))
(defun hydra-zoom/lambda-0-and-exit nil
- "Create a hydra with no body and the heads:
+ "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra.
+
+The heads for the associated hydra are:
\"r\": `(text-scale-set 0)',
\"0\": `(text-scale-set 0)',
\"1\": `(text-scale-set 0)'
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
+The body can be accessed via `hydra-zoom/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
@@ -729,7 +786,9 @@ Call the head: `(text-scale-set 0)'."
(interactive)
(text-scale-set 0)))))
(defun hydra-zoom/body nil
- "Create a hydra with no body and the heads:
+ "Call the body in the \"hydra-zoom\" hydra.
+
+The heads for the associated hydra are:
\"r\": `(text-scale-set 0)',
\"0\": `(text-scale-set 0)',
@@ -737,6 +796,7 @@ Call the head: `(text-scale-set 0)'."
The body can be accessed via `hydra-zoom/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore nil))
(hydra-keyboard-quit)
@@ -764,6 +824,32 @@ The body can be accessed via `hydra-zoom/body'."
("0" (text-scale-set 0) :bind nil :exit t)
("1" (text-scale-set 0) nil :bind nil)))
'(progn
+ (set
+ (defvar hydra-zoom/params nil
+ "Params of hydra-zoom.")
+ (quote (nil nil)))
+ (set
+ (defvar hydra-zoom/docstring nil
+ "Docstring of hydra-zoom.")
+ "zoom")
+ (set
+ (defvar hydra-zoom/heads nil
+ "Heads for hydra-zoom.")
+ (quote
+ (("r"
+ (text-scale-set 0)
+ "reset"
+ :exit nil)
+ ("0"
+ (text-scale-set 0)
+ ""
+ :bind nil
+ :exit t)
+ ("1"
+ (text-scale-set 0)
+ nil
+ :bind nil
+ :exit nil))))
(set
(defvar hydra-zoom/keymap nil
"Keymap for hydra-zoom.")
@@ -793,24 +879,6 @@ The body can be accessed via `hydra-zoom/body'."
(48 . hydra-zoom/lambda-0-and-exit)
(45 . hydra--negative-argument)
(21 . hydra--universal-argument))))
- (set
- (defvar hydra-zoom/heads nil
- "Heads for hydra-zoom.")
- (quote
- (("r"
- (text-scale-set 0)
- "reset"
- :exit nil)
- ("0"
- (text-scale-set 0)
- ""
- :bind nil
- :exit t)
- ("1"
- (text-scale-set 0)
- nil
- :bind nil
- :exit nil))))
(set
(defvar hydra-zoom/hint nil
"Dynamic hint for hydra-zoom.")
@@ -820,16 +888,17 @@ The body can be accessed via `hydra-zoom/body'."
7 8 (face hydra-face-red)
9 10 (face hydra-face-blue)))))
(defun hydra-zoom/lambda-r nil
- "Create a hydra with no body and the heads:
+ "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra.
+
+The heads for the associated hydra are:
\"r\": `(text-scale-set 0)',
\"0\": `(text-scale-set 0)',
\"1\": `(text-scale-set 0)'
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
+The body can be accessed via `hydra-zoom/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore t))
(hydra-keyboard-quit)
@@ -843,8 +912,7 @@ Call the head: `(text-scale-set 0)'."
(text-scale-set 0))))
((quit error)
(message
- (error-message-string err))
- (unless hydra-lv (sit-for 0.8))))
+ (error-message-string err))))
(hydra-show-hint
hydra-zoom/hint
(quote hydra-zoom))
@@ -855,16 +923,17 @@ Call the head: `(text-scale-set 0)'."
nil)
nil))
(defun hydra-zoom/lambda-0-and-exit nil
- "Create a hydra with no body and the heads:
+ "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra.
+
+The heads for the associated hydra are:
\"r\": `(text-scale-set 0)',
\"0\": `(text-scale-set 0)',
\"1\": `(text-scale-set 0)'
-The body can be accessed via `hydra-zoom/body'.
-
-Call the head: `(text-scale-set 0)'."
+The body can be accessed via `hydra-zoom/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
@@ -875,7 +944,9 @@ Call the head: `(text-scale-set 0)'."
(interactive)
(text-scale-set 0)))))
(defun hydra-zoom/body nil
- "Create a hydra with no body and the heads:
+ "Call the body in the \"hydra-zoom\" hydra.
+
+The heads for the associated hydra are:
\"r\": `(text-scale-set 0)',
\"0\": `(text-scale-set 0)',
@@ -883,6 +954,7 @@ Call the head: `(text-scale-set 0)'."
The body can be accessed via `hydra-zoom/body'."
(interactive)
+ (require (quote hydra))
(hydra-default-pre)
(let ((hydra--ignore nil))
(hydra-keyboard-quit)
@@ -1018,10 +1090,14 @@ _f_ auto-fill-mode: %`auto-fill-function
("t" toggle-truncate-lines nil)
("w" whitespace-mode nil)
("q" nil "quit"))))
- '(concat (format "%s abbrev-mode: %S
+ '(format
+ "%s abbrev-mode: %S
%s debug-on-error: %S
%s auto-fill-mode: %S
-" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[{q}]:
quit."))))
+[{q}]: quit."
+ "{a}" abbrev-mode
+ "{d}" debug-on-error
+ "{f}" auto-fill-function))))
(ert-deftest hydra-format-2 ()
(should (equal
@@ -1033,7 +1109,7 @@ _f_ auto-fill-mode: %`auto-fill-function
"\n bar %s`foo\n"
'(("a" (quote t) "" :cmd-name bar/lambda-a :exit nil)
("q" nil "" :cmd-name bar/nil :exit t))))
- '(concat (format " bar %s\n" foo) "{a}, [q]."))))
+ '(format " bar %s\n{a}, [q]." foo))))
(ert-deftest hydra-format-3 ()
(should (equal
@@ -1044,7 +1120,7 @@ _f_ auto-fill-mode: %`auto-fill-function
nil
"\n_<SPC>_ ^^ace jump\n"
'(("<SPC>" ace-jump-char-mode nil :cmd-name
bar/ace-jump-char-mode))))
- '(concat (format "%s ace jump\n" "{<SPC>}") ""))))
+ '(format "%s ace jump\n" "{<SPC>}"))))
(ert-deftest hydra-format-4 ()
(should
@@ -1053,39 +1129,35 @@ _f_ auto-fill-mode: %`auto-fill-function
'(nil nil :hint nil)
"\n_j_,_k_"
'(("j" nil nil :exit t) ("k" nil nil :exit t)))
- '(concat (format "%s,%s"
- #("j" 0 1 (face hydra-face-blue))
- #("k" 0 1 (face hydra-face-blue))) ""))))
+ '(format "%s,%s"
+ #("j" 0 1 (face hydra-face-blue))
+ #("k" 0 1 (face hydra-face-blue))))))
(ert-deftest hydra-format-5 ()
(should
(equal (hydra--format
nil nil "\n_-_: mark _u_: unmark\n"
- '(("-" Buffer-menu-mark)
- ("u" Buffer-menu-unmark)))
- '(concat
- (format
+ '(("-" Buffer-menu-mark nil)
+ ("u" Buffer-menu-unmark nil)))
+ '(format
"%s: mark %s: unmark\n"
#("-" 0 1 (face hydra-face-red))
- #("u" 0 1 (face hydra-face-red)))
- ""))))
+ #("u" 0 1 (face hydra-face-red))))))
(ert-deftest hydra-format-6 ()
(should
(equal (hydra--format
nil nil "\n[_]_] forward [_[_] backward\n"
- '(("]" forward-char)
- ("[" backward-char)))
- '(concat
- (format
- "[%s] forward [%s] backward\n"
- #("]"
- 0 1 (face
- hydra-face-red))
- #("["
- 0 1 (face
- hydra-face-red)))
- ""))))
+ '(("]" forward-char nil)
+ ("[" backward-char nil)))
+ '(format
+ "[%s] forward [%s] backward\n"
+ #("]"
+ 0 1 (face
+ hydra-face-red))
+ #("["
+ 0 1 (face
+ hydra-face-red))))))
(ert-deftest hydra-format-7 ()
(should
@@ -1104,12 +1176,10 @@ _f_ auto-fill-mode: %`auto-fill-function
(equal
(hydra--format nil nil "\n_%_ forward\n"
'(("%" forward-char nil :exit nil)))
- '(concat
- (format
- "%s forward\n"
- #("%%"
- 0 2 (face hydra-face-red)))
- ""))))
+ '(format
+ "%s forward\n"
+ #("%%"
+ 0 2 (face hydra-face-red))))))
(ert-deftest hydra-format-8 ()
(should
@@ -1126,11 +1196,28 @@ _f_ auto-fill-mode: %`auto-fill-function
(equal
(hydra--format nil '(nil nil :hint nil) "\n_f_(foo)"
'(("f" forward-char nil :exit nil)))
+ '(format
+ "%s(foo)"
+ #("f" 0 1 (face hydra-face-red))))))
+
+(ert-deftest hydra-format-10 ()
+ (should
+ (equal
+ (hydra--format nil '(nil nil) "Test:"
+ '(("j" next-line (format-time-string "%H:%M:%S"
(current-time))
+ :exit nil)))
'(concat
- (format
- "%s(foo)"
- #("f" 0 1 (face hydra-face-red)))
- ""))))
+ (format "Test:\n")
+ (mapconcat
+ (function
+ hydra--eval-and-format)
+ (quote
+ ((#("j" 0 1 (face hydra-face-red))
+ format-time-string
+ "%H:%M:%S"
+ (current-time))))
+ ", ")
+ "."))))
(ert-deftest hydra-format-with-sexp-1 ()
(should (equal
@@ -1140,12 +1227,12 @@ _f_ auto-fill-mode: %`auto-fill-function
'hydra-toggle nil
"\n_n_ narrow-or-widen-dwim %(progn (message
\"checking\")(buffer-narrowed-p))asdf\n"
'(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
- '(concat (format "%s narrow-or-widen-dwim %Sasdf\n"
- "{n}"
- (progn
- (message "checking")
- (buffer-narrowed-p)))
- "[[q]]: cancel."))))
+ '(format
+ "%s narrow-or-widen-dwim %Sasdf\n[[q]]: cancel."
+ "{n}"
+ (progn
+ (message "checking")
+ (buffer-narrowed-p))))))
(ert-deftest hydra-format-with-sexp-2 ()
(should (equal
@@ -1155,72 +1242,72 @@ _f_ auto-fill-mode: %`auto-fill-function
'hydra-toggle nil
"\n_n_ narrow-or-widen-dwim %s(progn (message
\"checking\")(buffer-narrowed-p))asdf\n"
'(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
- '(concat (format "%s narrow-or-widen-dwim %sasdf\n"
- "{n}"
- (progn
- (message "checking")
- (buffer-narrowed-p)))
- "[[q]]: cancel."))))
+ '(format
+ "%s narrow-or-widen-dwim %sasdf\n[[q]]: cancel."
+ "{n}"
+ (progn
+ (message "checking")
+ (buffer-narrowed-p))))))
(ert-deftest hydra-compat-colors-2 ()
(should
(equal
- (macroexpand
- '(defhydra hydra-test (:color amaranth)
- ("a" fun-a)
- ("b" fun-b :color blue)
- ("c" fun-c :color blue)
- ("d" fun-d :color blue)
- ("e" fun-e :color blue)
- ("f" fun-f :color blue)))
- (macroexpand
- '(defhydra hydra-test (:color teal)
- ("a" fun-a :color red)
- ("b" fun-b)
- ("c" fun-c)
- ("d" fun-d)
- ("e" fun-e)
- ("f" fun-f))))))
+ (cddr (macroexpand
+ '(defhydra hydra-test (:color amaranth)
+ ("a" fun-a)
+ ("b" fun-b :color blue)
+ ("c" fun-c :color blue)
+ ("d" fun-d :color blue)
+ ("e" fun-e :color blue)
+ ("f" fun-f :color blue))))
+ (cddr (macroexpand
+ '(defhydra hydra-test (:color teal)
+ ("a" fun-a :color red)
+ ("b" fun-b)
+ ("c" fun-c)
+ ("d" fun-d)
+ ("e" fun-e)
+ ("f" fun-f)))))))
(ert-deftest hydra-compat-colors-3 ()
(should
(equal
- (macroexpand
- '(defhydra hydra-test ()
- ("a" fun-a)
- ("b" fun-b :color blue)
- ("c" fun-c :color blue)
- ("d" fun-d :color blue)
- ("e" fun-e :color blue)
- ("f" fun-f :color blue)))
- (macroexpand
- '(defhydra hydra-test (:color blue)
- ("a" fun-a :color red)
- ("b" fun-b)
- ("c" fun-c)
- ("d" fun-d)
- ("e" fun-e)
- ("f" fun-f))))))
+ (cddr (macroexpand
+ '(defhydra hydra-test ()
+ ("a" fun-a)
+ ("b" fun-b :color blue)
+ ("c" fun-c :color blue)
+ ("d" fun-d :color blue)
+ ("e" fun-e :color blue)
+ ("f" fun-f :color blue))))
+ (cddr (macroexpand
+ '(defhydra hydra-test (:color blue)
+ ("a" fun-a :color red)
+ ("b" fun-b)
+ ("c" fun-c)
+ ("d" fun-d)
+ ("e" fun-e)
+ ("f" fun-f)))))))
(ert-deftest hydra-compat-colors-4 ()
(should
(equal
- (macroexpand
- '(defhydra hydra-test ()
- ("a" fun-a)
- ("b" fun-b :exit t)
- ("c" fun-c :exit t)
- ("d" fun-d :exit t)
- ("e" fun-e :exit t)
- ("f" fun-f :exit t)))
- (macroexpand
- '(defhydra hydra-test (:exit t)
- ("a" fun-a :exit nil)
- ("b" fun-b)
- ("c" fun-c)
- ("d" fun-d)
- ("e" fun-e)
- ("f" fun-f))))))
+ (cddr (macroexpand
+ '(defhydra hydra-test ()
+ ("a" fun-a)
+ ("b" fun-b :exit t)
+ ("c" fun-c :exit t)
+ ("d" fun-d :exit t)
+ ("e" fun-e :exit t)
+ ("f" fun-f :exit t))))
+ (cddr (macroexpand
+ '(defhydra hydra-test (:exit t)
+ ("a" fun-a :exit nil)
+ ("b" fun-b)
+ ("c" fun-c)
+ ("d" fun-d)
+ ("e" fun-e)
+ ("f" fun-f)))))))
(ert-deftest hydra--pad ()
(should (equal (hydra--pad '(a b c) 3)
@@ -1378,7 +1465,7 @@ _w_ Worf: % -8`hydra-tng/worf^^
_h_ Set phasers to
(should (equal (eval
(cadr
(nth 2
- (nth 3
+ (nth 5
(macroexpand
'(defhydra hydra-info (:color blue
:columns 3)
@@ -1437,6 +1524,29 @@ t: info-to"
314 315 (face hydra-face-blue)
322 323 (face hydra-face-blue)))))
+(ert-deftest hydra-columns-2 ()
+ (should (equal (eval
+ (cadr
+ (nth 2
+ (nth 5
+ (macroexpand
+ '(defhydra hydra-foo (:color blue)
+ "Silly hydra"
+ ("x" forward-char "forward" :column "sideways")
+ ("y" backward-char "back")
+ ("a" next-line "down" :column "vertical")
+ ("b" previous-line "up")))))))
+ #("Silly hydra:
+sideways | vertical
+----------- | -----------
+x: forward | a: down
+y: back | b: up
+"
+ 62 63 (face hydra-face-blue)
+ 76 77 (face hydra-face-blue)
+ 84 85 (face hydra-face-blue)
+ 98 99 (face hydra-face-blue)))))
+
;; checked:
;; basic rendering
;; column compatibility with ruby style and no colum specified
@@ -1446,42 +1556,41 @@ t: info-to"
(should (equal (eval
(cadr
(nth 2
- (nth 3
+ (nth 5
(macroexpand
'(defhydra hydra-rectangle (:body-pre
(rectangle-mark-mode 1)
- :color pink
- :post
(deactivate-mark))
- "
+ :color pink
+ :post
(deactivate-mark))
+ "
^_k_^ ()()
_h_ _l_ (O)(o)
^_j_^ ( O )
^^^^ (’’)(’’)
^^^^
"
- ("h" backward-char nil)
- ("l" forward-char nil)
- ("k" previous-line nil)
- ("j" next-line nil)
- ("Of" 5x5 "outside of table 1")
- ("e" exchange-point-and-mark "exchange"
:column "firstcol")
- ("n" copy-rectangle-as-kill "new-copy")
- ("d" delete-rectangle "delete")
- ("r" (if (region-active-p)
- (deactivate-mark)
- (rectangle-mark-mode 1)) "reset"
:column "secondcol")
- ("y" yank-rectangle "yank")
- ("u" undo "undo")
- ("s" string-rectangle "string")
- ("p" kill-rectangle "paste")
- ("o" nil "ok" :column "firstcol")
- ("Os" 5x5-bol "outside of table 2" :column
nil)
- ("Ot" 5x5-eol "outside of table 3")))))))
+ ("h" backward-char nil)
+ ("l" forward-char nil)
+ ("k" previous-line nil)
+ ("j" next-line nil)
+ ("Of" 5x5 "outside of table 1")
+ ("e" exchange-point-and-mark "exchange"
:column "firstcol")
+ ("n" copy-rectangle-as-kill "new-copy")
+ ("d" delete-rectangle "delete")
+ ("r" (if (region-active-p)
+ (deactivate-mark)
+ (rectangle-mark-mode 1)) "reset"
:column "secondcol")
+ ("y" yank-rectangle "yank")
+ ("u" undo "undo")
+ ("s" string-rectangle "string")
+ ("p" kill-rectangle "paste")
+ ("o" nil "ok" :column "firstcol")
+ ("Os" 5x5-bol "outside of table 2" :column nil)
+ ("Ot" 5x5-eol "outside of table 3")))))))
#(" k ()()
h l (O)(o)
j ( O )
(’’)(’’)
-
firstcol | secondcol
----------- | ------------
e: exchange | r: reset
@@ -1494,49 +1603,48 @@ o: ok | s: string
17 18 (face hydra-face-pink)
21 22 (face hydra-face-pink)
38 39 (face hydra-face-pink)
- 129 130 (face hydra-face-pink)
- 143 144 (face hydra-face-pink)
- 152 153 (face hydra-face-pink)
- 166 167 (face hydra-face-pink)
- 174 175 (face hydra-face-pink)
- 188 189 (face hydra-face-pink)
- 196 197 (face hydra-face-blue)
- 210 211 (face hydra-face-pink)
- 234 235 (face hydra-face-pink)
- 244 246 (face hydra-face-pink)
- 270 272 (face hydra-face-pink)
- 296 298 (face hydra-face-pink)))))
+ 128 129 (face hydra-face-pink)
+ 142 143 (face hydra-face-pink)
+ 151 152 (face hydra-face-pink)
+ 165 166 (face hydra-face-pink)
+ 173 174 (face hydra-face-pink)
+ 187 188 (face hydra-face-pink)
+ 195 196 (face hydra-face-blue)
+ 209 210 (face hydra-face-pink)
+ 233 234 (face hydra-face-pink)
+ 243 245 (face hydra-face-pink)
+ 269 271 (face hydra-face-pink)
+ 295 297 (face hydra-face-pink)))))
;; check column order is the same as they appear in defhydra
(ert-deftest hydra-column-order ()
(should (equal (eval
(cadr
(nth 2
- (nth 3
+ (nth 5
(macroexpand
'(defhydra hydra-window-order
- (:color red :hint nil :timeout 4)
- ("z" ace-window "ace" :color blue :column
"Switch")
- ("h" windmove-left "← window")
- ("j" windmove-down "↓ window")
- ("l" windmove-right "→ window")
- ("s" split-window-below "split window" :color
blue :column "Split Management")
- ("v" split-window-right "split window
vertically" :color blue)
- ("d" delete-window "delete current window")
- ("f" follow-mode "toogle follow mode")
- ("u" winner-undo "undo window conf" :column
"Undo/Redo")
- ("r" winner-redo "redo window conf")
- ("b" balance-windows "balance window height"
:column "1-Sizing")
- ("m" maximize-window "maximize current
window")
- ("k" windmove-up "↑ window" :column "Switch")
- ("M" minimize-window "maximize current
window" :column "1-Sizing")
- ("q" nil "quit menu" :color blue :column
nil)))))))
- #("hydra:
-Switch | Split Management | Undo/Redo | 1-Sizing
+ (:color red :timeout 4)
+ ("z" ace-window "ace" :color blue :column
"Switch")
+ ("h" windmove-left "← window")
+ ("j" windmove-down "↓ window")
+ ("l" windmove-right "→ window")
+ ("s" split-window-below "split window" :color
blue :column "Split Management")
+ ("v" split-window-right "split window
vertically" :color blue)
+ ("d" delete-window "delete current window")
+ ("f" follow-mode "toogle follow mode")
+ ("u" winner-undo "undo window conf" :column
"Undo/Redo")
+ ("r" winner-redo "redo window conf")
+ ("b" balance-windows "balance window height"
:column "1-Sizing")
+ ("m" maximize-window "maximize current window")
+ ("k" windmove-up "↑ window" :column "Switch")
+ ("M" minimize-window "minimize current window"
:column "1-Sizing")
+ ("q" nil "quit menu" :color blue :column
nil)))))))
+ #("Switch | Split Management | Undo/Redo
| 1-Sizing
----------- | -------------------------- | ------------------- |
--------------------------
z: ace | s: split window | u: undo window conf | b: balance
window height
h: ← window | v: split window vertically | r: redo window conf | m: maximize
current window
-j: ↓ window | d: delete current window | | M: maximize
current window
+j: ↓ window | d: delete current window | | M: minimize
current window
l: → window | f: toogle follow mode | |
k: ↑ window | | |
[q]: quit menu."
@@ -1556,6 +1664,59 @@ k: ↑ window | |
|
512 513 (face hydra-face-red)
578 579 (face hydra-face-blue)))))
+(ert-deftest hydra-column-sexp ()
+ (should (equal
+ (eval (nth 5
+ (macroexpand
+ '(defhydra hydra-toggle-stuff ()
+ "Toggle"
+ ("d" toggle-debug-on-error "debug-on-error" :column
"Misc")
+ ("a" abbrev-mode
+ (format "abbrev: %s"
+ (if (bound-and-true-p abbrev-mode)
+ "[x]"
+ "[ ]")))))))
+ '(concat
+ (format "Toggle:\n")
+ "Misc"
+ "\n"
+ "-----------------"
+ "\n"
+ #("d: debug-on-error"
+ 0 1 (face hydra-face-red))
+ "\n"
+ (format
+ "%1s: %-15s"
+ #("a" 0 1 (face hydra-face-red))
+ (format
+ "abbrev: %s"
+ (if (bound-and-true-p abbrev-mode)
+ "[x]"
+ "[ ]")))
+ "\n"))))
+
+(defhydra hydra-extendable ()
+ "extendable"
+ ("j" next-line "down"))
+
+(ert-deftest hydra-extend ()
+ (should (equal (macroexpand
+ '(defhydra+ hydra-extendable ()
+ ("k" previous-line "up")))
+ (macroexpand
+ '(defhydra hydra-extendable ()
+ "extendable"
+ ("j" next-line "down")
+ ("k" previous-line "up")))))
+ (should (equal (macroexpand
+ '(defhydra+ hydra-extendable ()
+ ("k" previous-line "up" :exit t)))
+ (macroexpand
+ '(defhydra hydra-extendable ()
+ "extendable"
+ ("j" next-line "down")
+ ("k" previous-line "up" :exit t))))))
+
(provide 'hydra-test)
;;; hydra-test.el ends here
diff --git a/hydra.el b/hydra.el
index c837e0fd6e..f28fdae7ce 100644
--- a/hydra.el
+++ b/hydra.el
@@ -1,13 +1,13 @@
;;; hydra.el --- Make bindings that stick around. -*- lexical-binding: t -*-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2019 Free Software Foundation, Inc.
;; Author: Oleh Krehel <ohwoeo...@gmail.com>
;; Maintainer: Oleh Krehel <ohwoeo...@gmail.com>
;; URL: https://github.com/abo-abo/hydra
-;; Version: 0.14.0
+;; Version: 0.15.0
;; Keywords: bindings
-;; Package-Requires: ((cl-lib "0.5"))
+;; Package-Requires: ((cl-lib "0.5") (lv "0"))
;; This file is part of GNU Emacs.
@@ -207,6 +207,38 @@ the body or the head."
:type 'sexp
:group 'hydra)
+(declare-function posframe-show "posframe")
+(declare-function posframe-hide "posframe")
+(declare-function posframe-poshandler-window-center "posframe")
+
+(defun hydra-posframe-show (str)
+ (require 'posframe)
+ (posframe-show
+ " *hydra-posframe*"
+ :string str
+ :poshandler #'posframe-poshandler-window-center))
+
+(defun hydra-posframe-hide ()
+ (posframe-hide " *hydra-posframe*"))
+
+(defvar hydra-hint-display-alist
+ (list (list 'lv #'lv-message #'lv-delete-window)
+ (list 'message #'message (lambda () (message "")))
+ (list 'posframe #'hydra-posframe-show #'hydra-posframe-hide))
+ "Store the functions for `hydra-hint-display-type'.")
+
+(defcustom hydra-hint-display-type 'lv
+ "The utility to show hydra hint"
+ :type '(choice
+ (const message)
+ (const lv)
+ (const posframe))
+ :group 'hydra)
+
+(define-obsolete-variable-alias
+ 'hydra-lv 'hydra-hint-display-type "0.14.0"
+ "Use either `hydra-hint-display-type' or `hydra-set-property' :verbosity.")
+
(defcustom hydra-lv t
"When non-nil, `lv-message' (not `message') will be used to display hints."
:type 'boolean)
@@ -441,6 +473,21 @@ Return DEFAULT if PROP is not in H."
((blue teal) t)
(t nil)))))
+(defun hydra--normalize-body (body)
+ "Put BODY in a normalized format.
+Add :exit and :foreign-keys if they are not there.
+Remove :color key. And sort the plist alphabetically."
+ (let ((plist (cddr body)))
+ (plist-put plist :exit (hydra--body-exit body))
+ (plist-put plist :foreign-keys (hydra--body-foreign-keys body))
+ (let* ((alist0 (cl-loop for (k v) on plist
+ by #'cddr collect (cons k v)))
+ (alist1 (assq-delete-all :color alist0))
+ (alist2 (cl-sort alist1 #'string<
+ :key (lambda (x) (symbol-name (car x))))))
+ (append (list (car body) (cadr body))
+ (cl-mapcan (lambda (x) (list (car x) (cdr x))) alist2)))))
+
(defalias 'hydra--imf #'list)
(defun hydra-default-pre ()
@@ -471,9 +518,8 @@ Return DEFAULT if PROP is not in H."
(setq hydra-curr-map nil)
(unless (and hydra--ignore
(null hydra--work-around-dedicated))
- (if hydra-lv
- (lv-delete-window)
- (message "")))
+ (funcall
+ (nth 2 (assoc hydra-hint-display-type hydra-hint-display-alist))))
nil)
(defvar hydra-head-format "[%s]: "
@@ -483,16 +529,25 @@ Return DEFAULT if PROP is not in H."
"The function for formatting key-doc pairs.")
(defun hydra-key-doc-function-default (key key-width doc doc-width)
- "Doc"
(cond
- ((equal key " ") (format (format "%%-%ds" (+ 3 key-width doc-width)) doc))
- (t (format (format "%%%ds: %%%ds" key-width (- -1 doc-width)) key doc))))
+ ((equal key " ") (format (format "%%-%ds" (+ 3 key-width doc-width)) doc))
+ ((listp doc)
+ `(format ,(format "%%%ds: %%%ds" key-width (- -1 doc-width)) ,key ,doc))
+ (t (format (format "%%%ds: %%%ds" key-width (- -1 doc-width)) key doc))))
(defun hydra--to-string (x)
(if (stringp x)
x
(eval x)))
+(defun hydra--eval-and-format (x)
+ (let ((str (hydra--to-string (cdr x))))
+ (format
+ (if (> (length str) 0)
+ (concat hydra-head-format str)
+ "%s")
+ (car x))))
+
(defun hydra--hint-heads-wocol (body heads)
"Generate a hint for the echo area.
BODY, and HEADS are parameters to `defhydra'.
@@ -501,14 +556,13 @@ Works for heads without a property :column."
(dolist (h heads)
(let ((val (assoc (cadr h) alist))
(pstr (hydra-fontify-head h body)))
- (unless (null (cl-caddr h))
- (if val
- (setf (cadr val)
- (concat (cadr val) " " pstr))
- (push
- (cons (cadr h)
- (cons pstr (cl-caddr h)))
- alist)))))
+ (if val
+ (setf (cadr val)
+ (concat (cadr val) " " pstr))
+ (push
+ (cons (cadr h)
+ (cons pstr (cl-caddr h)))
+ alist))))
(let ((keys (nreverse (mapcar #'cdr alist)))
(n-cols (plist-get (cddr body) :columns))
res)
@@ -537,13 +591,7 @@ Works for heads without a property :column."
`(concat
(mapconcat
- (lambda (x)
- (let ((str (hydra--to-string (cdr x))))
- (format
- (if (> (length str) 0)
- (concat hydra-head-format str)
- "%s")
- (car x))))
+ #'hydra--eval-and-format
',keys
", ")
,(if keys "." ""))))
@@ -557,11 +605,16 @@ Works for heads without a property :column."
BODY, and HEADS are parameters to `defhydra'."
(let* ((sorted-heads (hydra--sort-heads (hydra--normalize-heads heads)))
(heads-w-col (cl-remove-if-not (lambda (heads) (hydra--head-property
(nth 0 heads) :column)) sorted-heads))
- (heads-wo-col (cl-remove-if (lambda (heads) (hydra--head-property
(nth 0 heads) :column)) sorted-heads)))
- (concat (when heads-w-col
- (concat "\n" (hydra--hint-from-matrix body
(hydra--generate-matrix heads-w-col))))
- (when heads-wo-col
- (hydra--hint-heads-wocol body (car heads-wo-col))))))
+ (heads-wo-col (cl-remove-if (lambda (heads) (hydra--head-property
(nth 0 heads) :column)) sorted-heads))
+ (hint-w-col (when heads-w-col
+ (hydra--hint-from-matrix body (hydra--generate-matrix
heads-w-col))))
+ (hint-wo-col (when heads-wo-col
+ (hydra--hint-heads-wocol body (car heads-wo-col)))))
+ (if (null hint-w-col)
+ hint-wo-col
+ (if (stringp hint-wo-col)
+ `(concat ,@hint-w-col ,hint-wo-col)
+ `(concat ,@hint-w-col ,@(cdr hint-wo-col))))))
(defvar hydra-fontify-head-function nil
"Possible replacement for `hydra-fontify-head-default'.")
@@ -631,7 +684,7 @@ HEAD's binding is returned as a string wrapped with [] or
{}."
(defconst hydra-width-spec-regex " ?-?[0-9]*?"
"Regex for the width spec in keys and %` quoted sexps.")
-(defvar hydra-key-regex "\\[\\|]\\|[-[:alnum:]
~.,;:/|?<>={}*+#%@!&^↑↓←→⌫⌦⏎'`()\"$]+?"
+(defvar hydra-key-regex "\\[\\|]\\|[-\\[:alnum:]
~.,;:/|?<>={}*+#%@!&^↑↓←→⌫⌦⏎'`()\"$]+?"
"Regex for the key quoted in the docstring.")
(defun hydra--format (_name body docstring heads)
@@ -639,91 +692,113 @@ HEAD's binding is returned as a string wrapped with []
or {}."
\"%`...\" expressions are extracted into \"%S\".
_NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'.
The expressions can be auto-expanded according to NAME."
- (setq docstring (hydra--strip-align-markers docstring))
- (setq docstring (replace-regexp-in-string "___" "_β_" docstring))
- (let ((rest (if (eq (plist-get (cddr body) :hint) 'none)
- ""
- (hydra--hint body heads)))
- (start 0)
- varlist
- offset)
- (while (setq start
- (string-match
- (format
- "\\(?:%%\\(
?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:[_?]\\(%s\\)\\(%s\\)[_?]\\)"
- hydra-width-spec-regex
- hydra-key-regex)
- docstring start))
- (cond ((eq ?? (aref (match-string 0 docstring) 0))
- (let* ((key (match-string 4 docstring))
- (head (assoc key heads)))
- (if head
- (progn
- (push (nth 2 head) varlist)
- (setq docstring
- (replace-match
- (or
- hydra-doc-format-spec
- (concat "%" (match-string 3 docstring) "s"))
- t nil docstring)))
- (setq start (match-end 0))
- (warn "Unrecognized key: ?%s?" key))))
- ((eq ?_ (aref (match-string 0 docstring) 0))
- (let* ((key (match-string 4 docstring))
- (key (if (equal key "β") "_" key))
- normal-key
- (head (or (assoc key heads)
- (when (setq normal-key
- (cdr (assoc
- key
hydra-docstring-keys-translate-alist)))
- (assoc normal-key heads)))))
- (if head
- (progn
- (push (hydra-fontify-head (if normal-key
- (cons key (cdr head))
- head)
- body)
- varlist)
- (let ((replacement
- (or
- hydra-key-format-spec
- (concat "%" (match-string 3 docstring) "s"))))
+ (unless (memq 'elisp--witness--lisp (mapcar #'cadr heads))
+ (setq docstring (hydra--strip-align-markers docstring))
+ (setq docstring (replace-regexp-in-string "___" "_β_" docstring))
+ (let ((rest (if (eq (plist-get (cddr body) :hint) 'none)
+ ""
+ (hydra--hint body heads)))
+ (start 0)
+ (inner-regex (format "\\(%s\\)\\(%s\\)" hydra-width-spec-regex
hydra-key-regex))
+ varlist
+ offset)
+ (while (setq start
+ (string-match
+ (format
+ "\\(?:%%\\(
?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_%s_\\)\\|\\(?:[?]%s[?]\\)"
+ inner-regex
+ inner-regex)
+ docstring start))
+ (cond ((eq ?? (aref (match-string 0 docstring) 0))
+ (let* ((key (match-string 6 docstring))
+ (head (assoc key heads)))
+ (if head
+ (progn
+ (push (nth 2 head) varlist)
(setq docstring
- (replace-match replacement t nil docstring))
- (setq start (+ start (length replacement)))))
- (setq start (match-end 0))
- (warn "Unrecognized key: _%s_" key))))
-
- (t
- (let* ((varp (if (eq ?` (aref (match-string 2 docstring) 0)) 1 0))
- (spec (match-string 1 docstring))
- (lspec (length spec)))
- (setq offset
- (with-temp-buffer
- (insert (substring docstring (+ 1 start varp
- (length spec))))
- (goto-char (point-min))
- (push (read (current-buffer)) varlist)
- (- (point) (point-min))))
- (when (or (zerop lspec)
- (/= (aref spec (1- (length spec))) ?s))
- (setq spec (concat spec "S")))
- (setq docstring
- (concat
- (substring docstring 0 start)
- "%" spec
- (substring docstring (+ start offset 1 lspec varp))))))))
- (if (eq ?\n (aref docstring 0))
- `(concat (format ,(substring docstring 1) ,@(nreverse varlist))
- ,rest)
- (let ((r `(replace-regexp-in-string
- " +$" ""
- (concat ,docstring ": "
- (replace-regexp-in-string
- "\\(%\\)" "\\1\\1" ,rest)))))
- (if (stringp rest)
- `(format ,(eval r))
- `(format ,r))))))
+ (replace-match
+ (or
+ hydra-doc-format-spec
+ (concat "%" (match-string 3 docstring) "s"))
+ t nil docstring)))
+ (setq start (match-end 0))
+ (warn "Unrecognized key: ?%s?" key))))
+ ((eq ?_ (aref (match-string 0 docstring) 0))
+ (let* ((key (match-string 4 docstring))
+ (key (if (equal key "β") "_" key))
+ normal-key
+ (head (or (assoc key heads)
+ (when (setq normal-key
+ (cdr (assoc
+ key
hydra-docstring-keys-translate-alist)))
+ (assoc normal-key heads)))))
+ (if head
+ (progn
+ (push (hydra-fontify-head (if normal-key
+ (cons key (cdr head))
+ head)
+ body)
+ varlist)
+ (let ((replacement
+ (or
+ hydra-key-format-spec
+ (concat "%" (match-string 3 docstring) "s"))))
+ (setq docstring
+ (replace-match replacement t nil docstring))
+ (setq start (+ start (length replacement)))))
+ (setq start (match-end 0))
+ (warn "Unrecognized key: _%s_" key))))
+
+ (t
+ (let* ((varp (if (eq ?` (aref (match-string 2 docstring) 0)) 1
0))
+ (spec (match-string 1 docstring))
+ (lspec (length spec)))
+ (setq offset
+ (with-temp-buffer
+ (insert (substring docstring (+ 1 start varp
+ (length spec))))
+ (goto-char (point-min))
+ (push (read (current-buffer)) varlist)
+ (- (point) (point-min))))
+ (when (or (zerop lspec)
+ (/= (aref spec (1- (length spec))) ?s))
+ (setq spec (concat spec "S")))
+ (setq docstring
+ (concat
+ (substring docstring 0 start)
+ "%" spec
+ (substring docstring (+ start offset 1 lspec
varp))))))))
+ (hydra--format-1 docstring rest varlist))))
+
+(defun hydra--format-1 (docstring rest varlist)
+ (cond
+ ((string= docstring "")
+ rest)
+ ((listp rest)
+ (unless (string-match-p "[:\n]" docstring)
+ (setq docstring (concat docstring ":\n")))
+ (unless (or (string-match-p "\n\\'" docstring)
+ (equal (cadr rest) "\n"))
+ (setq docstring (concat docstring "\n")))
+ `(concat (format ,(replace-regexp-in-string "\\`\n" "" docstring)
,@(nreverse varlist))
+ ,@(cdr rest)))
+ ((eq ?\n (aref docstring 0))
+ `(format ,(concat (substring docstring 1) rest) ,@(nreverse varlist)))
+ (t
+ (let ((r `(replace-regexp-in-string
+ " +$" ""
+ (concat ,docstring
+ ,(cond ((string-match-p "\\`\n" rest)
+ ":")
+ ((string-match-p "\n" rest)
+ ":\n")
+ (t
+ ": "))
+ (replace-regexp-in-string
+ "\\(%\\)" "\\1\\1" ,rest)))))
+ (if (stringp rest)
+ `(format ,(eval r))
+ `(format ,r))))))
(defun hydra--complain (format-string &rest args)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."
@@ -737,15 +812,15 @@ BODY-KEY is the body key binding.
BODY-NAME is the symbol that identifies the Hydra.
HEADS is a list of heads."
(format
- "Create a hydra with %s body and the heads:\n\n%s\n\n%s"
- (if body-key
- (format "a \"%s\"" body-key)
- "no")
+ "The heads for the associated hydra are:\n\n%s\n\n%s%s."
(mapconcat
(lambda (x)
(format "\"%s\": `%S'" (car x) (cadr x)))
heads ",\n")
- (format "The body can be accessed via `%S'." body-name)))
+ (format "The body can be accessed via `%S'" body-name)
+ (if body-key
+ (format ", which is bound to \"%s\"" body-key)
+ "")))
(defun hydra--call-interactively-remap-maybe (cmd)
"`call-interactively' the given CMD or its remapped equivalent.
@@ -782,8 +857,10 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
(hydra--make-callable
(cadr head))))
(doc (if (car head)
- (format "%s\n\nCall the head: `%S'." doc (cadr head))
- doc))
+ (format "Call the head `%S' in the \"%s\" hydra.\n\n%s"
+ (cadr head) name doc)
+ (format "Call the body in the \"%s\" hydra.\n\n%s"
+ name doc)))
(hint (intern (format "%S/hint" name)))
(body-foreign-keys (hydra--body-foreign-keys body))
(body-timeout (plist-get body :timeout))
@@ -791,6 +868,7 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
`(defun ,cmd-name ()
,doc
(interactive)
+ (require 'hydra)
(hydra-default-pre)
,@(when body-pre (list body-pre))
,@(if (hydra--head-property head :exit)
@@ -812,9 +890,7 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
`(condition-case err
,(hydra--call-interactively cmd (cadr head))
((quit error)
- (message (error-message-string err))
- (unless hydra-lv
- (sit-for 0.8)))))
+ (message (error-message-string err)))))
,(if (and body-idle (eq (cadr head) 'body))
`(hydra-idle-message ,body-idle ,hint ',name)
`(hydra-show-hint ,hint ',name))
@@ -857,9 +933,9 @@ KEY is forwarded to `plist-get'."
(message (eval hint)))
(t
(when hydra-is-helpful
- (if hydra-lv
- (lv-message (eval hint))
- (message (eval hint))))))))
+ (funcall
+ (nth 1 (assoc hydra-hint-display-type hydra-hint-display-alist))
+ (eval hint)))))))
(defmacro hydra--make-funcall (sym)
"Transform SYM into a `funcall' to call it."
@@ -1043,21 +1119,48 @@ Each head is decorated with 2 new properties
max-doc-len and max-key-len
representing the maximum dimension of their owning group.
Every heads-group have equal length by adding padding heads where applicable."
(when heads-groups
- (cl-loop for heads-group in (hydra--pad-heads heads-groups '(" " nil " "
:exit t))
- for column-name = (hydra--head-property (nth 0 heads-group)
:column)
- for max-key-len = (apply #'max (mapcar (lambda (x) (length (car
x))) heads-group))
- for max-doc-len = (apply #'max
- (length column-name)
- (mapcar (lambda (x) (length
(hydra--to-string (nth 2 x)))) heads-group))
- for header-virtual-head = `(" " nil ,column-name :column
,column-name :exit t)
- for separator-virtual-head = `(" " nil ,(make-string (+ 2
max-doc-len max-key-len) ?-) :column ,column-name :exit t)
- for decorated-heads = (copy-tree (apply 'list header-virtual-head
separator-virtual-head heads-group))
- collect (mapcar (lambda (it)
- (hydra--head-set-property it :max-key-len
max-key-len)
- (hydra--head-set-property it :max-doc-len
max-doc-len))
- decorated-heads)
- into decorated-heads-matrix
- finally return decorated-heads-matrix)))
+ (let ((res nil))
+ (dolist (heads-group (hydra--pad-heads heads-groups '(" " nil " " :exit
t)))
+ (let* ((column-name (hydra--head-property (nth 0 heads-group) :column))
+ (max-key-len (apply #'max (mapcar (lambda (x) (length (car x)))
heads-group)))
+ (max-doc-len (apply #'max
+ (length column-name)
+ (mapcar (lambda (x) (length
(hydra--to-string (nth 2 x)))) heads-group)))
+ (header-virtual-head `(" " nil ,column-name :column
,column-name :exit t))
+ (separator-virtual-head `(" " nil ,(make-string (+ 2
max-doc-len max-key-len) ?-) :column ,column-name :exit t))
+ (decorated-heads (copy-tree (apply 'list header-virtual-head
separator-virtual-head heads-group))))
+ (push (mapcar (lambda (it)
+ (hydra--head-set-property it :max-key-len
max-key-len)
+ (hydra--head-set-property it :max-doc-len
max-doc-len))
+ decorated-heads) res)))
+ (nreverse res))))
+
+(defun hydra-interpose (x lst)
+ "Insert X in between each element of LST."
+ (let (res y)
+ (while (setq y (pop lst))
+ (push y res)
+ (push x res))
+ (nreverse (cdr res))))
+
+(defun hydra--hint-row (heads body)
+ (let ((lst (hydra-interpose
+ "| "
+ (mapcar (lambda (head)
+ (funcall hydra-key-doc-function
+ (hydra-fontify-head head body)
+ (let ((n (hydra--head-property head
:max-key-len)))
+ (+ n (cl-count ?% (car head))))
+ (nth 2 head) ;; doc
+ (hydra--head-property head :max-doc-len)))
+ heads))))
+ (when (stringp (car (last lst)))
+ (let ((len (length lst))
+ (new-last (replace-regexp-in-string "\s+$" "" (car (last lst)))))
+ (when (= 0 (length (setf (nth (- len 1) lst) new-last)))
+ (setf (nth (- len 2) lst) "|"))))
+ lst))
+
(defun hydra--hint-from-matrix (body heads-matrix)
"Generate a formated table-style docstring according to BODY and
HEADS-MATRIX.
@@ -1065,22 +1168,21 @@ HEADS-MATRIX is expected to be a list of heads with
following features:
Each heads must have the same length
Each head must have a property max-key-len and max-doc-len."
(when heads-matrix
- (cl-loop with first-heads-col = (nth 0 heads-matrix)
- with last-row-index = (- (length first-heads-col) 1)
- for row-index from 0 to last-row-index
- for heads-in-row = (mapcar (lambda (heads) (nth row-index heads))
heads-matrix)
- concat (concat
- (replace-regexp-in-string "\s+$" ""
- (mapconcat (lambda (head)
- (funcall
hydra-key-doc-function
-
(hydra-fontify-head head body) ;; key
-
(hydra--head-property head :max-key-len)
- (nth 2
head) ;; doc
-
(hydra--head-property head :max-doc-len)))
- heads-in-row "| "))
"\n")
- into matrix-image
- finally return matrix-image)))
-;; previous functions dealt with automatic docstring table generation from
:column head property
+ (let ((lines (hydra--hint-from-matrix-1 body heads-matrix)))
+ `(,@(apply #'append (hydra-interpose '("\n") lines))
+ "\n"))))
+
+(defun hydra--hint-from-matrix-1 (body heads-matrix)
+ (let* ((first-heads-col (nth 0 heads-matrix))
+ (last-row-index (- (length first-heads-col) 1))
+ (lines nil))
+ (dolist (row-index (number-sequence 0 last-row-index))
+ (let ((heads-in-row (mapcar
+ (lambda (heads) (nth row-index heads))
+ heads-matrix)))
+ (push (hydra--hint-row heads-in-row body)
+ lines)))
+ (nreverse lines)))
(defun hydra-idle-message (secs hint name)
"In SECS seconds display HINT."
@@ -1147,7 +1249,7 @@ 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 and :bind.
+override some keys. The keys recognized are :exit, :bind, and :column.
:exit can be:
- nil (default): this head will continue the Hydra state.
@@ -1157,11 +1259,13 @@ override some keys. The keys recognized are :exit and
:bind.
- 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))
+ (declare (indent defun) (doc-string 3))
(setq heads (copy-tree heads))
(cond ((stringp docstring))
((and (consp docstring)
@@ -1169,15 +1273,18 @@ result of `defhydra'."
(setq docstring (concat "\n" (eval docstring))))
(t
(setq heads (cons docstring heads))
- (setq docstring "hydra")))
+ (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 (copy-keymap hydra-base-map))
- (keymap-name (intern (format "%S/keymap" name)))
+ (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))
@@ -1252,12 +1359,14 @@ result of `defhydra'."
"An %S Hydra must have at least one blue head in order to exit"
body-foreign-keys)))
`(progn
- ;; create keymap
- (set (defvar ,keymap-name
+ (set (defvar ,(intern (format "%S/params" name))
nil
- ,(format "Keymap for %S." name))
- ',keymap)
- ;; declare heads
+ ,(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))
@@ -1266,6 +1375,12 @@ result of `defhydra'."
(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))
@@ -1316,6 +1431,24 @@ result of `defhydra'."
(hydra--complain "Error in defhydra %S: %s" name (cdr err))
nil)))
+(defmacro defhydra+ (name body &optional docstring &rest heads)
+ "Redefine an existing hydra by adding new heads.
+Arguments are same as of `defhydra'."
+ (declare (indent defun) (doc-string 3))
+ (unless (stringp docstring)
+ (setq heads
+ (cons docstring heads))
+ (setq docstring nil))
+ `(defhydra ,name ,(or body (hydra--prop name "/params"))
+ ,(or docstring (hydra--prop name "/docstring"))
+ ,@(cl-delete-duplicates
+ (append (hydra--prop name "/heads") heads)
+ :key #'car
+ :test #'equal)))
+
+(defun hydra--prop (name prop-name)
+ (symbol-value (intern (concat (symbol-name name) prop-name))))
+
(defmacro defhydradio (name _body &rest heads)
"Create radios with prefix NAME.
_BODY specifies the options; there are none currently.
diff --git a/lv.el b/lv.el
index 87f7e5e98b..7043abb126 100644
--- a/lv.el
+++ b/lv.el
@@ -54,6 +54,8 @@ Only the background color is significant."
(defvar lv-wnd nil
"Holds the current LV window.")
+(defvar display-line-numbers)
+
(defun lv-window ()
"Ensure that LV window is live and return it."
(if (window-live-p lv-wnd)
@@ -72,6 +74,7 @@ Only the background color is significant."
(setq window-size-fixed t)
(setq mode-line-format nil)
(setq cursor-type nil)
+ (setq display-line-numbers nil)
(set-window-dedicated-p lv-wnd t)
(set-window-parameter lv-wnd 'no-other-window t))
(select-window ori)))))
