From 336602f30866dc585d3950068abb2b5057fce9b2 Mon Sep 17 00:00:00 2001 From: Oleh Krehel Date: Mon, 20 Jul 2015 13:34:21 +0200 Subject: [PATCH] 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 --- hydra-test.el | 103 ++++++++++++++++++++++++++++++++++++++++++++++++-- hydra.el | 55 +++++++++++++++++++++------ 2 files changed, 143 insertions(+), 15 deletions(-) diff --git a/hydra-test.el b/hydra-test.el index d20e353..8dac9f7 100644 --- a/hydra-test.el +++ b/hydra-test.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 diff --git a/hydra.el b/hydra.el index f5a36bb..cf11d43 100644 --- a/hydra.el +++ b/hydra.el @@ -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."