Skip to content

Commit

Permalink
Rename compat toggle - :nonheads -> :foreign-keys
Browse files Browse the repository at this point in the history 
* hydra-test.el: Add tests.

* hydra.el (hydra--head-color): Update.
(hydra--body-foreign-keys): New defun.
(hydra--body-color): Update.
(hydra--handle-nonhead): Update.

* README.md: Update.
  • Loading branch information
@abo-abo
abo-abo committed Feb 23, 2015
1 parent 54004d2 commit 989ed95
Show file tree
Hide file tree
Showing 3 changed files with 131 additions and 55 deletions.
16 changes: 8 additions & 8 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -297,13 +297,13 @@ the hint. You can still have the old behavior by setting `hydra-lv` to `nil`.
By popular demand, an alternative syntax has been implemented that translates to colors without
using them in the syntax. `:exit` can be used both in body (heads will inherit) and in heads
(possible to override body). `:exit` is nil by default, corresponding to `red` head; you don't need
to set it explicitly to nil. `:nonheads` can be used only in body and can be either nil (default),
to set it explicitly to nil. `:foreign-keys` can be used only in body and can be either nil (default),
`warn` or `run`.

| color | toggle |
|----------+------------------------|
| red | |
| blue | :exit t |
| amaranth | :nonheads warn |
| teal | :nonheads warn :exit t |
| pink | :nonheads run |
| color | toggle |
|----------+----------------------------|
| red | |
| blue | :exit t |
| amaranth | :foreign-keys warn |
| teal | :foreign-keys warn :exit t |
| pink | :foreign-keys run |
123 changes: 94 additions & 29 deletions hydra-test.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -605,31 +605,30 @@ The body can be accessed via `hydra-vi/body'."
("q" nil "cancel"))))))

(ert-deftest hydra-amaranth-compat ()
(unless (version< emacs-version "24.4")
(should
(equal
(macroexpand
'(defhydra hydra-vi
(:pre
(set-cursor-color "#e52b50")
:post
(set-cursor-color "#ffffff")
:color amaranth)
"vi"
("j" next-line)
("k" previous-line)
("q" nil "quit")))
(macroexpand
'(defhydra hydra-vi
(:pre
(set-cursor-color "#e52b50")
:post
(set-cursor-color "#ffffff")
:nonheads warn)
"vi"
("j" next-line)
("k" previous-line)
("q" nil "quit")))))))
(should
(equal
(macroexpand
'(defhydra hydra-vi
(:pre
(set-cursor-color "#e52b50")
:post
(set-cursor-color "#ffffff")
:color amaranth)
"vi"
("j" next-line)
("k" previous-line)
("q" nil "quit")))
(macroexpand
'(defhydra hydra-vi
(:pre
(set-cursor-color "#e52b50")
:post
(set-cursor-color "#ffffff")
:foreign-keys warn)
"vi"
("j" next-line)
("k" previous-line)
("q" nil "quit"))))))

(ert-deftest hydra-pink-compat ()
(should
Expand All @@ -643,7 +642,7 @@ The body can be accessed via `hydra-vi/body'."
("q" nil "quit")))
(macroexpand
'(defhydra hydra-zoom (global-map "<f2>"
:nonheads run)
:foreign-keys run)
"zoom"
("g" text-scale-increase "in")
("l" text-scale-decrease "out")
Expand All @@ -661,7 +660,7 @@ The body can be accessed via `hydra-vi/body'."
("q" nil "quit")))
(macroexpand
'(defhydra hydra-zoom (global-map "<f2>"
:nonheads warn
:foreign-keys warn
:exit t)
"zoom"
("g" text-scale-increase "in")
Expand Down Expand Up @@ -706,7 +705,7 @@ _f_ auto-fill-mode: %`auto-fill-function
(buffer-narrowed-p)))
"[[q]]: cancel"))))

(ert-deftest hydra-compat-colors ()
(ert-deftest hydra-compat-colors-1 ()
(should (equal (hydra--head-color
'("e" (message "Exiting now") "blue")
'(nil nil :color blue))
Expand All @@ -722,7 +721,73 @@ _f_ auto-fill-mode: %`auto-fill-function
(should (equal (hydra--head-color
'("c" (message "Continuing") "red" :exit nil)
'(nil nil :exit t))
'red)))
'red))
(equal (hydra--head-color
'("a" abbrev-mode nil)
'(nil nil :color teal))
'teal)
(equal (hydra--head-color
'("a" abbrev-mode :exit nil)
'(nil nil :color teal))
'amaranth)
)

(ert-deftest hydra-compat-colors-2 ()
(equal
(macroexpand
'(defhydra hydra-test (:color amaranth)
("a" fun-a)
("b" fun-b :color blue)
("c" fun-c :color blue)
("d" fun-d :color blue)
("e" fun-e :color blue)
("f" fun-f :color blue)))
(macroexpand
'(defhydra hydra-test (:color teal)
("a" fun-a :color red)
("b" fun-b)
("c" fun-c)
("d" fun-d)
("e" fun-e)
("f" fun-f)))))

(ert-deftest hydra-compat-colors-3 ()
(equal
(macroexpand
'(defhydra hydra-test ()
("a" fun-a)
("b" fun-b :color blue)
("c" fun-c :color blue)
("d" fun-d :color blue)
("e" fun-e :color blue)
("f" fun-f :color blue)))
(macroexpand
'(defhydra hydra-test (:color blue)
("a" fun-a :color red)
("b" fun-b)
("c" fun-c)
("d" fun-d)
("e" fun-e)
("f" fun-f)))))

(ert-deftest hydra-compat-colors-4 ()
(equal
(macroexpand
'(defhydra hydra-test ()
("a" fun-a)
("b" fun-b :exit t)
("c" fun-c :exit t)
("d" fun-d :exit t)
("e" fun-e :exit t)
("f" fun-f :exit t)))
(macroexpand
'(defhydra hydra-test (:exit t)
("a" fun-a :exit nil)
("b" fun-b)
("c" fun-c)
("d" fun-d)
("e" fun-e)
("f" fun-f)))))

(provide 'hydra-test)

Expand Down
47 changes: 29 additions & 18 deletions hydra.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/hydra
;; Version: 0.10.0
;; Version: 0.11.0
;; Keywords: bindings
;; Package-Requires: ((cl-lib "0.5"))

Expand Down Expand Up @@ -267,6 +267,7 @@ Return DEFAULT if PROP is not in H."
"Return the color of a Hydra head H with BODY."
(let* ((exit (hydra--head-property h :exit 'default))
(color (hydra--head-property h :color))
(foreign-keys (hydra--body-foreign-keys body))
(head-color
(cond ((eq exit 'default)
(cl-case color
Expand All @@ -278,44 +279,55 @@ Return DEFAULT if PROP is not in H."
((null exit)
(if color
(error "Don't mix :color and :exit - they are aliases: %S" h)
'red))
(cl-case foreign-keys
(run 'pink)
(warn 'amaranth)
(t 'red))))
((eq exit t)
(if color
(error "Don't mix :color and :exit - they are aliases: %S" h)
'blue))
(t
(error "Unknown :exit %S" exit)))))
(let ((nonheads (plist-get (cddr body) :nonheads))
(body-exit (plist-get (cddr body) :exit)))
(let ((body-exit (plist-get (cddr body) :exit)))
(cond ((null (cadr h))
(when head-color
(hydra--complain
"Doubly specified blue head - nil cmd is already blue: %S" h))
'blue)
((null head-color)
(hydra--body-color body))
((null nonheads)
((null foreign-keys)
head-color)
((eq nonheads 'run)
((eq foreign-keys 'run)
(if (eq head-color 'red)
'pink
'blue))
((eq nonheads 'warn)
(if (eq head-color 'red)
((eq foreign-keys 'warn)
(if (memq head-color '(red amaranth))
'amaranth
'teal))
(t
(error "Unexpected %S %S" h body))))))

(defun hydra--body-foreign-keys (body)
"Return what BODY does with a non-head binding."
(or
(plist-get (cddr body) :foreign-keys)
(let ((color (plist-get (cddr body) :color)))
(cl-case color
((amaranth teal) 'warn)
(pink 'run)))))

(defun hydra--body-color (body)
"Return the color of BODY.
BODY is the second argument to `defhydra'"
(let ((color (plist-get (cddr body) :color))
(exit (plist-get (cddr body) :exit))
(nonheads (plist-get (cddr body) :nonheads)))
(cond ((eq nonheads 'warn)
(foreign-keys (plist-get (cddr body) :foreign-keys)))
(cond ((eq foreign-keys 'warn)
(if exit 'teal 'amaranth))
((eq nonheads 'run) 'pink)
((eq foreign-keys 'run) 'pink)
(exit 'blue)
(color color)
(t 'red))))
Expand Down Expand Up @@ -585,27 +597,26 @@ NAME, BODY and HEADS are parameters to `defhydra'."
(define-key keymap hydra-keyboard-quit #'hydra-keyboard-quit))
(when (memq body-color '(amaranth pink teal))
(if (cl-some `(lambda (h)
(eq (hydra--head-color h body) 'blue))
(memq (hydra--head-color h body) '(blue teal)))
heads)
(progn
(define-key keymap [t]
`(lambda ()
(interactive)
,(cond
((eq body-color 'amaranth)
((memq body-color '(amaranth teal))
'(message "An amaranth Hydra can only exit through a blue head"))
((eq body-color 'teal)
'(message "A teal Hydra can only exit through a blue head"))
(t
'(hydra-pink-fallback)))
(hydra-set-transient-map hydra-curr-map t)
(when hydra-is-helpful
(unless hydra-lv
(sit-for 0.8))
(,(intern (format "%S/hint" name)))))))
(error
"An %S Hydra must have at least one blue head in order to exit"
body-color)))))
(unless (eq body-color 'teal)
(error
"An %S Hydra must have at least one blue head in order to exit"
body-color))))))

(defun hydra--head-name (h body-name)
"Return the symbol for head H of body BODY-NAME."
Expand Down

0 comments on commit 989ed95

Please sign in to comment.