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

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

[elpa] master ace99b3 51/72: hydra.el (hydra--make-defun): Update signat


From: Oleh Krehel
Subject: [elpa] master ace99b3 51/72: hydra.el (hydra--make-defun): Update signature
Date: Fri, 06 Mar 2015 13:04:19 +0000

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

    hydra.el (hydra--make-defun): Update signature
---
 hydra.el |  107 ++++++++++++++++++++++++++++++++++---------------------------
 1 files changed, 60 insertions(+), 47 deletions(-)

diff --git a/hydra.el b/hydra.el
index 8c84419..e9fdc5c 100644
--- a/hydra.el
+++ b/hydra.el
@@ -493,41 +493,58 @@ HEADS is a list of heads."
     heads ",\n")
    (format "The body can be accessed via `%S'." body-name)))
 
-(defun hydra--make-defun (name cmd color
-                          doc hint keymap
-                          body-color body-pre body-post &optional other-post)
-  "Make a defun wrapper, using NAME, CMD, COLOR, DOC, HINT, and KEYMAP.
-BODY-COLOR, BODY-PRE, BODY-POST, and OTHER-POST are used as well."
-  `(defun ,name ()
-     ,doc
-     (interactive)
-     ,@(when body-pre (list body-pre))
-     (hydra-disable)
-     ,@(when (memq color '(blue teal)) '((hydra-cleanup)))
-     (catch 'hydra-disable
-       ,@(delq nil
-               (if (memq color '(blue teal))
-                   `(,(when cmd `(call-interactively #',cmd))
-                      ,body-post)
-                 `(,(when cmd
-                          `(condition-case err
-                               (prog1 t
-                                 (call-interactively #',cmd))
-                             ((quit error)
-                              (message "%S" err)
-                              (unless hydra-lv
-                                (sit-for 0.8))
-                              nil)))
-                    (when hydra-is-helpful
-                      (,hint))
-                    (setq hydra-last
-                          (hydra-set-transient-map
-                           (setq hydra-curr-map ',keymap)
-                           t
-                           ,(if (and (not (memq body-color '(amaranth pink 
teal))) body-post)
-                                `(lambda () (hydra-cleanup) ,body-post)
-                                `(lambda () (hydra-cleanup)))))
-                    ,other-post))))))
+(defun hydra--make-defun (name body doc head
+                          keymap body-pre body-post &optional other-post)
+  "Make a defun wrapper, using NAME, BODY, DOC, HEAD, and KEYMAP.
+NAME and BODY are the arguments to `defhydra'.
+DOC was generated with `hydra--doc'.
+HEAD is one of the HEADS passed to `defhydra'.
+BODY-PRE and BODY-POST are pre-processed in `defhydra'.
+OTHER-POST is an optional extension to the :post key of BODY."
+  (let ((name (hydra--head-name head name))
+        (cmd (when (car head)
+               (hydra--make-callable
+                (cadr head))))
+        (color (when (car head)
+                 (hydra--head-color head body)))
+        (doc (if (car head)
+                 (format "%s\n\nCall the head: `%S'." doc (cadr head))
+               doc))
+        (hint (intern (format "%S/hint" name)))
+        (body-color (hydra--body-color body)))
+    `(defun ,name ()
+       ,doc
+       (interactive)
+       ,@(when body-pre (list body-pre))
+       (hydra-disable)
+       ,@(when (memq color '(blue teal)) '((hydra-cleanup)))
+       (catch 'hydra-disable
+         ,@(delq nil
+                 (if (memq color '(blue teal))
+                     `(,(when cmd `(call-interactively #',cmd))
+                        ,body-post)
+                   `(,(when cmd
+                            `(condition-case err
+                                 (prog1 t
+                                   (call-interactively #',cmd))
+                               ((quit error)
+                                (message "%S" err)
+                                (unless hydra-lv
+                                  (sit-for 0.8))
+                                nil)))
+                      (when hydra-is-helpful
+                        (,hint))
+                      (setq hydra-last
+                            (hydra-set-transient-map
+                             (setq hydra-curr-map ',keymap)
+                             t
+                             ,(if (and
+                                   (not (memq body-color
+                                              '(amaranth pink teal)))
+                                   body-post)
+                                  `(lambda () (hydra-cleanup) ,body-post)
+                                  `(lambda () (hydra-cleanup)))))
+                      ,other-post)))))))
 
 (defun hydra-pink-fallback ()
   "On intercepting a non-head, try to run it."
@@ -658,7 +675,6 @@ result of `defhydra'."
     (setq body (cons nil (cons nil body))))
   (let* ((keymap (copy-keymap hydra-base-map))
          (body-name (intern (format "%S/body" name)))
-         (hint-name (intern (format "%S/hint" name)))
          (body-key (unless (hydra--callablep body)
                      (cadr body)))
          (body-color (hydra--body-color body))
@@ -683,13 +699,8 @@ result of `defhydra'."
     `(progn
        ,@(mapcar
           (lambda (head)
-            (hydra--make-defun
-             (hydra--head-name head name)
-             (hydra--make-callable
-              (cadr head)) (hydra--head-color head body)
-             (format "%s\n\nCall the head: `%S'." doc (cadr head))
-             hint-name keymap
-             body-color body-pre body-post))
+            (hydra--make-defun name body doc head keymap
+                               body-pre body-post))
           (hydra--delete-duplicates heads))
        ,@(unless (or (null body-key)
                      (null method)
@@ -725,11 +736,13 @@ result of `defhydra'."
                               (t
                                (error "Invalid :bind property %S" head)))))))
                 heads))
-       (defun ,hint-name ()
+       (defun ,(intern (format "%S/hint" name)) ()
          ,(hydra--message name body docstring heads))
-       ,(hydra--make-defun body-name nil nil doc hint-name keymap
-                           body-color (or body-body-pre body-pre) body-post
-                           '(setq prefix-arg current-prefix-arg)))))
+       ,(hydra--make-defun
+         name body doc '(nil body)
+         keymap
+         (or body-body-pre body-pre) body-post
+         '(setq prefix-arg current-prefix-arg)))))
 
 (defmacro defhydradio (name body &rest heads)
   "Create radios with prefix NAME.



reply via email to

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