branch: master
commit 208661423bc4cb805004f93997659e27cfe8b2a3
Author: Oleh Krehel <[email protected]>
Commit: Oleh Krehel <[email protected]>
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:
