[elpa] master b351b7c 24/45: hydra.el (hydra--body-color): Remove

[Oleh Krehel]

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

    hydra.el (hydra--body-color): Remove
    
    * hydra.el (hydra--head-color): Update.
    (hydra--make-defun): Update.
    (defhydra): Update.
---
 hydra.el |   72 +++++++++++++++++++++++++++++++------------------------------
 1 files changed, 37 insertions(+), 35 deletions(-)

diff --git a/hydra.el b/hydra.el
index e5152c0..599ad47 100644
--- a/hydra.el
+++ b/hydra.el
@@ -319,37 +319,45 @@ 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* ((exit (hydra--head-property h :exit 'default))
-         (color (hydra--head-property h :color))
+  (let* ((head-exit (hydra--head-property h :exit 'default))
          (foreign-keys (hydra--body-foreign-keys body))
+         (head-color (hydra--head-property h :color))
          (head-color
-          (cond ((eq exit 'default)
-                 (cl-case color
+          (cond ((eq head-exit 'default)
+                 (cl-case head-color
                    (blue 'blue)
                    (red 'red)
                    (t
-                    (unless (null color)
+                    (unless (null head-color)
                       (error "Use only :blue or :red for heads: %S" h)))))
-                ((null exit)
-                 (if color
+                ((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 exit t)
-                 (if color
+                ((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" exit)))))
+                 (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)
-           (hydra--body-color body))
+           (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)
@@ -372,19 +380,6 @@ Return DEFAULT if PROP is not in H."
        ((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))
-        (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))))
-
 (defvar hydra--input-method-function nil
   "Store overridden `input-method-function' here.")
 
@@ -558,7 +553,7 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
                  (format "%s\n\nCall the head: `%S'." doc (cadr head))
                doc))
         (hint (intern (format "%S/hint" name)))
-        (body-color (hydra--body-color body))
+        (body-foreign-keys (hydra--body-foreign-keys body))
         (body-timeout (plist-get body :timeout)))
     `(defun ,name ()
        ,doc
@@ -588,13 +583,8 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
                  (hydra-set-transient-map
                   ,keymap
                   (lambda () (hydra-keyboard-quit) ,body-before-exit)
-                  ,(cond
-                    ((memq body-color '(amaranth teal))
-                     ''warn)
-                    ((eq body-color 'pink)
-                     ''run)
-                    (t
-                     nil)))
+                  ,(when body-foreign-keys
+                         (list 'quote body-foreign-keys)))
                  ,body-after-exit
                  ,(when body-timeout
                         `(hydra-timeout ,body-timeout))))))))
@@ -807,9 +797,12 @@ result of `defhydra'."
              (body-before-exit (or (plist-get body-plist :post)
                                    (plist-get body-plist :before-exit)))
              (body-after-exit (plist-get body-plist :after-exit))
-             (body-color (hydra--body-color body)))
+             (body-inherit (plist-get body-plist :inherit))
+             (body-foreign-keys (hydra--body-foreign-keys body)))
         (hydra--make-funcall body-before-exit)
         (hydra--make-funcall body-after-exit)
+        (dolist (base body-inherit)
+          (setq heads (append heads (eval base))))
         (dolist (h heads)
           (let ((len (length h)))
             (cond ((< len 2)
@@ -844,20 +837,29 @@ result of `defhydra'."
            heads)
           (hydra--make-funcall body-pre)
           (hydra--make-funcall body-body-pre)
-          (when (memq body-color '(amaranth pink))
+          (when (memq body-foreign-keys '(run warn))
             (unless (cl-some
                      (lambda (h)
                        (memq (hydra--head-color h body) '(blue teal)))
                      heads)
               (error
                "An %S Hydra must have at least one blue head in order to exit"
-               body-color)))
+               body-foreign-keys)))
           `(progn
              ;; create keymap
              (set (defvar ,keymap-name
                     nil
                     ,(format "Keymap for %S." name))
                   ',keymap)
+             ;; declare heads
+             ;; (set (defvar ,(intern (format "%S/heads" name))
+             ;;        nil
+             ;;        ,(format "Heads for %S." name))
+             ;;      ',(mapcar (lambda (h)
+             ;;                  (let ((j (copy-sequence h)))
+             ;;                    (cl-remf (cl-cdddr j) :cmd-name)
+             ;;                    j))
+             ;;                heads))
              ;; create defuns
              ,@(mapcar
                 (lambda (head)