[elpa] externals/hydra e01a79e4b7 24/46: hydra.el (defhydra): Declare "/params" and "/docstring"

[Stefan Monnier]

branch: externals/hydra
commit e01a79e4b771e6ac5579132bbc9aa88154dbf070
Author: Oleh Krehel <ohwoeowho@gmail.com>
Commit: Oleh Krehel <ohwoeowho@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.