Skip to content

Commit

Permalink
Add some features for generating tables
Browse files Browse the repository at this point in the history
* 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.
  • Loading branch information
abo-abo committed Feb 27, 2015
1 parent 7de26d0 commit 8e90037
Show file tree
Hide file tree
Showing 2 changed files with 153 additions and 22 deletions.
55 changes: 50 additions & 5 deletions hydra-test.el
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand All @@ -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
Expand Down Expand Up @@ -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
120 changes: 103 additions & 17 deletions hydra.el
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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 ()
Expand Down

0 comments on commit 8e90037

Please sign in to comment.