[elpa] master d3d435d 25/45: Finalize head inheritance

[Oleh Krehel]

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

    Finalize head inheritance
    
    * hydra.el (hydra--body-exit): New defun.
    (defhydra): Ensure that each head doesn't need the :exit info from the
    body any more by putting the aggregated :exit in the head's own plist.
    
    * hydra-test.el: Update tests.
    
    Each hydra will now declare its own heads as a variable `foo/heads`.
    It's possible to inherit them like this:
    
    (defhydra hydra-zoom-child (:inherit (hydra-zoom/heads))
      "zoom"
      ("q" nil))
    
    One hydra can inherit from multiple parents. This one just adds a single
    "q" head to the familiar hydra-zoom.
    
    Fixes #57.
---
 hydra-test.el |   84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 hydra.el      |   61 ++++++++++++++++++++++++++++-------------
 2 files changed, 126 insertions(+), 19 deletions(-)

diff --git a/hydra-test.el b/hydra-test.el
index 54da5d0..fcb34c5 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -70,6 +70,27 @@
          (48 . hydra--digit-argument)
          (45 . hydra--negative-argument)
          (21 . hydra--universal-argument))))
+      (set
+       (defvar hydra-error/heads nil
+         "Heads for hydra-error.")
+       (quote
+        (("h"
+          first-error
+          "first"
+          :exit nil)
+         ("j"
+          next-error
+          "next"
+          :exit nil)
+         ("k"
+          previous-error
+          "prev"
+          :exit nil)
+         ("SPC"
+          hydra-repeat
+          "rep"
+          :bind nil
+          :exit nil))))
       (defun hydra-error/first-error nil
         "Create a hydra with a \"M-g\" body and the heads:
 
@@ -257,6 +278,23 @@ The body can be accessed via `hydra-error/body'."
          (48 . hydra--digit-argument)
          (45 . hydra--negative-argument)
          (21 . hydra--universal-argument))))
+      (set
+       (defvar hydra-toggle/heads nil
+         "Heads for hydra-toggle.")
+       (quote
+        (("t"
+          toggle-truncate-lines
+          "truncate"
+          :exit t)
+         ("f"
+          auto-fill-mode
+          "fill"
+          :exit t)
+         ("a"
+          abbrev-mode
+          "abbrev"
+          :exit t)
+         ("q" nil "cancel" :exit t))))
       (defun hydra-toggle/toggle-truncate-lines-and-exit nil
         "Create a hydra with no body and the heads:
 
@@ -403,6 +441,16 @@ The body can be accessed via `hydra-toggle/body'."
          (48 . hydra--digit-argument)
          (45 . hydra--negative-argument)
          (21 . hydra--universal-argument))))
+      (set
+       (defvar hydra-vi/heads nil
+         "Heads for hydra-vi.")
+       (quote
+        (("j" next-line "" :exit nil)
+         ("k"
+          previous-line
+          ""
+          :exit nil)
+         ("q" nil "quit" :exit nil))))
       (defun hydra-vi/next-line nil
         "Create a hydra with no body and the heads:
 
@@ -551,6 +599,24 @@ The body can be accessed via `hydra-vi/body'."
          (48 . hydra-zoom/lambda-0-and-exit)
          (45 . hydra--negative-argument)
          (21 . hydra--universal-argument))))
+      (set
+       (defvar hydra-zoom/heads nil
+         "Heads for hydra-zoom.")
+       (quote
+        (("r"
+          (text-scale-set 0)
+          "reset"
+          :exit nil)
+         ("0"
+          (text-scale-set 0)
+          ""
+          :bind nil
+          :exit t)
+         ("1"
+          (text-scale-set 0)
+          nil
+          :bind nil
+          :exit t))))
       (defun hydra-zoom/lambda-r nil
         "Create a hydra with no body and the heads:
 
@@ -674,6 +740,24 @@ The body can be accessed via `hydra-zoom/body'."
          (48 . hydra-zoom/lambda-0-and-exit)
          (45 . hydra--negative-argument)
          (21 . hydra--universal-argument))))
+      (set
+       (defvar hydra-zoom/heads nil
+         "Heads for hydra-zoom.")
+       (quote
+        (("r"
+          (text-scale-set 0)
+          "reset"
+          :exit nil)
+         ("0"
+          (text-scale-set 0)
+          ""
+          :bind nil
+          :exit t)
+         ("1"
+          (text-scale-set 0)
+          nil
+          :bind nil
+          :exit nil))))
       (defun hydra-zoom/lambda-r nil
         "Create a hydra with no body and the heads:
 
diff --git a/hydra.el b/hydra.el
index 599ad47..1397035 100644
--- a/hydra.el
+++ b/hydra.el
@@ -380,6 +380,15 @@ Return DEFAULT if PROP is not in H."
        ((amaranth teal) 'warn)
        (pink 'run)))))
 
+(defun hydra--body-exit (body)
+  "Return the exit behavior of BODY."
+  (or
+   (plist-get (cddr body) :exit)
+   (let ((color (plist-get (cddr body) :color)))
+     (cl-case color
+       ((blue teal) t)
+       (t nil)))))
+
 (defvar hydra--input-method-function nil
   "Store overridden `input-method-function' here.")
 
@@ -798,7 +807,8 @@ result of `defhydra'."
                                    (plist-get body-plist :before-exit)))
              (body-after-exit (plist-get body-plist :after-exit))
              (body-inherit (plist-get body-plist :inherit))
-             (body-foreign-keys (hydra--body-foreign-keys body)))
+             (body-foreign-keys (hydra--body-foreign-keys body))
+             (body-exit (hydra--body-exit body)))
         (hydra--make-funcall body-before-exit)
         (hydra--make-funcall body-after-exit)
         (dolist (base body-inherit)
@@ -812,22 +822,35 @@ result of `defhydra'."
                            (list
                             (hydra-plist-get-default body-plist :hint "")))
                    (setcdr (nthcdr 2 h)
-                           (list :cmd-name (hydra--head-name h name body))))
+                           (list :cmd-name (hydra--head-name h name body)
+                                 :exit body-exit)))
                   (t
                    (let ((hint (cl-caddr h)))
                      (unless (or (null hint)
                                  (stringp hint))
                        (setcdr (cdr h) (cons
                                         (hydra-plist-get-default body-plist 
:hint "")
-                                        (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)))
-                         (plist-put (cdr hint-and-plist)
-                                    :cmd-name
-                                    (hydra--head-name h name body)))))))))
+                                        (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))
+                       (let* ((plist (cl-cdddr h))
+                              (h-color (plist-get plist :color)))
+                         (if h-color
+                             (progn
+                               (plist-put plist :exit
+                                          (cl-case h-color
+                                            ((blue teal) t)
+                                            (t nil)))
+                               (cl-remf (cl-cdddr h) :color))
+                           (let ((h-exit (hydra-plist-get-default plist :exit 
'default)))
+                             (plist-put plist :exit
+                                        (if (eq h-exit 'default)
+                                            body-exit
+                                          h-exit))))
+                         (plist-put plist :cmd-name (hydra--head-name h name 
body)))))))))
         (let ((doc (hydra--doc body-key body-name heads))
               (heads-nodup (hydra--delete-duplicates heads)))
           (mapc
@@ -852,14 +875,14 @@ result of `defhydra'."
                     ,(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))
+             (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)