emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 900ca34 04/22: Allow access to the current hydra body


From: Oleh Krehel
Subject: [elpa] master 900ca34 04/22: Allow access to the current hydra body
Date: Fri, 16 Oct 2015 10:06:55 +0000

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

    Allow access to the current hydra body
    
    * hydra.el (hydra-curr-body-fn): New defvar.
    (hydra--make-defun): All hydra heads will set `hydra-curr-body-fn' to
    their respective "hydra.../body" function.
    
    Users may read `hydra-curr-body-fn' from any head.
    
    Re #127
---
 hydra-test.el |   66 +++++++++++++++++++++++++++++++++---------
 hydra.el      |   90 ++++++++++++++++++++++++++++++--------------------------
 2 files changed, 100 insertions(+), 56 deletions(-)

diff --git a/hydra-test.el b/hydra-test.el
index 0fc82a1..b55f3ef 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -115,7 +115,9 @@ Call the head: `first-error'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore t))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-error/body)))
         (condition-case err
             (progn
               (setq this-command
@@ -151,7 +153,9 @@ Call the head: `next-error'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore t))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-error/body)))
         (condition-case err
             (progn
               (setq this-command
@@ -187,7 +191,9 @@ Call the head: `previous-error'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore t))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-error/body)))
         (condition-case err
             (progn
               (setq this-command
@@ -236,7 +242,9 @@ The body can be accessed via `hydra-error/body'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore nil))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-error/body)))
         (when hydra-is-helpful
           (if hydra-lv
               (lv-message
@@ -336,6 +344,8 @@ Call the head: `toggle-truncate-lines'."
         (interactive)
         (hydra-default-pre)
         (hydra-keyboard-quit)
+        (setq hydra-curr-body-fn
+              (quote hydra-toggle/body))
         (progn
           (setq this-command
                 (quote toggle-truncate-lines))
@@ -356,6 +366,8 @@ Call the head: `auto-fill-mode'."
         (interactive)
         (hydra-default-pre)
         (hydra-keyboard-quit)
+        (setq hydra-curr-body-fn
+              (quote hydra-toggle/body))
         (progn
           (setq this-command
                 (quote auto-fill-mode))
@@ -375,6 +387,8 @@ Call the head: `abbrev-mode'."
         (interactive)
         (hydra-default-pre)
         (hydra-keyboard-quit)
+        (setq hydra-curr-body-fn
+              (quote hydra-toggle/body))
         (progn
           (setq this-command
                 (quote abbrev-mode))
@@ -393,7 +407,9 @@ The body can be accessed via `hydra-toggle/body'.
 Call the head: `nil'."
         (interactive)
         (hydra-default-pre)
-        (hydra-keyboard-quit))
+        (hydra-keyboard-quit)
+        (setq hydra-curr-body-fn
+              (quote hydra-toggle/body)))
       (defun hydra-toggle/body nil
         "Create a hydra with no body and the heads:
 
@@ -406,7 +422,9 @@ The body can be accessed via `hydra-toggle/body'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore nil))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-toggle/body)))
         (when hydra-is-helpful
           (if hydra-lv
               (lv-message
@@ -501,7 +519,9 @@ Call the head: `next-line'."
         (hydra-default-pre)
         (set-cursor-color "#e52b50")
         (let ((hydra--ignore t))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-vi/body)))
         (condition-case err
             (progn
               (setq this-command
@@ -536,7 +556,9 @@ Call the head: `previous-line'."
         (hydra-default-pre)
         (set-cursor-color "#e52b50")
         (let ((hydra--ignore t))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-vi/body)))
         (condition-case err
             (progn
               (setq this-command
@@ -570,7 +592,9 @@ Call the head: `nil'."
         (interactive)
         (hydra-default-pre)
         (set-cursor-color "#e52b50")
-        (hydra-keyboard-quit))
+        (hydra-keyboard-quit)
+        (setq hydra-curr-body-fn
+              (quote hydra-vi/body)))
       (defun hydra-vi/body nil
         "Create a hydra with no body and the heads:
 
@@ -583,7 +607,9 @@ The body can be accessed via `hydra-vi/body'."
         (hydra-default-pre)
         (set-cursor-color "#e52b50")
         (let ((hydra--ignore nil))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-vi/body)))
         (when hydra-is-helpful
           (if hydra-lv
               (lv-message
@@ -676,7 +702,9 @@ Call the head: `(text-scale-set 0)'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore t))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-zoom/body)))
         (condition-case err
             (call-interactively
              (function
@@ -711,6 +739,8 @@ Call the head: `(text-scale-set 0)'."
         (interactive)
         (hydra-default-pre)
         (hydra-keyboard-quit)
+        (setq hydra-curr-body-fn
+              (quote hydra-zoom/body))
         (call-interactively
          (function
           (lambda nil
@@ -727,7 +757,9 @@ The body can be accessed via `hydra-zoom/body'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore nil))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-zoom/body)))
         (when hydra-is-helpful
           (if hydra-lv
               (lv-message
@@ -821,7 +853,9 @@ Call the head: `(text-scale-set 0)'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore t))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-zoom/body)))
         (condition-case err
             (call-interactively
              (function
@@ -856,6 +890,8 @@ Call the head: `(text-scale-set 0)'."
         (interactive)
         (hydra-default-pre)
         (hydra-keyboard-quit)
+        (setq hydra-curr-body-fn
+              (quote hydra-zoom/body))
         (call-interactively
          (function
           (lambda nil
@@ -872,7 +908,9 @@ The body can be accessed via `hydra-zoom/body'."
         (interactive)
         (hydra-default-pre)
         (let ((hydra--ignore nil))
-          (hydra-keyboard-quit))
+          (hydra-keyboard-quit)
+          (setq hydra-curr-body-fn
+                (quote hydra-zoom/body)))
         (when hydra-is-helpful
           (if hydra-lv
               (lv-message
diff --git a/hydra.el b/hydra.el
index 67a345e..16261dc 100644
--- a/hydra.el
+++ b/hydra.el
@@ -88,6 +88,9 @@
 (defvar hydra-curr-foreign-keys nil
   "The current :foreign-keys behavior.")
 
+(defvar hydra-curr-body-fn nil
+  "The current hydra-.../body function.")
+
 (defvar hydra-deactivate nil
   "If a Hydra head sets this to t, exit the Hydra.
 This will be done even if the head wasn't designated for exiting.")
@@ -205,28 +208,28 @@ When nil, you can specify your own at each location like 
this: _ 5a_.")
  "0.13.1")
 
 (defface hydra-face-red
-    '((t (:foreground "#FF0000" :bold t)))
+  '((t (:foreground "#FF0000" :bold t)))
   "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)))
+  '((t (:foreground "#0000FF" :bold t)))
   "Blue Hydra heads exit the Hydra.
 Every other command exits as well.")
 
 (defface hydra-face-amaranth
-    '((t (:foreground "#E52B50" :bold t)))
+  '((t (:foreground "#E52B50" :bold t)))
   "Amaranth body has red heads and warns on intercepting non-heads.
 Exitable only through a blue head.")
 
 (defface hydra-face-pink
-    '((t (:foreground "#FF6EB4" :bold t)))
+  '((t (:foreground "#FF6EB4" :bold t)))
   "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)))
+  '((t (:foreground "#367588" :bold t)))
   "Teal body has blue heads and warns on intercepting non-heads.
 Exitable only through a blue head.")
 
@@ -405,9 +408,9 @@ Return DEFAULT if PROP is not in H."
   (cancel-timer hydra-message-timer)
   (unless (and hydra--ignore
                (null hydra--work-around-dedicated))
-   (if hydra-lv
-       (lv-delete-window)
-     (message "")))
+    (if hydra-lv
+        (lv-delete-window)
+      (message "")))
   nil)
 
 (defun hydra--hint (body heads)
@@ -458,7 +461,8 @@ HEAD's binding is returned as a string with a colored face."
       (hydra--complain "nil cmd can only be blue"))
     (propertize (if (string= (car head) "%")
                     "%%"
-                  (car head)) 'face
+                  (car head))
+                'face
                 (cl-case head-color
                   (blue 'hydra-face-blue)
                   (red 'hydra-face-red)
@@ -585,7 +589,7 @@ HEAD is one of the HEADS passed to `defhydra'.
 BODY-PRE is added to the start of the wrapper.
 BODY-BEFORE-EXIT will be called before the hydra quits.
 BODY-AFTER-EXIT is added to the end of the wrapper."
-  (let ((name (hydra--head-name head name))
+  (let ((cmd-name (hydra--head-name head name))
         (cmd (when (car head)
                (hydra--make-callable
                 (cadr head))))
@@ -596,45 +600,47 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
         (body-foreign-keys (hydra--body-foreign-keys body))
         (body-timeout (plist-get body :timeout))
         (body-idle (plist-get body :idle)))
-    `(defun ,name ()
+    `(defun ,cmd-name ()
        ,doc
        (interactive)
        (hydra-default-pre)
        ,@(when body-pre (list body-pre))
        ,@(if (hydra--head-property head :exit)
              `((hydra-keyboard-quit)
+               (setq hydra-curr-body-fn ',(intern (format "%S/body" name)))
                ,@(if body-after-exit
                      `((unwind-protect
                             ,(when cmd
-                                   (hydra--call-interactively cmd (cadr head)))
+                               (hydra--call-interactively cmd (cadr head)))
                          ,body-after-exit))
-                     (when cmd
-                       `(,(hydra--call-interactively cmd (cadr head))))))
-             (delq
-              nil
-              `((let ((hydra--ignore ,(not (eq (cadr head) 'body))))
-                  (hydra-keyboard-quit))
-                ,(when cmd
-                       `(condition-case err
-                            ,(hydra--call-interactively cmd (cadr head))
-                          ((quit error)
-                           (message "%S" err)
-                           (unless hydra-lv
-                             (sit-for 0.8)))))
-                ,(if (and body-idle (eq (cadr head) 'body))
-                     `(hydra-idle-message ,body-idle ,hint)
-                     `(when hydra-is-helpful
-                        (if hydra-lv
-                            (lv-message (eval ,hint))
-                          (message (eval ,hint)))))
-                (hydra-set-transient-map
-                 ,keymap
-                 (lambda () (hydra-keyboard-quit) ,body-before-exit)
-                 ,(when body-foreign-keys
-                        (list 'quote body-foreign-keys)))
-                ,body-after-exit
-                ,(when body-timeout
-                       `(hydra-timeout ,body-timeout))))))))
+                   (when cmd
+                     `(,(hydra--call-interactively cmd (cadr head))))))
+           (delq
+            nil
+            `((let ((hydra--ignore ,(not (eq (cadr head) 'body))))
+                (hydra-keyboard-quit)
+                (setq hydra-curr-body-fn ',(intern (format "%S/body" name))))
+              ,(when cmd
+                 `(condition-case err
+                      ,(hydra--call-interactively cmd (cadr head))
+                    ((quit error)
+                     (message "%S" err)
+                     (unless hydra-lv
+                       (sit-for 0.8)))))
+              ,(if (and body-idle (eq (cadr head) 'body))
+                   `(hydra-idle-message ,body-idle ,hint)
+                 `(when hydra-is-helpful
+                    (if hydra-lv
+                        (lv-message (eval ,hint))
+                      (message (eval ,hint)))))
+              (hydra-set-transient-map
+               ,keymap
+               (lambda () (hydra-keyboard-quit) ,body-before-exit)
+               ,(when body-foreign-keys
+                  (list 'quote body-foreign-keys)))
+              ,body-after-exit
+              ,(when body-timeout
+                 `(hydra-timeout ,body-timeout))))))))
 
 (defmacro hydra--make-funcall (sym)
   "Transform SYM into a `funcall' to call it."
@@ -788,7 +794,7 @@ Cancel the previous `hydra-timeout'."
    hydra-timeout-timer
    `(lambda ()
       ,(when function
-             `(funcall ,function))
+         `(funcall ,function))
       (hydra-keyboard-quit)))
   (timer-activate hydra-timeout-timer))
 
@@ -956,8 +962,8 @@ result of `defhydra'."
              ,@(unless (or (null body-key)
                            (null body-map)
                            (hydra--callablep body-map))
-                       `((unless (keymapp (lookup-key ,body-map (kbd 
,body-key)))
-                           (define-key ,body-map (kbd ,body-key) nil))))
+                 `((unless (keymapp (lookup-key ,body-map (kbd ,body-key)))
+                     (define-key ,body-map (kbd ,body-key) nil))))
              ;; bind keys
              ,@(delq nil
                      (mapcar



reply via email to

[Prev in Thread] Current Thread [Next in Thread]