[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 5242aad 48/72: Fix :exit t / :exit nil inheritance issue
From: |
Oleh Krehel |
Subject: |
[elpa] master 5242aad 48/72: Fix :exit t / :exit nil inheritance issue |
Date: |
Fri, 06 Mar 2015 13:04:18 +0000 |
branch: master
commit 5242aad74913d5040954f1bfca0859fa02528175
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
Fix :exit t / :exit nil inheritance issue
* hydra-test.el (hydra-compat-colors): Add test.
* hydra.el (hydra--aggregate-color): New defun.
(hydra--head-color): Update.
Fixes #46.
---
hydra-test.el | 18 +++++++++++++
hydra.el | 78 +++++++++++++++++++++++++++++++++++++++++++-------------
2 files changed, 78 insertions(+), 18 deletions(-)
diff --git a/hydra-test.el b/hydra-test.el
index 2a6b579..8386847 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -711,6 +711,24 @@ _f_ auto-fill-mode: %`auto-fill-function
(buffer-narrowed-p)))
"[[q]]: cancel"))))
+(ert-deftest hydra-compat-colors ()
+ (should (equal (hydra--head-color
+ '("e" (message "Exiting now") "blue")
+ '(nil nil :color blue))
+ 'blue))
+ (should (equal (hydra--head-color
+ '("c" (message "Continuing") "red" :color red)
+ '(nil nil :color blue))
+ 'red))
+ (should (equal (hydra--head-color
+ '("e" (message "Exiting now") "blue")
+ '(nil nil :exit t))
+ 'blue))
+ (should (equal (hydra--head-color
+ '("c" (message "Continuing") "red" :exit nil)
+ '(nil nil :exit t))
+ 'red)))
+
(provide 'hydra-test)
;;; hydra-test.el ends here
diff --git a/hydra.el b/hydra.el
index 7658c76..1708fe7 100644
--- a/hydra.el
+++ b/hydra.el
@@ -239,26 +239,68 @@ Return DEFAULT if PROP is not in H."
(plist-get plist prop)
default)))
+(defun hydra--aggregate-color (head-color body-color)
+ "Return the resulting head color for HEAD-COLOR and BODY-COLOR."
+ (cond ((eq head-color 'red)
+ (cl-case body-color
+ (red 'red)
+ (blue 'red)
+ (amaranth 'amaranth)
+ (pink 'pink)
+ (cyan 'amaranth)))
+ ((eq head-color 'blue)
+ (cl-case body-color
+ (red 'blue)
+ (blue 'blue)
+ (amaranth 'teal)
+ (pink 'blue)
+ (cyan 'teal)))
+ (t
+ (error "Can't aggregate head %S to body %S"
+ head-color body-color))))
+
(defun hydra--head-color (h body)
"Return the color of a Hydra head H with BODY."
- (let ((color (hydra--head-property h :color))
- (exit (or (plist-get (cddr body) :exit)
- (hydra--head-property h :exit 'default)))
- (nonheads (plist-get (cddr body) :nonheads)))
- (cond ((null (cadr h))
- 'blue)
- ((eq exit t)
- 'blue)
- ((eq nonheads 'run)
- 'pink)
- ((eq nonheads 'warn)
- (if (eq exit t)
- 'teal
- 'amaranth))
- ((null color)
- (hydra--body-color body))
- (t
- color))))
+ (let* ((exit (hydra--head-property h :exit 'default))
+ (color (hydra--head-property h :color))
+ (head-color
+ (cond ((eq exit 'default)
+ (cl-case color
+ (blue 'blue)
+ (red 'red)
+ (t
+ (unless (null color)
+ (error "Use only :blue or :red for heads: %S" h)))))
+ ((null exit)
+ (if color
+ (error "Don't mix :color and :exit - they are aliases:
%S" h)
+ '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)))
+ (cond ((null (cadr h))
+ (if head-color
+ (error "Extra properties for head with nil body: %S" h)
+ 'blue))
+ ((null head-color)
+ (hydra--body-color body))
+ ((null nonheads)
+ head-color)
+ ((eq nonheads 'run)
+ (if (eq head-color 'red)
+ 'pink
+ 'blue))
+ ((eq nonheads 'warn)
+ (if (eq head-color 'red)
+ 'amaranth
+ 'teal))
+ (t
+ (error "Unexpected %S %S" h body))))))
(defun hydra--body-color (body)
"Return the color of BODY.
- [elpa] master a6c6a55 38/72: Improve compatibility for Emacs <= 24.3, (continued)
- [elpa] master a6c6a55 38/72: Improve compatibility for Emacs <= 24.3, Oleh Krehel, 2015/03/06
- [elpa] master 2c01db0 42/72: hydra.el (hydra--handle-nonhead): Update signature, Oleh Krehel, 2015/03/06
- [elpa] master a71b76e 35/72: Intercept quit signals, Oleh Krehel, 2015/03/06
- [elpa] master ae70e9a 41/72: Fix pink and teal Hydras running :post, Oleh Krehel, 2015/03/06
- [elpa] master 71d70f6 46/72: Add :body-pre switch, Oleh Krehel, 2015/03/06
- [elpa] master cb28124 44/72: Allow sexps in Ruby-style docstrings, Oleh Krehel, 2015/03/06
- [elpa] master ace99b3 51/72: hydra.el (hydra--make-defun): Update signature, Oleh Krehel, 2015/03/06
- [elpa] master efcffc0 45/72: hydra-examples.el: Add example 9, Oleh Krehel, 2015/03/06
- [elpa] master ef1f61d 40/72: hydra.el (hydra--handle-nonhead): Fix bug, Oleh Krehel, 2015/03/06
- [elpa] master 2eddb83 43/72: hydra-test.el (hydra-format): New test, Oleh Krehel, 2015/03/06
- [elpa] master 5242aad 48/72: Fix :exit t / :exit nil inheritance issue,
Oleh Krehel <=
- [elpa] master 0f733d8 37/72: Add an option to fontify heads in a custom way, Oleh Krehel, 2015/03/06
- [elpa] master c413b5f 54/72: Allow for a custom key format spec in docstrings, Oleh Krehel, 2015/03/06
- [elpa] master 54004d2 52/72: hydra.el (hydra-verbose): New defcustom, Oleh Krehel, 2015/03/06
- [elpa] master 0d9c95e 47/72: Update README.md, Oleh Krehel, 2015/03/06
- [elpa] master 3c06695 56/72: Amend the key regex in docstring to include <>, Oleh Krehel, 2015/03/06
- [elpa] master e567bd6 59/72: lv.el (lv-window): set-window-parameter 'no-other-window, Oleh Krehel, 2015/03/06
- [elpa] master eb1e0fc 58/72: Don't bind nil heads in outside keymaps, Oleh Krehel, 2015/03/06
- [elpa] master 41ec124 50/72: Avoid generating multiple defuns with same name, Oleh Krehel, 2015/03/06
- [elpa] master db0415e 49/72: hydra.el (hydra-keyboard-quit): Add, Oleh Krehel, 2015/03/06
- [elpa] master 55682e7 57/72: Improve handling of heads with duplicate cmd, Oleh Krehel, 2015/03/06