Rename compat toggle - :nonheads -> :foreign-keys

* 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.

Author: abo-abo

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          |

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 "<f2>"
-                            :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 "<f2>"
-                            :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)
 

hydra.el

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