branch: master commit 0a3cc60f5856eb4a38204b9075d67d058ba56bef Author: Oleh Krehel <ohwoeo...@gmail.com> Commit: Oleh Krehel <ohwoeo...@gmail.com>
Add compat color-less syntax * hydra.el (hydra--head-color): Adapt compat switches. (hydra--body-color): Adapt compat switches. (hydra--handle-nonhead): Move verbatim from `defhydra'. (defhydra): Move verbatim to `hydra--handle-nonhead'. * README.md: Update with two tables. * hydra-test.el: Add compat tests. New compat switches are: - ":exit t" for ":color blue" - ":nonheads warn" for ":color amaranth" - ":nonheads warn :exit t" for ":color teal" - ":nonheads run" for ":color pink" See the compat tests to get the intuition of how both ways translate between each other. Fixes #27. --- README.md | 31 +++++++++++++++++ hydra-test.el | 82 +++++++++++++++++++++++++++++++++++++++++++++ hydra.el | 104 +++++++++++++++++++++++++++++++++++---------------------- 3 files changed, 177 insertions(+), 40 deletions(-) diff --git a/README.md b/README.md index 960684a..dbe8abb 100644 --- a/README.md +++ b/README.md @@ -277,3 +277,34 @@ Since version `0.10.0`, setting `hydra-lv` to `t` (the default setting) will mak window right above the Echo Area for hints. This has the advantage that you can immediately see any `message` output from the functions that you call, since Hydra no longer uses `message` to display the hint. You can still have the old behavior by setting `hydra-lv` to `nil`. + +## Color table + + +Body | Head | Executing NON-HEADS | Executing HEADS +Color | Inherited | | + | Color | | +---------|-----------|-----------------------|----------------- +amaranth | red | Disallow and Continue | Continue +teal | blue | Disallow and Continue | Quit +pink | red | Allow and Continue | Continue +red | red | Allow and Quit | Continue +blue | blue | Allow and Quit | Quit + +## Color to toggle correspondence + +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), +`warn` or `run`. + +| color | toggle | +|----------+------------------------| +| red | | +| blue | :exit t | +| amaranth | :nonheads warn | +| teal | :nonheads warn :exit t | +| pink | :nonheads run | + + diff --git a/hydra-test.el b/hydra-test.el index 96f02da..31519dc 100644 --- a/hydra-test.el +++ b/hydra-test.el @@ -591,6 +591,88 @@ The body can be accessed via `hydra-vi/body'." (setq hydra-test/num 0) (setq hydra-test/str "foo")))))) +(ert-deftest hydra-blue-compat () + (should + (equal + (macroexpand + '(defhydra hydra-toggle (:color blue) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel"))) + (macroexpand + '(defhydra hydra-toggle (:exit t) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("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"))))))) + +(ert-deftest hydra-pink-compat () + (should + (equal + (macroexpand + '(defhydra hydra-zoom (global-map "<f2>" + :color pink) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-zoom (global-map "<f2>" + :nonheads run) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit")))))) + +(ert-deftest hydra-teal-compat () + (should + (equal + (macroexpand + '(defhydra hydra-zoom (global-map "<f2>" + :color teal) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-zoom (global-map "<f2>" + :nonheads warn + :exit t) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit")))))) + (provide 'hydra-test) ;;; hydra-test.el ends here diff --git a/hydra.el b/hydra.el index a3024c4..67fe34c 100644 --- a/hydra.el +++ b/hydra.el @@ -225,18 +225,37 @@ Return DEFAULT if PROP is not in H." (defun hydra--head-color (h body-color) "Return the color of a Hydra head H with BODY-COLOR." - (let ((col (hydra--head-property h :color))) + (let ((color (hydra--head-property h :color)) + (exit (hydra--head-property h :exit 'default)) + (nonheads (plist-get (cddr body) :nonheads))) (cond ((null (cadr h)) 'blue) - ((null col) + ((eq exit t) + 'blue) + ((null exit) + (cond ((eq nonheads 'warn) + 'amaranth) + ((eq nonheads 'run) + 'pink) + (t + 'red))) + ((null color) body-color) (t - col)))) + color)))) (defun hydra--body-color (body) "Return the color of BODY. BODY is the second argument to `defhydra'" - (or (plist-get (cddr body) :color) 'red)) + (let ((color (plist-get (cddr body) :color)) + (exit (plist-get (cddr body) :exit)) + (nonheads (plist-get (cddr body) :nonheads))) + (cond ((eq nonheads 'warn) + (if exit 'teal 'amaranth)) + ((eq nonheads 'run) 'pink) + (exit 'blue) + (color color) + (t 'red)))) (defun hydra--face (h body-color) "Return the face for a Hydra head H with BODY-COLOR." @@ -418,6 +437,46 @@ BODY-COLOR, BODY-PRE, BODY-POST, and OTHER-POST are used as well." (message "Pink Hydra can't currently handle prefixes, continuing")) (message "Pink Hydra could not resolve: %S" keys)))) +(defun hydra--handle-nonhead (body heads keymap hint-name) + (let ((body-color (hydra--body-color body)) + (body-post (plist-get (cddr body) :post))) + (when (memq body-color '(amaranth pink teal)) + (if (cl-some `(lambda (h) + (eq (hydra--head-color h ',body-color) 'blue)) + heads) + (progn + ;; (when (cl-some `(lambda (h) + ;; (eq (hydra--head-color h ',body-color) 'red)) + ;; heads) + ;; (warn + ;; "%S body color: upgrading all red heads to %S" + ;; body-color body-color)) + (define-key keymap [t] + `(lambda () + (interactive) + ,(cond + ((eq body-color 'amaranth) + '(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)) + (,hint-name))))) + (error + "An %S Hydra must have at least one blue head in order to exit" + body-color)) + (when hydra-keyboard-quit + (define-key keymap hydra-keyboard-quit + `(lambda () + (interactive) + (hydra-disable) + (hydra-cleanup) + ,body-post)))))) + ;;* Macros ;;** defhydra ;;;###autoload @@ -503,42 +562,7 @@ result of `defhydra'." (setq body-pre `(funcall #',body-pre))) (when (and body-post (symbolp body-post)) (setq body-post `(funcall #',body-post))) - (when (memq body-color '(amaranth pink teal)) - (if (cl-some `(lambda (h) - (eq (hydra--head-color h ',body-color) 'blue)) - heads) - (progn - (when (cl-some `(lambda (h) - (eq (hydra--head-color h ',body-color) 'red)) - heads) - (warn - "%S body color: upgrading all red heads to %S" - body-color body-color)) - (define-key keymap [t] - `(lambda () - (interactive) - ,@(cond - ((eq body-color 'amaranth) - '((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)) - (,hint-name))))) - (error - "An %S Hydra must have at least one blue head in order to exit" - body-color)) - (when hydra-keyboard-quit - (define-key keymap hydra-keyboard-quit - `(lambda () - (interactive) - (hydra-disable) - (hydra-cleanup) - ,body-post)))) + (hydra--handle-nonhead body heads keymap hint-name) `(progn ,@(cl-mapcar (lambda (head name)