[elpa] master 8e90037 65/72: Add some features for generating tables

[Oleh Krehel]

branch: master
commit 8e90037eda7599cfb9caa57a516129690e2239ae
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    Add some features for generating tables
    
    * hydra.el (hydra--pad): New defun.
    (hydra--matrix): New defun.
    (hydra--cell): New defun.
    (hydra--vconcat): New defun.
    (hydra-cell-format): New defcustom.
    (hydra--table): New defun.
    (hydra-reset-radios): New defun.
    (defhydra): Allow docstring to be eval-able.
    (defhydradio): Don't define `.../reset-radios', instead define
    `.../names' that can be passed to `hydra-reset-radios'.
    (hydra-multipop): New defmacro.
    (hydra--radio): Update the order - the docstring is now a mandatory
    second arg, value is the optional third.
    
    * hydra-test.el (defhydradio): Update test.
    (hydra--pad): Add test.
    (hydra--matrix): Add test.
    (hydra--cell): Add test.
    (hydra--vconcat): Add test.
    (hydra--table): Add test.
---
 hydra-test.el |   55 ++++++++++++++++++++++++--
 hydra.el      |  120 +++++++++++++++++++++++++++++++++++++++++++++++++--------
 2 files changed, 153 insertions(+), 22 deletions(-)

diff --git a/hydra-test.el b/hydra-test.el
index c2fb5ab..a4a9a00 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -569,8 +569,8 @@ The body can be accessed via `hydra-vi/body'."
   (should (equal
            (macroexpand
             '(defhydradio hydra-test ()
-              (num [0 1 2 3 4 5 6 7 8 9 10])
-              (str ["foo" "bar" "baz"])))
+              (num "Num" [0 1 2 3 4 5 6 7 8 9 10])
+              (str "Str" ["foo" "bar" "baz"])))
            '(progn
              (defvar hydra-test/num 0
                "Num")
@@ -582,9 +582,7 @@ The body can be accessed via `hydra-vi/body'."
              (put 'hydra-test/str 'range ["foo" "bar" "baz"])
              (defun hydra-test/str ()
                (hydra--cycle-radio 'hydra-test/str))
-             (defun hydra-test/reset-radios ()
-               (setq hydra-test/num 0)
-               (setq hydra-test/str "foo"))))))
+             (defvar hydra-test/names '(hydra-test/num hydra-test/str))))))
 
 (ert-deftest hydra-blue-compat ()
   (should
@@ -1031,6 +1029,53 @@ The body can be accessed via `hydra-zoom/body'."
                       t (lambda nil (hydra-cleanup))))
                (setq prefix-arg current-prefix-arg)))))))
 
+(ert-deftest hydra--pad ()
+  (should (equal (hydra--pad '(a b c) 3)
+                 '(a b c)))
+  (should (equal (hydra--pad '(a) 3)
+                 '(a nil nil))))
+
+(ert-deftest hydra--matrix ()
+  (should (equal (hydra--matrix '(a b c) 2 2)
+                 '((a b) (c nil))))
+  (should (equal (hydra--matrix '(a b c d e f g h i) 4 3)
+                 '((a b c d) (e f g h) (i nil nil nil)))))
+
+(ert-deftest hydra--cell ()
+  (should (equal (hydra--cell "% -75s %%`%s" '(hydra-lv hydra-verbose))
+                 "When non-nil, `lv-message' (not `message') will be used to 
display hints.   %`hydra-lv^^^^^
+When non-nil, hydra will issue some non essential style warnings.           
%`hydra-verbose")))
+
+(ert-deftest hydra--vconcat ()
+  (should (equal (hydra--vconcat '("abc\ndef" "012\n34" "def\nabc"))
+                 "abc012def\ndef34abc")))
+
+(defhydradio hydra-tng ()
+  (picard "_p_ Captain Jean Luc Picard:")
+  (riker "_r_ Commander William Riker:")
+  (data "_d_ Lieutenant Commander Data:")
+  (worf "_w_ Worf:")
+  (la-forge "_f_ Geordi La Forge:")
+  (troi "_t_ Deanna Troi:")
+  (dr-crusher "_c_ Doctor Beverly Crusher:")
+  (phaser "_h_ Set phasers to " [stun kill]))
+
+(ert-deftest hydra--table ()
+  (let ((hydra-cell-format "% -30s %% -8`%s"))
+    (should (equal (hydra--table hydra-tng/names 5 2)
+                   (substring "
+_p_ Captain Jean Luc Picard:   % -8`hydra-tng/picard^^    _t_ Deanna Troi:     
          % -8`hydra-tng/troi^^^^^^
+_r_ Commander William Riker:   % -8`hydra-tng/riker^^^    _c_ Doctor Beverly 
Crusher:    % -8`hydra-tng/dr-crusher
+_d_ Lieutenant Commander Data: % -8`hydra-tng/data^^^^    _h_ Set phasers to   
          % -8`hydra-tng/phaser^^^^
+_w_ Worf:                      % -8`hydra-tng/worf^^^^    
+_f_ Geordi La Forge:           % -8`hydra-tng/la-forge    " 1)))
+    (should (equal (hydra--table hydra-tng/names 4 3)
+                   (substring "
+_p_ Captain Jean Luc Picard:   % -8`hydra-tng/picard    _f_ Geordi La Forge:   
        % -8`hydra-tng/la-forge^^    
+_r_ Commander William Riker:   % -8`hydra-tng/riker^    _t_ Deanna Troi:       
        % -8`hydra-tng/troi^^^^^^    
+_d_ Lieutenant Commander Data: % -8`hydra-tng/data^^    _c_ Doctor Beverly 
Crusher:    % -8`hydra-tng/dr-crusher    
+_w_ Worf:                      % -8`hydra-tng/worf^^    _h_ Set phasers to     
        % -8`hydra-tng/phaser^^^^    " 1)))))
+
 (provide 'hydra-test)
 
 ;;; hydra-test.el ends here
diff --git a/hydra.el b/hydra.el
index 24d194c..6eb9526 100644
--- a/hydra.el
+++ b/hydra.el
@@ -118,7 +118,7 @@ It's possible to set this to nil.")
   :type 'boolean)
 
 (defcustom hydra-verbose nil
-  "When non-nil, hydra will issue some non-essential style warnings."
+  "When non-nil, hydra will issue some non essential style warnings."
   :type 'boolean)
 
 (defcustom hydra-key-format-spec "%s"
@@ -660,6 +660,86 @@ In duplicate HEADS, :cmd-name is modified to whatever they 
duplicate."
         (push h res)))
     (nreverse res)))
 
+(defun hydra--pad (lst n)
+  "Pad LST with nil until length N."
+  (let ((len (length lst)))
+    (if (= len n)
+        lst
+      (append lst (make-list (- n len) nil)))))
+
+(defun hydra--matrix (lst rows cols)
+  "Create a matrix from elements of LST.
+The matrix size is ROWS times COLS."
+  (let ((ls (copy-sequence lst))
+        res)
+    (dotimes (c cols)
+      (push (hydra--pad (hydra-multipop ls rows) rows) res))
+    (nreverse res)))
+
+(defun hydra--cell (fstr names)
+  "Format a rectangular cell based on FSTR and NAMES.
+FSTR is a format-style string with two string inputs: one for the
+doc and one for the symbol name.
+NAMES is a list of variables."
+  (let ((len (cl-reduce
+              (lambda (acc it) (max (length (symbol-name it)) acc))
+              names
+              :initial-value 0)))
+    (mapconcat
+     (lambda (sym)
+       (if sym
+           (format fstr
+                   (documentation-property sym 'variable-documentation)
+                   (let ((name (symbol-name sym)))
+                     (concat name (make-string (- len (length name)) ?^)))
+                   sym)
+         ""))
+     names
+     "\n")))
+
+(defun hydra--vconcat (strs &optional joiner)
+  "Glue STRS vertically.  They must be the same height.
+JOINER is a function similar to `concat'."
+  (setq joiner (or joiner #'concat))
+  (mapconcat
+   #'identity
+   (apply #'cl-mapcar joiner
+          (mapcar
+           (lambda (s) (split-string s "\n"))
+           strs))
+   "\n"))
+
+(defcustom hydra-cell-format "% -20s %% -8`%s"
+  "The default format for docstring cells."
+  :type 'string)
+
+(defun hydra--table (names rows cols &optional cell-formats)
+  "Format a `format'-style table from variables in NAMES.
+The size of the table is ROWS times COLS.
+CELL-FORMATS are `format' strings for each column.
+If CELL-FORMATS is a string, it's used for all columns.
+If CELL-FORMATS is nil, `hydra-cell-format' is used for all columns."
+  (setq cell-formats
+        (cond ((null cell-formats)
+               (make-list cols hydra-cell-format))
+              ((stringp cell-formats)
+               (make-list cols cell-formats))
+              (t
+               cell-formats)))
+  (hydra--vconcat
+   (cl-mapcar
+    #'hydra--cell
+    cell-formats
+    (hydra--matrix names rows cols))
+   (lambda (&rest x)
+     (mapconcat #'identity x "    "))))
+
+(defun hydra-reset-radios (names)
+  "Set varibles NAMES to their defaults.
+NAMES should be defined by `defhydradio' or similar."
+  (dolist (n names)
+    (set n (aref (get n 'range) 0))))
+
 ;;* Macros
 ;;** defhydra
 ;;;###autoload
@@ -714,9 +794,13 @@ 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))
-  (unless (stringp docstring)
-    (setq heads (cons docstring heads))
-    (setq docstring "hydra"))
+  (cond ((stringp docstring))
+        ((and (consp docstring)
+              (memq (car docstring) '(hydra--table concat format)))
+         (setq docstring (concat "\n" (eval docstring))))
+        (t
+         (setq heads (cons docstring heads))
+         (setq docstring "hydra")))
   (when (keywordp (car body))
     (setq body (cons nil (cons nil body))))
   (dolist (h heads)
@@ -824,24 +908,26 @@ DOC defaults to TOGGLE-NAME split and capitalized."
               (mapcar (lambda (h)
                         (hydra--radio name h))
                       heads))
-     (defun ,(intern (format "%S/reset-radios" name)) ()
-       ,@(mapcar
-          (lambda (h)
-            (let ((full-name (intern (format "%S/%S" name (car h))))
-                  )
-              `(setq ,full-name ,(hydra--quote-maybe
-                                  (and (cadr h) (aref (cadr h) 0))))))
-          heads))))
+     (defvar ,(intern (format "%S/names" name))
+       ',(mapcar (lambda (h) (intern (format "%S/%S" name (car h))))
+                 heads))))
+
+(defmacro hydra-multipop (lst n)
+  "Return LST's first N elements while removing them."
+  `(if (<= (length ,lst) ,n)
+       (prog1 ,lst
+         (setq ,lst nil))
+     (prog1 ,lst
+       (setcdr
+        (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
+        nil))))
 
 (defun hydra--radio (parent head)
   "Generate a hydradio with PARENT from HEAD."
   (let* ((name (car head))
          (full-name (intern (format "%S/%S" parent name)))
-         (val (or (cadr head) [nil t]))
-         (doc (or (cl-caddr head)
-                  (mapconcat #'capitalize
-                             (split-string (symbol-name name) "-")
-                             " "))))
+         (doc (cadr head))
+         (val (or (cl-caddr head) [nil t])))
     `((defvar ,full-name ,(hydra--quote-maybe (aref val 0)) ,doc)
       (put ',full-name 'range ,val)
       (defun ,full-name ()