diff --git a/README.md b/README.md index 1bbeffe..70b31bf 100644 --- a/README.md +++ b/README.md @@ -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 | diff --git a/hydra-test.el b/hydra-test.el index 15fa42f..2d1b275 100644 --- a/hydra-test.el +++ b/hydra-test.el @@ -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 @@ -643,7 +642,7 @@ The body can be accessed via `hydra-vi/body'." ("q" nil "quit"))) (macroexpand '(defhydra hydra-zoom (global-map "" - :nonheads run) + :foreign-keys run) "zoom" ("g" text-scale-increase "in") ("l" text-scale-decrease "out") @@ -661,7 +660,7 @@ The body can be accessed via `hydra-vi/body'." ("q" nil "quit"))) (macroexpand '(defhydra hydra-zoom (global-map "" - :nonheads warn + :foreign-keys warn :exit t) "zoom" ("g" text-scale-increase "in") @@ -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)) @@ -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) diff --git a/hydra.el b/hydra.el index afe59b7..fdf1b9f 100644 --- a/hydra.el +++ b/hydra.el @@ -5,7 +5,7 @@ ;; Author: Oleh Krehel ;; Maintainer: Oleh Krehel ;; URL: https://github.com/abo-abo/hydra -;; Version: 0.10.0 +;; Version: 0.11.0 ;; Keywords: bindings ;; Package-Requires: ((cl-lib "0.5")) @@ -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 @@ -278,15 +279,17 @@ 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 @@ -294,28 +297,37 @@ Return DEFAULT if PROP is not in 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)))) @@ -585,17 +597,15 @@ 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) @@ -603,9 +613,10 @@ NAME, BODY and HEADS are parameters to `defhydra'." (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."