hydra-test.el (hydra-format): New test

[gnu-emacs-elpa] / hydra.el

diff --git a/hydra.el b/hydra.el
index fe5489274f8b155a83b40b1ecd43f8d0b57dd210..5ea464096bc49700f030106b3da23bab711f6fb4 100644 (file)
--- a/hydra.el
+++ b/hydra.el
@@ -354,6 +354,15 @@ NAME, BODY, DOCSTRING and HEADS are parameters to `defhydra'."
 HEAD's binding is returned as a string with a colored face."
   (propertize (car head) 'face (hydra--face head body)))
 
+(defun hydra-fontify-head-greyscale (head body)
+  "Produce a pretty string from HEAD and BODY.
+HEAD's binding is returned as a string wrapped with [] or {}."
+  (let ((color (hydra--head-color head body)))
+    (format
+     (if (eq color 'blue)
+         "[%s]"
+       "{%s}") (car head))))
+
 (defun hydra-fontify-head (head body)
   "Produce a pretty string from HEAD and BODY."
   (funcall (or hydra-fontify-head-function 'hydra-fontify-head-default)
@@ -362,7 +371,7 @@ HEAD's binding is returned as a string with a colored face."
 (defun hydra--format (name body docstring heads)
   "Generate a `format' statement from STR.
 \"%`...\" expressions are extracted into \"%S\".
-NAME, HEADS and BODY-COLOR are parameters of `defhydra'.
+NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'.
 The expressions can be auto-expanded according to NAME."
   (setq docstring (replace-regexp-in-string "\\^" "" docstring))
   (let ((rest (hydra--hint name body docstring heads))
@@ -451,6 +460,7 @@ BODY-COLOR, BODY-PRE, BODY-POST, and OTHER-POST are used as well."
                     ,other-post))))))
 
 (defun hydra-pink-fallback ()
+  "On intercepting a non-head, try to run it."
   (let ((keys (this-command-keys))
         kb)
     (when (equal keys [backspace])
@@ -467,7 +477,9 @@ BODY-COLOR, BODY-PRE, BODY-POST, and OTHER-POST are used as well."
           (message "Pink Hydra can't currently handle prefixes, continuing"))
       (message "Pink Hydra could not resolve: %S" keys))))
 
-(defun hydra--handle-nonhead (body heads keymap hint-name)
+(defun hydra--handle-nonhead (keymap name body heads)
+  "Setup KEYMAP for intercepting non-head bindings.
+NAME, BODY and HEADS are parameters to `defhydra'."
   (let ((body-color (hydra--body-color body))
         (body-post (plist-get (cddr body) :post)))
     (when (and body-post (symbolp body-post))
@@ -491,10 +503,10 @@ BODY-COLOR, BODY-PRE, BODY-POST, and OTHER-POST are used as well."
                  (when hydra-is-helpful
                    (unless hydra-lv
                      (sit-for 0.8))
-                   (,hint-name)))))
-          (error
-           "An %S Hydra must have at least one blue head in order to exit"
-           body-color))
+                   (,(intern (format "%S/hint" name)))))))
+        (error
+         "An %S Hydra must have at least one blue head in order to exit"
+         body-color))
       (when hydra-keyboard-quit
         (define-key keymap hydra-keyboard-quit
           `(lambda ()
@@ -585,7 +597,7 @@ result of `defhydra'."
       (setq body-pre `(funcall #',body-pre)))
     (when (and body-post (symbolp body-post))
       (setq body-post `(funcall #',body-post)))
-    (hydra--handle-nonhead body heads keymap hint-name)
+    (hydra--handle-nonhead keymap name body heads)
     `(progn
        ,@(cl-mapcar
           (lambda (head name)