From 1e423933a9834509b21ab2e766e6f01886b44d20 Mon Sep 17 00:00:00 2001 From: Oleh Krehel Date: Tue, 12 Feb 2019 12:40:48 +0100 Subject: [PATCH] hydra.el: sexp hints are now supported for :columns * hydra-test.el: Old tests have one less layer of '(concat ...) around the docstring. (hydra-format-10): Add test. Fixes #304 Fixes #311 --- hydra-test.el | 105 ++++++++++++++++++++++++++++---------------------- hydra.el | 96 +++++++++++++++++++++++++-------------------- 2 files changed, 115 insertions(+), 86 deletions(-) diff --git a/hydra-test.el b/hydra-test.el index 2fb98a0..048f37f 100644 --- a/hydra-test.el +++ b/hydra-test.el @@ -1097,10 +1097,14 @@ _f_ auto-fill-mode: %`auto-fill-function ("t" toggle-truncate-lines nil) ("w" whitespace-mode nil) ("q" nil "quit")))) - '(concat (format "%s abbrev-mode: %S + '(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.")))) +[{q}]: quit." + "{a}" abbrev-mode + "{d}" debug-on-error + "{f}" auto-fill-function)))) (ert-deftest hydra-format-2 () (should (equal @@ -1112,7 +1116,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].")))) + '(format " bar %s\n{a}, [q]." foo)))) (ert-deftest hydra-format-3 () (should (equal @@ -1123,7 +1127,7 @@ _f_ auto-fill-mode: %`auto-fill-function nil "\n__ ^^ace jump\n" '(("" ace-jump-char-mode nil :cmd-name bar/ace-jump-char-mode)))) - '(concat (format "%s ace jump\n" "{}") "")))) + '(format "%s ace jump\n" "{}")))) (ert-deftest hydra-format-4 () (should @@ -1132,9 +1136,9 @@ _f_ auto-fill-mode: %`auto-fill-function '(nil nil :hint nil) "\n_j_,_k_" '(("j" nil nil :exit t) ("k" nil nil :exit t))) - '(concat (format "%s,%s" - #("j" 0 1 (face hydra-face-blue)) - #("k" 0 1 (face hydra-face-blue))) "")))) + '(format "%s,%s" + #("j" 0 1 (face hydra-face-blue)) + #("k" 0 1 (face hydra-face-blue)))))) (ert-deftest hydra-format-5 () (should @@ -1142,12 +1146,10 @@ _f_ auto-fill-mode: %`auto-fill-function nil nil "\n_-_: mark _u_: unmark\n" '(("-" Buffer-menu-mark nil) ("u" Buffer-menu-unmark nil))) - '(concat - (format - "%s: mark %s: unmark\n" - #("-" 0 1 (face hydra-face-red)) - #("u" 0 1 (face hydra-face-red))) - "")))) + '(format + "%s: mark %s: unmark\n" + #("-" 0 1 (face hydra-face-red)) + #("u" 0 1 (face hydra-face-red)))))) (ert-deftest hydra-format-6 () (should @@ -1155,16 +1157,14 @@ _f_ auto-fill-mode: %`auto-fill-function nil nil "\n[_]_] forward [_[_] backward\n" '(("]" forward-char nil) ("[" backward-char nil))) - '(concat - (format - "[%s] forward [%s] backward\n" - #("]" - 0 1 (face - hydra-face-red)) - #("[" - 0 1 (face - hydra-face-red))) - "")))) + '(format + "[%s] forward [%s] backward\n" + #("]" + 0 1 (face + hydra-face-red)) + #("[" + 0 1 (face + hydra-face-red)))))) (ert-deftest hydra-format-7 () (should @@ -1183,12 +1183,10 @@ _f_ auto-fill-mode: %`auto-fill-function (equal (hydra--format nil nil "\n_%_ forward\n" '(("%" forward-char nil :exit nil))) - '(concat - (format - "%s forward\n" - #("%%" - 0 2 (face hydra-face-red))) - "")))) + '(format + "%s forward\n" + #("%%" + 0 2 (face hydra-face-red)))))) (ert-deftest hydra-format-8 () (should @@ -1205,11 +1203,28 @@ _f_ auto-fill-mode: %`auto-fill-function (equal (hydra--format nil '(nil nil :hint nil) "\n_f_(foo)" '(("f" forward-char nil :exit nil))) + '(format + "%s(foo)" + #("f" 0 1 (face hydra-face-red)))))) + +(ert-deftest hydra-format-10 () + (should + (equal + (hydra--format nil '(nil nil) "Test:" + '(("j" next-line (format-time-string "%H:%M:%S" (current-time)) + :exit nil))) '(concat - (format - "%s(foo)" - #("f" 0 1 (face hydra-face-red))) - "")))) + (format "Test:\n") + (mapconcat + (function + hydra--eval-and-format) + (quote + ((#("j" 0 1 (face hydra-face-red)) + format-time-string + "%H:%M:%S" + (current-time)))) + ", ") + ".")))) (ert-deftest hydra-format-with-sexp-1 () (should (equal @@ -1219,12 +1234,12 @@ _f_ auto-fill-mode: %`auto-fill-function 'hydra-toggle nil "\n_n_ narrow-or-widen-dwim %(progn (message \"checking\")(buffer-narrowed-p))asdf\n" '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t)))) - '(concat (format "%s narrow-or-widen-dwim %Sasdf\n" - "{n}" - (progn - (message "checking") - (buffer-narrowed-p))) - "[[q]]: cancel.")))) + '(format + "%s narrow-or-widen-dwim %Sasdf\n[[q]]: cancel." + "{n}" + (progn + (message "checking") + (buffer-narrowed-p)))))) (ert-deftest hydra-format-with-sexp-2 () (should (equal @@ -1234,12 +1249,12 @@ _f_ auto-fill-mode: %`auto-fill-function 'hydra-toggle nil "\n_n_ narrow-or-widen-dwim %s(progn (message \"checking\")(buffer-narrowed-p))asdf\n" '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t)))) - '(concat (format "%s narrow-or-widen-dwim %sasdf\n" - "{n}" - (progn - (message "checking") - (buffer-narrowed-p))) - "[[q]]: cancel.")))) + '(format + "%s narrow-or-widen-dwim %sasdf\n[[q]]: cancel." + "{n}" + (progn + (message "checking") + (buffer-narrowed-p)))))) (ert-deftest hydra-compat-colors-2 () (should diff --git a/hydra.el b/hydra.el index 3bfda15..1ccb483 100644 --- a/hydra.el +++ b/hydra.el @@ -508,6 +508,14 @@ Remove :color key. And sort the plist alphabetically." x (eval x))) +(defun hydra--eval-and-format (x) + (let ((str (hydra--to-string (cdr x)))) + (format + (if (> (length str) 0) + (concat hydra-head-format str) + "%s") + (car x)))) + (defun hydra--hint-heads-wocol (body heads) "Generate a hint for the echo area. BODY, and HEADS are parameters to `defhydra'. @@ -516,14 +524,13 @@ Works for heads without a property :column." (dolist (h heads) (let ((val (assoc (cadr h) alist)) (pstr (hydra-fontify-head h body))) - (unless (not (stringp (cl-caddr h))) - (if val - (setf (cadr val) - (concat (cadr val) " " pstr)) - (push - (cons (cadr h) - (cons pstr (cl-caddr h))) - alist))))) + (if val + (setf (cadr val) + (concat (cadr val) " " pstr)) + (push + (cons (cadr h) + (cons pstr (cl-caddr h))) + alist)))) (let ((keys (nreverse (mapcar #'cdr alist))) (n-cols (plist-get (cddr body) :columns)) res) @@ -552,13 +559,7 @@ Works for heads without a property :column." `(concat (mapconcat - (lambda (x) - (let ((str (hydra--to-string (cdr x)))) - (format - (if (> (length str) 0) - (concat hydra-head-format str) - "%s") - (car x)))) + #'hydra--eval-and-format ',keys ", ") ,(if keys "." "")))) @@ -572,11 +573,17 @@ Works for heads without a property :column." BODY, and HEADS are parameters to `defhydra'." (let* ((sorted-heads (hydra--sort-heads (hydra--normalize-heads heads))) (heads-w-col (cl-remove-if-not (lambda (heads) (hydra--head-property (nth 0 heads) :column)) sorted-heads)) - (heads-wo-col (cl-remove-if (lambda (heads) (hydra--head-property (nth 0 heads) :column)) sorted-heads))) - (concat (when heads-w-col - (hydra--hint-from-matrix body (hydra--generate-matrix heads-w-col))) - (when heads-wo-col - (hydra--hint-heads-wocol body (car heads-wo-col)))))) + (heads-wo-col (cl-remove-if (lambda (heads) (hydra--head-property (nth 0 heads) :column)) sorted-heads)) + (hint-w-col (when heads-w-col + (hydra--hint-from-matrix body (hydra--generate-matrix heads-w-col)))) + (hint-wo-col (when heads-wo-col + (hydra--hint-heads-wocol body (car heads-wo-col))))) + (if (or (stringp hint-wo-col) (null hint-wo-col)) + (concat hint-w-col hint-wo-col) + (cl-assert (or (eq (car hint-wo-col) 'concat))) + (if hint-w-col + `(concat ,hint-w-col ,@(cdr hint-wo-col)) + hint-wo-col)))) (defvar hydra-fontify-head-function nil "Possible replacement for `hydra-fontify-head-default'.") @@ -730,27 +737,34 @@ The expressions can be auto-expanded according to NAME." (substring docstring 0 start) "%" spec (substring docstring (+ start offset 1 lspec varp)))))))) - (cond - ((string= docstring "") - rest) - ((eq ?\n (aref docstring 0)) - `(concat (format ,(substring docstring 1) ,@(nreverse varlist)) - ,rest)) - (t - (let ((r `(replace-regexp-in-string - " +$" "" - (concat ,docstring - ,(cond ((string-match-p "\\`\n" rest) - ":") - ((string-match-p "\n" rest) - ":\n") - (t - ": ")) - (replace-regexp-in-string - "\\(%\\)" "\\1\\1" ,rest))))) - (if (stringp rest) - `(format ,(eval r)) - `(format ,r)))))))) + (hydra--format-1 docstring rest varlist)))) + +(defun hydra--format-1 (docstring rest varlist) + (cond + ((string= docstring "") + rest) + ((listp rest) + (unless (or (string-match-p "\n\\'" docstring) + (equal (cadr rest) "\n")) + (setq docstring (concat docstring "\n"))) + `(concat (format ,docstring ,@(nreverse varlist)) ,@(cdr rest))) + ((eq ?\n (aref docstring 0)) + `(format ,(concat (substring docstring 1) rest) ,@(nreverse varlist))) + (t + (let ((r `(replace-regexp-in-string + " +$" "" + (concat ,docstring + ,(cond ((string-match-p "\\`\n" rest) + ":") + ((string-match-p "\n" rest) + ":\n") + (t + ": ")) + (replace-regexp-in-string + "\\(%\\)" "\\1\\1" ,rest))))) + (if (stringp rest) + `(format ,(eval r)) + `(format ,r)))))) (defun hydra--complain (format-string &rest args) "Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."