[elpa] master d71386b 29/45: hydra.el (hydra--head-color): Simplify

[Oleh Krehel]

branch: master
commit d71386b0f58929c7bc35374bc25b6b8e967acef9
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    hydra.el (hydra--head-color): Simplify
    
    * hydra.el (hydra-face-red):
    (hydra-face-blue):
    (hydra-face-amaranth):
    (hydra-face-pink):
    (hydra-face-teal): Improve docstrings.
    (hydra--head-color): Simplify.
    (defhydra): Use copy-sequence on inherited heads. Move :cmd-name setting
    to the very end, when :exit is already set.
    
    * hydra-test.el: Update tests.
---
 hydra-test.el |   22 +++++--------
 hydra.el      |   93 +++++++++++++++++---------------------------------------
 2 files changed, 37 insertions(+), 78 deletions(-)

diff --git a/hydra-test.el b/hydra-test.el
index 23616ee..635a53f 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -450,7 +450,7 @@ The body can be accessed via `hydra-toggle/body'."
           previous-line
           ""
           :exit nil)
-         ("q" nil "quit" :exit nil))))
+         ("q" nil "quit" :exit t))))
       (defun hydra-vi/next-line nil
         "Create a hydra with no body and the heads:
 
@@ -534,7 +534,7 @@ Call the head: `nil'."
          #("vi: j, k, [q]: quit."
            4 5 (face hydra-face-amaranth)
            7 8 (face hydra-face-amaranth)
-           11 12 (face hydra-face-blue)))))
+           11 12 (face hydra-face-teal)))))
       (defun hydra-vi/body nil
         "Create a hydra with no body and the heads:
 
@@ -963,7 +963,7 @@ _f_ auto-fill-mode:    %`auto-fill-function
            '(concat (format "%s abbrev-mode:       %S
 %s debug-on-error:    %S
 %s auto-fill-mode:    %S
-" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[[q]]: 
quit"))))
+" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[{q}]: 
quit"))))
 
 (ert-deftest hydra-format-2 ()
   (should (equal
@@ -973,8 +973,8 @@ _f_ auto-fill-mode:    %`auto-fill-function
               'bar
               nil
               "\n  bar %s`foo\n"
-              '(("a" (quote t) "" :cmd-name bar/lambda-a)
-                ("q" nil "" :cmd-name bar/nil))))
+              '(("a" (quote t) "" :cmd-name bar/lambda-a :exit nil)
+                ("q" nil "" :cmd-name bar/nil :exit t))))
            '(concat (format "  bar %s\n" foo) "{a}, [q]"))))
 
 (ert-deftest hydra-format-3 ()
@@ -1006,7 +1006,7 @@ _f_ auto-fill-mode:    %`auto-fill-function
              (hydra--format
               'hydra-toggle nil
               "\n_n_ narrow-or-widen-dwim %(progn (message 
\"checking\")(buffer-narrowed-p))asdf\n"
-              '(("n" narrow-to-region nil) ("q" nil "cancel"))))
+              '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
            '(concat (format "%s narrow-or-widen-dwim %Sasdf\n"
                      "{n}"
                      (progn
@@ -1021,7 +1021,7 @@ _f_ auto-fill-mode:    %`auto-fill-function
              (hydra--format
               'hydra-toggle nil
               "\n_n_ narrow-or-widen-dwim %s(progn (message 
\"checking\")(buffer-narrowed-p))asdf\n"
-              '(("n" narrow-to-region nil) ("q" nil "cancel"))))
+              '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
            '(concat (format "%s narrow-or-widen-dwim %sasdf\n"
                      "{n}"
                      (progn
@@ -1031,7 +1031,7 @@ _f_ auto-fill-mode:    %`auto-fill-function
 
 (ert-deftest hydra-compat-colors-1 ()
   (should (equal (hydra--head-color
-                  '("e" (message "Exiting now") "blue")
+                  '("e" (message "Exiting now") "blue" :exit t)
                   '(nil nil :color blue))
                  'blue))
   (should (equal (hydra--head-color
@@ -1039,10 +1039,6 @@ _f_ auto-fill-mode:    %`auto-fill-function
                   '(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
                   '("j" next-line "" :exit t)
                   '(nil nil))
                  'blue))
@@ -1051,7 +1047,7 @@ _f_ auto-fill-mode:    %`auto-fill-function
                   '(nil nil :exit t))
                  'red))
   (equal (hydra--head-color
-          '("a" abbrev-mode nil)
+          '("a" abbrev-mode nil :exit t)
           '(nil nil :color teal))
          'teal)
   (equal (hydra--head-color
diff --git a/hydra.el b/hydra.el
index 15ef310..61d4d4a 100644
--- a/hydra.el
+++ b/hydra.el
@@ -178,27 +178,29 @@ When nil, you can specify your own at each location like 
this: _ 5a_.")
 
 (defface hydra-face-red
     '((t (:foreground "#FF0000" :bold t)))
-  "Red Hydra heads will persist indefinitely."
+  "Red Hydra heads don't exit the Hydra.
+Every other command exits the Hydra."
   :group 'hydra)
 
 (defface hydra-face-blue
     '((t (:foreground "#0000FF" :bold t)))
-  "Blue Hydra heads will vanquish the Hydra.")
+  "Blue Hydra heads exit the Hydra.
+Every other command exits as well.")
 
 (defface hydra-face-amaranth
     '((t (:foreground "#E52B50" :bold t)))
   "Amaranth body has red heads and warns on intercepting non-heads.
-Vanquishable only through a blue head.")
+Exitable only through a blue head.")
 
 (defface hydra-face-pink
     '((t (:foreground "#FF6EB4" :bold t)))
-  "Pink body has red heads and on intercepting non-heads calls them without 
quitting.
-Vanquishable only through a blue head.")
+  "Pink body has red heads and runs intercepted non-heads.
+Exitable only through a blue head.")
 
 (defface hydra-face-teal
     '((t (:foreground "#367588" :bold t)))
   "Teal body has blue heads an warns on intercepting non-heads.
-Vanquishable only through a blue head.")
+Exitable only through a blue head.")
 
 ;;* Fontification
 (defun hydra-add-font-lock ()
@@ -330,57 +332,21 @@ Return DEFAULT if PROP is not in H."
 
 (defun hydra--head-color (h body)
   "Return the color of a Hydra head H with BODY."
-  (let* ((head-exit (hydra--head-property h :exit 'default))
-         (foreign-keys (hydra--body-foreign-keys body))
-         (head-color (hydra--head-property h :color))
+  (let* ((foreign-keys (hydra--body-foreign-keys body))
+         (head-exit (hydra--head-property h :exit))
          (head-color
-          (cond ((eq head-exit 'default)
-                 (cl-case head-color
-                   (blue 'blue)
-                   (red 'red)
-                   (t
-                    (unless (null head-color)
-                      (error "Use only :blue or :red for heads: %S" h)))))
-                ((null head-exit)
-                 (if head-color
-                     (error "Don't mix :color and :exit - they are aliases: 
%S" h)
-                   (cl-case foreign-keys
-                     (run 'pink)
-                     (warn 'amaranth)
-                     (t 'red))))
-                ((eq head-exit t)
-                 (if head-color
-                     (error "Don't mix :color and :exit - they are aliases: 
%S" h)
-                   'blue))
-                (t
-                 (error "Unknown :exit %S" head-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)
-           (let ((color (plist-get (cddr body) :color))
-                 (exit (plist-get (cddr body) :exit))
-                 (foreign-keys (plist-get (cddr body) :foreign-keys)))
-             (cond ((eq foreign-keys 'warn)
-                    (if exit 'teal 'amaranth))
-                   ((eq foreign-keys 'run) 'pink)
-                   (exit 'blue)
-                   (color color)
-                   (t 'red))))
-          ((null foreign-keys)
-           head-color)
-          ((eq foreign-keys 'run)
-           (if (eq head-color 'red)
-               'pink
-             'blue))
-          ((eq foreign-keys 'warn)
-           (if (memq head-color '(red amaranth))
-               'amaranth
-             'teal))
-          (t
-           (error "Unexpected %S %S" h body)))))
+          (if head-exit
+              (if (eq foreign-keys 'warn)
+                  'teal
+                'blue)
+            (cl-case foreign-keys
+              (warn 'amaranth)
+              (run 'pink)
+              (t 'red)))))
+    (when (and (null (cadr h))
+               (not (eq head-color 'blue)))
+      (hydra--complain "nil cmd can only be blue"))
+    head-color))
 
 (defun hydra--body-foreign-keys (body)
   "Return what BODY does with a non-head binding."
@@ -823,7 +789,7 @@ result of `defhydra'."
         (hydra--make-funcall body-before-exit)
         (hydra--make-funcall body-after-exit)
         (dolist (base body-inherit)
-          (setq heads (append heads (eval base))))
+          (setq heads (append heads (copy-sequence (eval base)))))
         (dolist (h heads)
           (let ((len (length h)))
             (cond ((< len 2)
@@ -832,9 +798,7 @@ result of `defhydra'."
                    (setcdr (cdr h)
                            (list
                             (hydra-plist-get-default body-plist :hint "")))
-                   (setcdr (nthcdr 2 h)
-                           (list :cmd-name (hydra--head-name h name body)
-                                 :exit body-exit)))
+                   (setcdr (nthcdr 2 h) (list :exit body-exit)))
                   (t
                    (let ((hint (cl-caddr h)))
                      (unless (or (null hint)
@@ -844,9 +808,7 @@ result of `defhydra'."
                                         (cddr h)))))
                    (let ((hint-and-plist (cddr h)))
                      (if (null (cdr hint-and-plist))
-                         (setcdr hint-and-plist
-                                 (list :cmd-name (hydra--head-name h name body)
-                                       :exit body-exit))
+                         (setcdr hint-and-plist (list :exit body-exit))
                        (let* ((plist (cl-cdddr h))
                               (h-color (plist-get plist :color)))
                          (if h-color
@@ -860,8 +822,9 @@ result of `defhydra'."
                              (plist-put plist :exit
                                         (if (eq h-exit 'default)
                                             body-exit
-                                          h-exit))))
-                         (plist-put plist :cmd-name (hydra--head-name h name 
body)))))))))
+                                          h-exit))))))))))
+          (plist-put (cl-cdddr h) :cmd-name (hydra--head-name h name body))
+          (when (null (cadr h)) (plist-put (cl-cdddr h) :exit t)))
         (let ((doc (hydra--doc body-key body-name heads))
               (heads-nodup (hydra--delete-duplicates heads)))
           (mapc