branch: externals/hydra
commit e01a79e4b771e6ac5579132bbc9aa88154dbf070
Author: Oleh Krehel <ohwoeo...@gmail.com>
Commit: Oleh Krehel <ohwoeo...@gmail.com>
hydra.el (defhydra): Declare "/params" and "/docstring"
* hydra-test.el: Update tests.
Re #185
---
hydra-test.el | 322 +++++++++++++++++++++++++++++++++-------------------------
hydra.el | 37 ++++++-
2 files changed, 218 insertions(+), 141 deletions(-)
diff --git a/hydra-test.el b/hydra-test.el
index 4e77b7ade0..eed1163935 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.")
@@ -268,6 +276,35 @@ The body can be accessed via `hydra-error/body', which is
bound to \"M-g\"."
("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.")
@@ -300,23 +337,6 @@ The body can be accessed via `hydra-error/body', which is
bound to \"M-g\"."
(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.")
@@ -456,6 +476,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.")
@@ -487,16 +531,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.")
@@ -637,6 +671,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.")
@@ -666,24 +726,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.")
@@ -788,6 +830,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.")
@@ -817,24 +885,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.")
@@ -1194,62 +1244,62 @@ _f_ auto-fill-mode: %`auto-fill-function
(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)
@@ -1407,7 +1457,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)
@@ -1470,7 +1520,7 @@ t: info-to"
(should (equal (eval
(cadr
(nth 2
- (nth 3
+ (nth 5
(macroexpand
'(defhydra hydra-foo (:color blue)
"Silly hydra"
@@ -1498,7 +1548,7 @@ y: back | b: up
(should (equal (eval
(cadr
(nth 2
- (nth 3
+ (nth 5
(macroexpand
'(defhydra hydra-rectangle (:body-pre
(rectangle-mark-mode 1)
:color pink
@@ -1563,7 +1613,7 @@ o: ok | s: string
(should (equal (eval
(cadr
(nth 2
- (nth 3
+ (nth 5
(macroexpand
'(defhydra hydra-window-order
(:color red :timeout 4)
diff --git a/hydra.el b/hydra.el
index 49066e9bd2..1739dd752c 100644
--- a/hydra.el
+++ b/hydra.el
@@ -441,6 +441,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))
+ (mapcan (lambda (x) (list (car x) (cdr x))) alist2)))))
+
(defalias 'hydra--imf #'list)
(defun hydra-default-pre ()
@@ -1192,6 +1207,7 @@ result of `defhydra'."
(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)))
@@ -1274,12 +1290,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))
@@ -1288,6 +1306,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))
@@ -1338,6 +1362,9 @@ result of `defhydra'."
(hydra--complain "Error in defhydra %S: %s" name (cdr err))
nil)))
+(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.
