Add :columns option for hydra body

* hydra.el (hydra-key-doc-function): New defvar.
(hydra-key-doc-function-default): New defun.
(hydra--hint): Add a new branch for the case :columns is specified; when
there are no columns, move the final dot here from `hydra--format'.
(hydra--format): Move final dot.

* hydra-test.el (hydra-format-1):
(hydra-format-2):
(hydra-format-with-sexp-1):
(hydra-format-with-sexp-2): Move final dot.
(hydra-columns-1): Add test.

See the code in `hydra-columns-1' test for a new approach to defining
hydras with 2D docstrings. Compared to doing it by-hand, the new method
is more flexible in one place (heads and head hints can be updated
easily) and less flexible in other (the method of joining head hints is
fixed), but very simple and short.

Example:

(defhydra hydra-info (:color blue
                      :columns 3)
  "Info-mode"
  ("?" Info-summary "summary")
  ("]" Info-forward-node "forward")
  ("[" Info-backward-node "backward")
  ("<" Info-top-node "top node")
  (">" Info-final-node "final node")
  ("h" Info-help "help")
  ("d" Info-directory "info dir")
  ("f" Info-follow-reference "follow ref")
  ("g" Info-goto-node "goto node")
  ("l" Info-history-back "hist back")
  ("r" Info-history-forward "hist forward")
  ("i" Info-index "index")
  ("I" Info-virtual-index "virtual index")
  ("L" Info-history "hist")
  ("n" Info-next "next")
  ("p" Info-prev "previous")
  ("s" Info-search "search")
  ("S" Info-search-case-sensitively "case-search")
  ("T" Info-toc "TOC")
  ("u" Info-up "up")
  ("m" Info-menu "menu"))

Similar one done by-hand:

(defhydra hydra-info (:color blue :hint nil)
  "
Info-mode:
    [_?_] summary       [_[_] forward          [_g_] goto node
    [_<_] top node      [_]_] backward         [_s_] search
    [_>_] final node    [_f_] follow ref       [_S_] case-search
    [_d_] info dir      [_l_] hist back        [_m_] menu
    [_i_] index         [_r_] hist forward     [_h_] help
    [_I_] virtual index [_n_] next
    [_L_] hist          [_p_] previous
    [_T_] TOC           [_u_] up
        "
  ("?" Info-summary)
  ("]" Info-forward-node)
  ("[" Info-backward-node)
  ("<" Info-top-node)
  (">" Info-final-node)
  ("h" Info-help)
  ("d" Info-directory)
  ("f" Info-follow-reference)
  ("g" Info-goto-node)
  ("l" Info-history-back)
  ("r" Info-history-forward)
  ("i" Info-index)
  ("I" Info-virtual-index)
  ("L" Info-history)
  ("n" Info-next)
  ("p" Info-prev)
  ("s" Info-search)
  ("S" Info-search-case-sensitively)
  ("T" Info-toc)
  ("u" Info-up)
  ("m" Info-menu))

Fixes #140
master
Oleh Krehel 11 years ago
parent df7b079af8
commit 336602f308
  1. 103
      hydra-test.el
  2. 55
      hydra.el

@ -1047,7 +1047,7 @@ _f_ auto-fill-mode: %`auto-fill-function
'(concat (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"))))
" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[{q}]: quit."))))
(ert-deftest hydra-format-2 ()
(should (equal
@ -1059,7 +1059,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]"))))
'(concat (format " bar %s\n" foo) "{a}, [q]."))))
(ert-deftest hydra-format-3 ()
(should (equal
@ -1150,7 +1150,7 @@ _f_ auto-fill-mode: %`auto-fill-function
(progn
(message "checking")
(buffer-narrowed-p)))
"[[q]]: cancel"))))
"[[q]]: cancel."))))
(ert-deftest hydra-format-with-sexp-2 ()
(should (equal
@ -1165,7 +1165,7 @@ _f_ auto-fill-mode: %`auto-fill-function
(progn
(message "checking")
(buffer-narrowed-p)))
"[[q]]: cancel"))))
"[[q]]: cancel."))))
(ert-deftest hydra-compat-colors-2 ()
(should
@ -1351,6 +1351,101 @@ _w_ Worf: % -8`hydra-tng/worf^^ _h_ Set phasers to
(kbd "C-c g 1 RET q")))
"|foo\nbar")))
(ert-deftest hydra-columns-1 ()
(should (equal (eval
(cadr
(nth 2
(nth 3
(macroexpand
'(defhydra hydra-info (:color blue
:columns 3)
"Info-mode"
("?" Info-summary "summary")
("]" Info-forward-node "forward")
("[" Info-backward-node "backward")
("<" Info-top-node "top node")
(">" Info-final-node "final node")
("h" Info-help "help")
("d" Info-directory "info dir")
("f" Info-follow-reference "follow ref")
("g" Info-goto-node "goto node")
("l" Info-history-back "hist back")
("r" Info-history-forward "hist forward")
("i" Info-index "index")
("I" Info-virtual-index "virtual index")
("L" Info-history "hist")
("n" Info-next "next")
("p" Info-prev "previous")
("s" Info-search "search")
("S" Info-search-case-sensitively "case-search")
("T" Info-toc "TOC")
("u" Info-up "up")
("m" Info-menu "menu")
("t" hydra-info-to/body "info-to"))))))
(format
#("Info-mode:
?: summary ]: forward [: backward
<: top node >: final node h: help
d: info dir f: follow ref g: goto node
l: hist back r: hist forward i: index
I: virtual index L: hist n: next
p: previous s: search S: case-search
T: TOC u: up m: menu
t: info-to "
12 13 (face hydra-face-blue)
29 30 (face hydra-face-blue)
46 47 (face hydra-face-blue)
64 65 (face hydra-face-blue)
81 82 (face hydra-face-blue)
98 99 (face hydra-face-blue)
116 117 (face hydra-face-blue)
133 134 (face hydra-face-blue)
150 151 (face hydra-face-blue)
168 169 (face hydra-face-blue)
185 186 (face hydra-face-blue)
202 203 (face hydra-face-blue)
220 221 (face hydra-face-blue)
237 238 (face hydra-face-blue)
254 255 (face hydra-face-blue)
272 273 (face hydra-face-blue)
289 290 (face hydra-face-blue)
306 307 (face hydra-face-blue)
324 325 (face hydra-face-blue)
341 342 (face hydra-face-blue)
358 359 (face hydra-face-blue)
376 377 (face hydra-face-blue))))
#("Info-mode:
?: summary ]: forward [: backward
<: top node >: final node h: help
d: info dir f: follow ref g: goto node
l: hist back r: hist forward i: index
I: virtual index L: hist n: next
p: previous s: search S: case-search
T: TOC u: up m: menu
t: info-to "
12 13 (face hydra-face-blue)
29 30 (face hydra-face-blue)
46 47 (face hydra-face-blue)
64 65 (face hydra-face-blue)
81 82 (face hydra-face-blue)
98 99 (face hydra-face-blue)
116 117 (face hydra-face-blue)
133 134 (face hydra-face-blue)
150 151 (face hydra-face-blue)
168 169 (face hydra-face-blue)
185 186 (face hydra-face-blue)
202 203 (face hydra-face-blue)
220 221 (face hydra-face-blue)
237 238 (face hydra-face-blue)
254 255 (face hydra-face-blue)
272 273 (face hydra-face-blue)
289 290 (face hydra-face-blue)
306 307 (face hydra-face-blue)
324 325 (face hydra-face-blue)
341 342 (face hydra-face-blue)
358 359 (face hydra-face-blue)
376 377 (face hydra-face-blue)))))
(provide 'hydra-test)
;;; hydra-test.el ends here

@ -422,6 +422,14 @@ Return DEFAULT if PROP is not in H."
(defvar hydra-head-format "[%s]: "
"The formatter for each head of a plain docstring.")
(defvar hydra-key-doc-function 'hydra-key-doc-function-default
"The function for formatting key-doc pairs.")
(defun hydra-key-doc-function-default (key key-width doc doc-width)
"Doc"
(format (format "%%%ds: %%%ds" key-width (- -1 doc-width))
key doc))
(defun hydra--hint (body heads)
"Generate a hint for the echo area.
BODY, and HEADS are parameters to `defhydra'."
@ -437,16 +445,41 @@ BODY, and HEADS are parameters to `defhydra'."
(cons (cadr h)
(cons pstr (cl-caddr h)))
alist)))))
(let ((keys (nreverse (mapcar #'cdr alist))))
(mapconcat
(lambda (x)
(format
(if (> (length (cdr x)) 0)
(concat hydra-head-format (cdr x))
"%s")
(car x)))
keys
", "))))
(let ((keys (nreverse (mapcar #'cdr alist)))
(n-cols (plist-get (cddr body) :columns)))
(if n-cols
(let ((n-rows (1+ (/ (length keys) n-cols)))
(max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys)))
(max-doc-len (apply #'max (mapcar (lambda (x) (length (cdr x))) keys))))
(concat
"\n"
(mapconcat #'identity
(mapcar
(lambda (x)
(mapconcat
(lambda (y)
(and y
(funcall hydra-key-doc-function
(car y)
max-key-len
(cdr y)
max-doc-len))) x ""))
(hydra--matrix keys n-cols n-rows))
"\n")))
(concat
(mapconcat
(lambda (x)
(format
(if (> (length (cdr x)) 0)
(concat hydra-head-format (cdr x))
"%s")
(car x)))
keys
", ")
(if keys "." ""))))))
(defvar hydra-fontify-head-function nil
"Possible replacement for `hydra-fontify-head-default'.")
@ -555,7 +588,7 @@ The expressions can be auto-expanded according to NAME."
`(concat (format ,(substring docstring 1) ,@(nreverse varlist))
,rest)
`(format ,(concat docstring ": " (replace-regexp-in-string
"\\(%\\)" "\\1\\1" rest) ".")))))
"\\(%\\)" "\\1\\1" rest))))))
(defun hydra--complain (format-string &rest args)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."

Loading…
Cancel
Save