branch: master
commit 8e90037eda7599cfb9caa57a516129690e2239ae
Author: Oleh Krehel <ohwoeo...@gmail.com>
Commit: Oleh Krehel <ohwoeo...@gmail.com>
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 ()
