wilderjds
/
hydra
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

hydra.el: sexp hints are now supported for :columns

Browse Source 
* hydra-test.el: Old tests have one less layer of '(concat ...) around
  the docstring.
(hydra-format-10): Add test.

Fixes #304
Fixes #311
master
Oleh Krehel 7 years ago
parent 67e454bf10
commit 1e423933a9
2 changed files with 115 additions and 86 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 105
      hydra-test.el
  2. 96
      hydra.el

105
hydra-test.el
Unescape View File

@ -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_<SPC>_ ^^ace jump\n"
'(("<SPC>" ace-jump-char-mode nil :cmd-name bar/ace-jump-char-mode))))
'(concat (format "%s ace jump\n" "{<SPC>}") ""))))
'(format "%s ace jump\n" "{<SPC>}"))))
(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

96
hydra.el
Unescape View File

@ -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."

Write Preview
Loading…
Cancel
Save