]> code.delx.au - gnu-emacs-elpa/commitdiff
Set pink/amaranth override recursively
authorOleh Krehel <ohwoeowho@gmail.com>
Sat, 21 Mar 2015 18:30:23 +0000 (19:30 +0100)
committerOleh Krehel <ohwoeowho@gmail.com>
Sat, 21 Mar 2015 18:30:23 +0000 (19:30 +0100)
* hydra.el (hydra--modify-keymap): New defun.
(hydra--handle-nonhead): Update.

Fixes #81.

hydra.el

index 684fdad12d17641965e259b62a29ff46d9c9282e..44d27efd324c6ddfc5db77c994c64531109679dc 100644 (file)
--- a/hydra.el
+++ b/hydra.el
@@ -635,6 +635,22 @@ OTHER-POST is an optional extension to the :post key of BODY."
           (message "Pink Hydra can't currently handle prefixes, continuing"))
       (message "Pink Hydra could not resolve: %S" keys))))
 
+(defun hydra--modify-keymap (keymap def)
+  "In KEYMAP, add DEF to each sub-keymap."
+  (cl-labels
+      ((recur (map)
+         (if (atom map)
+             map
+           (if (eq (car map) 'keymap)
+               (cons 'keymap
+                     (cons
+                      def
+                      (recur (cdr map))))
+             (cons
+              (recur (car map))
+              (recur (cdr map)))))))
+    (recur keymap)))
+
 (defun hydra--handle-nonhead (keymap name body heads)
   "Setup KEYMAP for intercepting non-head bindings.
 NAME, BODY and HEADS are parameters to `defhydra'."
@@ -650,19 +666,24 @@ NAME, BODY and HEADS are parameters to `defhydra'."
                       (memq (hydra--head-color h body) '(blue teal)))
                    heads)
           (progn
-            (define-key keymap [t]
-              `(lambda ()
-                 (interactive)
-                 ,(cond
-                   ((memq body-color '(amaranth teal))
-                    '(message "An amaranth 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)))))))
+            (setcdr
+             keymap
+             (cdr
+              (hydra--modify-keymap
+               keymap
+               (cons t
+                     `(lambda ()
+                        (interactive)
+                        ,(cond
+                          ((memq body-color '(amaranth teal))
+                           '(message "An amaranth 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))))))))))
         (unless (eq body-color 'teal)
           (error
            "An %S Hydra must have at least one blue head in order to exit"