[elpa] master 2086614 10/72: hydra.el (defhydradio): New macro

[Oleh Krehel]

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

    hydra.el (defhydradio): New macro
    
    * hydra.el (hydra--radio): New defun.
    (hydra--quote-maybe): New defun.
    (hydra--cycle-radio): New defun.
    
    * hydra-test.el (defhydradio): New test.
---
 hydra-test.el |   18 +++++++++++++++++
 hydra.el      |   58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 76 insertions(+), 0 deletions(-)

diff --git a/hydra-test.el b/hydra-test.el
index 8e1df9a..914c4ad 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -555,6 +555,24 @@ The body can be accessed via `hydra-vi/body'."
                         t (lambda nil (hydra-disable t))))
                  (setq prefix-arg current-prefix-arg))))))))
 
+(ert-deftest defhydradio ()
+  (should (equal
+           (macroexpand
+            '(defhydradio hydra-test ()
+              (num [0 1 2 3 4 5 6 7 8 9 10])
+              (str ["foo" "bar" "baz"])))
+           '(progn
+             (defvar hydra-test/num 0
+               "Num")
+             (put 'hydra-test/num 'range [0 1 2 3 4 5 6 7 8 9 10])
+             (defun hydra-test/num ()
+               (hydra--cycle-radio 'hydra-test/num))
+             (defvar hydra-test/str "foo"
+               "Str")
+             (put 'hydra-test/str 'range ["foo" "bar" "baz"])
+             (defun hydra-test/str ()
+               (hydra--cycle-radio 'hydra-test/str))))))
+
 (provide 'hydra-test)
 
 ;;; hydra-test.el ends here
diff --git a/hydra.el b/hydra.el
index 40aae23..7ccf47e 100644
--- a/hydra.el
+++ b/hydra.el
@@ -483,6 +483,64 @@ except a blue head can stop the Hydra state.
                            body-color body-pre body-post
                            '(setq prefix-arg current-prefix-arg)))))
 
+(defmacro defhydradio (name body &rest heads)
+  "Create toggles with prefix NAME.
+BODY specifies the options; there are none currently.
+HEADS have the format:
+
+    (TOGGLE-NAME &optional VALUE DOC)
+
+TOGGLE-NAME will be used along with NAME to generate a variable
+name and a function that cycles it with the same name.  VALUE
+should be an array. The first element of VALUE will be used to
+inialize the variable.
+VALUE defaults to [nil t].
+DOC defaults to TOGGLE-NAME split and capitalized."
+  (declare (indent defun))
+  (cons 'progn
+        (apply #'append
+               (mapcar (lambda (h)
+                         (hydra--radio name h))
+                       heads))))
+
+(defun hydra--radio (parent head)
+  "Generate a hydradio from HEAD."
+  (let* ((name (car head))
+         (full-name (intern (format "%S/%S" parent name)))
+         (val (or (cadr head) [nil t]))
+         (doc (or (cl-caddr head)
+                  (mapconcat #'capitalize
+                             (split-string (symbol-name name) "-")
+                             " "))))
+    `((defvar ,full-name ,(hydra--quote-maybe (aref val 0)) ,doc)
+      (put ',full-name 'range ,val)
+      (defun ,full-name ()
+        (hydra--cycle-radio ',full-name)))))
+
+(defun hydra--quote-maybe (x)
+  "Quote X if it's a symbol."
+  (if (symbolp x)
+      (list 'quote x)
+    x))
+
+(defun hydra--cycle-radio (sym)
+  "Set SYM to the next value in its range."
+  (let* ((val (symbol-value sym))
+         (range (get sym 'range))
+         (i 0)
+         (l (length range)))
+    (setq i (catch 'done
+              (while (< i l)
+                (if (equal (aref range i) val)
+                    (throw 'done (1+ i))
+                  (incf i)))
+              (error "Val not in range for %S" sym)))
+    (set sym
+         (aref range
+               (if (>= i l)
+                   0
+                 i)))))
+
 (provide 'hydra)
 
 ;;; Local Variables: