[elpa] externals/hydra 1e423933a9 30/46: hydra.el: sexp hints are now supported for :columns

[Stefan Monnier]

branch: externals/hydra
commit 1e423933a9834509b21ab2e766e6f01886b44d20
Author: Oleh Krehel <ohwoeowho@gmail.com>
Commit: Oleh Krehel <ohwoeowho@gmail.com>

    hydra.el: sexp hints are now supported for :columns
    
    * hydra-test.el: Old tests have one less layer of '(concat ...) around
      the docstring.
    (hydra-format-10): Add test.
    
    Fixes #304
    Fixes #311
---
 hydra-test.el | 105 +++++++++++++++++++++++++++++++++-------------------------
 hydra.el      |  96 ++++++++++++++++++++++++++++++-----------------------
 2 files changed, 115 insertions(+), 86 deletions(-)

diff --git a/hydra-test.el b/hydra-test.el
index 2fb98a0b14..048f37f5b2 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -1097,10 +1097,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
@@ -1112,7 +1116,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
@@ -1123,7 +1127,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
@@ -1132,9 +1136,9 @@ _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
@@ -1142,12 +1146,10 @@ _f_ auto-fill-mode:    %`auto-fill-function
            nil nil "\n_-_: mark          _u_: unmark\n"
            '(("-" Buffer-menu-mark nil)
              ("u" Buffer-menu-unmark nil)))
-          '(concat
-            (format
-             "%s: mark          %s: unmark\n"
-             #("-" 0 1 (face hydra-face-red))
-             #("u" 0 1 (face hydra-face-red)))
-            ""))))
+          '(format
+            "%s: mark          %s: unmark\n"
+            #("-" 0 1 (face hydra-face-red))
+            #("u" 0 1 (face hydra-face-red))))))
 
 (ert-deftest hydra-format-6 ()
   (should
@@ -1155,16 +1157,14 @@ _f_ auto-fill-mode:    %`auto-fill-function
            nil nil "\n[_]_] forward [_[_] backward\n"
            '(("]" forward-char nil)
              ("[" backward-char nil)))
-          '(concat
-            (format
-             "[%s] forward [%s] backward\n"
-             #("]"
-               0 1 (face
-                    hydra-face-red))
-             #("["
-               0 1 (face
-                    hydra-face-red)))
-            ""))))
+          '(format
+            "[%s] forward [%s] backward\n"
+            #("]"
+              0 1 (face
+                   hydra-face-red))
+            #("["
+              0 1 (face
+                   hydra-face-red))))))
 
 (ert-deftest hydra-format-7 ()
   (should
@@ -1183,12 +1183,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
@@ -1205,11 +1203,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
@@ -1219,12 +1234,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
@@ -1234,12 +1249,12 @@ _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
diff --git a/hydra.el b/hydra.el
index 3bfda1587f..1ccb483209 100644
--- a/hydra.el
+++ b/hydra.el
@@ -508,6 +508,14 @@ Remove :color key. And sort the plist alphabetically."
       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'.
@@ -516,14 +524,13 @@ Works for heads without a property :column."
     (dolist (h heads)
       (let ((val (assoc (cadr h) alist))
             (pstr (hydra-fontify-head h body)))
-        (unless (not (stringp (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)
@@ -552,13 +559,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 "." ""))))
@@ -572,11 +573,17 @@ 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
-              (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 (or (stringp hint-wo-col) (null hint-wo-col))
+        (concat hint-w-col hint-wo-col)
+      (cl-assert (or (eq (car hint-wo-col) 'concat)))
+      (if hint-w-col
+          `(concat ,hint-w-col ,@(cdr hint-wo-col))
+        hint-wo-col))))
 
 (defvar hydra-fontify-head-function nil
   "Possible replacement for `hydra-fontify-head-default'.")
@@ -730,27 +737,34 @@ The expressions can be auto-expanded according to NAME."
                         (substring docstring 0 start)
                         "%" spec
                         (substring docstring (+ start offset 1 lspec 
varp))))))))
-      (cond
-        ((string= docstring "")
-         rest)
-        ((eq ?\n (aref docstring 0))
-         `(concat (format ,(substring docstring 1) ,@(nreverse varlist))
-                  ,rest))
-        (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))))))))
+      (hydra--format-1 docstring rest varlist))))
+
+(defun hydra--format-1 (docstring rest varlist)
+  (cond
+    ((string= docstring "")
+     rest)
+    ((listp rest)
+     (unless (or (string-match-p "\n\\'" docstring)
+                 (equal (cadr rest) "\n"))
+       (setq docstring (concat docstring "\n")))
+     `(concat (format ,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."