diff --git a/README.md b/README.md index 24c8cf7..79175bd 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,8 @@ This is a package for GNU Emacs that can be used to tie related commands into a family of short bindings with a common prefix - a Hydra. +![hydra](http://oremacs.com/download/Hydra.png) + Once you summon the Hydra through the prefixed binding (the body + any one head), all heads can be called in succession with only a short extension. @@ -14,6 +16,8 @@ Hydra, will still serve his orignal purpose, calling his proper command. This makes the Hydra very seamless, it's like a minor mode that disables itself auto-magically. +## Simplified usage + Here's how to quickly bind the examples bundled with Hydra: ```cl @@ -23,6 +27,8 @@ Here's how to quickly bind the examples bundled with Hydra: (hydra-create "" hydra-example-text-scale) ``` +## Using Hydra for global bindings + But it's much better to just take the examples as a template and write down everything explicitly: @@ -51,7 +57,8 @@ it like this: ("l" text-scale-decrease "out"))) ``` -If you like key chords so much that you don't want to touch the global map at all, you can e.g.: +If you like key chords so much that you don't want to touch the global +map at all, you can e.g.: ``` (key-chord-define-global @@ -68,9 +75,7 @@ You can also substitute `global-map` with any other keymap, like See the [introductory blog post](http://oremacs.com/2015/01/20/introducing-hydra/) for more information. -![hydra](http://oremacs.com/download/Hydra.png) - -## Using Hydra to define bindings other than global ones +## Using Hydra for major-mode or minor-mode bindings Here's an example: @@ -104,3 +109,57 @@ can even add comments to the heads like this: With this, you'll see `zoom: [g]: in, [l]: out.` in your echo area, once the zoom Hydra becomes active. + +## Colorful Hydras + +Since version `0.5.0`, Hydra's heads all have a color associated with them: + +- *red* (default) means the calling this head will not vanquish the Hydra +- *blue* means that the Hydra will be vanquished after calling this head + +In all the older examples, all heads are red by default. You can specify blue heads like this: + +```cl +(global-set-key + (kbd "C-c C-v") + (defhydra toggle () + "toggle" + ("a" abbrev-mode "abbrev" :color blue) + ("d" toggle-debug-on-error "debug" :color blue) + ("f" auto-fill-mode "fill" :color blue) + ("t" toggle-truncate-lines "truncate" :color blue) + ("w" whitespace-mode "whitespace" :color blue) + ("q" nil "cancel"))) +``` + +Or, since the heads can inherit the color from the body, the following is equivalent: + +```cl +(global-set-key + (kbd "C-c C-v") + (defhydra toggle (:color blue) + "toggle" + ("a" abbrev-mode "abbrev") + ("d" toggle-debug-on-error "debug") + ("f" auto-fill-mode "fill") + ("t" toggle-truncate-lines "truncate") + ("w" whitespace-mode "whitespace") + ("q" nil "cancel"))) +``` + +The above Hydra is very similar to this code: + +```cl +(global-set-key (kbd "C-c C-v t") 'toggle-truncate-lines) +(global-set-key (kbd "C-c C-v f") 'auto-fill-mode) +(global-set-key (kbd "C-c C-v a") 'abbrev-mode) +``` + +However, there are two important differences: + +- you get a hint like this right after C-c C-v: + + toggle: [t]: truncate, [f]: fill, [a]: abbrev, [q]: cancel. + +- you can cancel C-c C-v with a command while executing that command, instead of e.g. +getting an error `C-c C-v C-n is undefined` for C-c C-v C-n. diff --git a/hydra-test.el b/hydra-test.el index d1cb902..4bbbcd0 100644 --- a/hydra-test.el +++ b/hydra-test.el @@ -1,6 +1,6 @@ (require 'ert) -(ert-deftest defhydra () +(ert-deftest defhydra-red-error () (should (equal (macroexpand @@ -109,4 +109,94 @@ The body can be accessed via `hydra-error/body'." (106 . hydra-error/next-error) (104 . hydra-error/first-error)) t))))))) +(ert-deftest hydra-blue-toggle () + (should + (equal + (macroexpand + '(defhydra toggle (:color blue) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel"))) + '(progn + (defun toggle/toggle-truncate-lines () + "Create a hydra with no body and the heads: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `toggle/body'. + +Call the head: `toggle-truncate-lines'." + (interactive) + (hydra-disable) + (call-interactively #'toggle-truncate-lines)) + (defun toggle/auto-fill-mode () + "Create a hydra with no body and the heads: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `toggle/body'. + +Call the head: `auto-fill-mode'." + (interactive) + (hydra-disable) + (call-interactively #'auto-fill-mode)) + (defun toggle/abbrev-mode () + "Create a hydra with no body and the heads: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `toggle/body'. + +Call the head: `abbrev-mode'." + (interactive) + (hydra-disable) + (call-interactively #'abbrev-mode)) + (defun toggle/nil () + "Create a hydra with no body and the heads: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `toggle/body'. + +Call the head: `nil'." + (interactive) + (hydra-disable)) + (defun toggle/body () + "Create a hydra with no body and the heads: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `toggle/body'." + (interactive) + (when hydra-is-helpful + (message #("toggle: [t]: truncate, [f]: fill, [a]: abbrev, [q]: cancel." + 9 10 (face hydra-face-blue) + 24 25 (face hydra-face-blue) + 35 36 (face hydra-face-blue) + 48 49 (face hydra-face-blue)))) + (setq hydra-last + (hydra-set-transient-map + '(keymap (113 . toggle/nil) + (97 . toggle/abbrev-mode) + (102 . toggle/auto-fill-mode) + (116 . toggle/toggle-truncate-lines)) + t))))))) + (provide 'hydra-test) diff --git a/hydra.el b/hydra.el index e6950eb..95d3a42 100644 --- a/hydra.el +++ b/hydra.el @@ -5,7 +5,7 @@ ;; Author: Oleh Krehel ;; Maintainer: Oleh Krehel ;; URL: https://github.com/abo-abo/hydra -;; Version: 0.4.1 +;; Version: 0.5.0 ;; Keywords: bindings ;; Package-Requires: ((cl-lib "0.5")) @@ -73,6 +73,15 @@ :type 'boolean :group 'hydra) +(defface hydra-face-red + '((t (:foreground "#7F0055" :bold t))) + "Red Hydra heads will persist indefinitely." + :group 'hydra) + +(defface hydra-face-blue + '((t (:foreground "#758BC6" :bold t))) + "Blue Hydra heads will vanquish the Hydra.") + (defalias 'hydra-set-transient-map (if (fboundp 'set-transient-map) 'set-transient-map @@ -111,11 +120,70 @@ When `(keymapp METHOD)`, it becomes: ,@(eval heads))) (defun hydra--callablep (x) - "Test if X looks like it's callable." + "Test if X is callable." (or (functionp x) (and (consp x) (memq (car x) '(function quote))))) +(defun hydra--color (h body-color) + "Return the color of a Hydra head H with BODY-COLOR." + (if (null (cadr h)) + 'blue + (let ((plist (if (stringp (cl-caddr h)) + (cl-cdddr h) + (cddr h)))) + (or (plist-get plist :color) body-color)))) + +(defun hydra--face (h body-color) + "Return the face for a Hydra head H with BODY-COLOR." + (cl-case (hydra--color h body-color) + (blue 'hydra-face-blue) + (red 'hydra-face-red) + (t (error "Unknown color for %S" h)))) + +(defun hydra--hint (docstring heads) + "Generate a hint from DOCSTRING and HEADS. +It's intended for the echo area, when a Hydra is active." + (format "%s: %s." + docstring + (mapconcat + (lambda (h) + (format + (if (stringp (cl-caddr h)) + (concat "[%s]: " (cl-caddr h)) + "%s") + (propertize + (car h) 'face + (hydra--face h body-color)))) + heads ", "))) + +(defun hydra-disable () + "Disable the current Hydra." + (if (functionp hydra-last) + (funcall hydra-last) + (while (and (consp (car emulation-mode-map-alists)) + (consp (caar emulation-mode-map-alists)) + (equal (cl-cdaar emulation-mode-map-alists) ',keymap)) + (setq emulation-mode-map-alists + (cdr emulation-mode-map-alists))))) + +(defun hydra--doc (body-key body-name heads) + "Generate a part of Hydra docstring. +BODY-KEY is the body key binding. +BODY-NAME is the symbol that identifies the Hydra. +HEADS is a list of heads." + (format + "Create a hydra with %s body and the heads:\n\n%s\n\n%s" + (if body-key + (format "a \"%s\"" body-key) + "no") + (mapconcat + (lambda (x) + (format "\"%s\": `%S'" (car x) (cadr x))) + heads ",\n") + (format "The body can be accessed via `%S'." body-name))) + +;;;###autoload (defmacro defhydra (name body &optional docstring &rest heads) "Create a hydra named NAME with a prefix BODY. @@ -124,7 +192,7 @@ defined here. BODY should be either: - (BODY-MAP &optional BODY-KEY) + (BODY-MAP &optional BODY-KEY &rest PLIST) or: (lambda (KEY CMD) ...) @@ -135,10 +203,15 @@ BODY-KEY should be a string processable by `kbd'. DOCSTRING will be displayed in the echo area to identify the hydra. -HEADS is a list of (KEY CMD &optional HINT)." +HEADS is a list of (KEY CMD &optional HINT &rest PLIST). + +PLIST in both cases recognizes only the :color key so far, which +in turn can be either red or blue." (unless (stringp docstring) (setq heads (cons docstring heads)) (setq docstring "hydra")) + (when (keywordp (car body)) + (setq body (cons nil (cons nil body)))) (let* ((keymap (make-sparse-keymap)) (names (mapcar (lambda (x) @@ -148,43 +221,25 @@ HEADS is a list of (KEY CMD &optional HINT)." (body-name (intern (format "%S/body" name))) (body-key (unless (hydra--callablep body) (cadr body))) + (body-color (if (hydra--callablep body) + 'red + (or (plist-get (cddr body) :color) + 'red))) (method (if (hydra--callablep body) body (car body))) - (hint (format "%s: %s." - docstring - (mapconcat - (lambda (h) - (format - (if (cl-caddr h) - (concat "[%s]: " (cl-caddr h)) - "%s") - (propertize (car h) 'face 'font-lock-keyword-face))) - heads ", "))) - (doc (format - "Create a hydra with %s body and the heads:\n\n%s\n\n%s" - (if body-key - (format "a \"%s\"" body-key) - "no") - (mapconcat - (lambda (x) - (format "\"%s\": `%S'" (car x) (cadr x))) - heads ",\n") - (format "The body can be accessed via `%S'." body-name)))) + (hint (hydra--hint docstring heads)) + (doc (hydra--doc body-key body-name heads))) `(progn ,@(cl-mapcar (lambda (head name) `(defun ,name () ,(format "%s\n\nCall the head: `%S'." doc (cadr head)) (interactive) - ,@(if (null (cadr head)) - `((if (functionp hydra-last) - (funcall hydra-last) - (while (and (consp (car emulation-mode-map-alists)) - (consp (caar emulation-mode-map-alists)) - (equal (cl-cdaar emulation-mode-map-alists) ',keymap)) - (setq emulation-mode-map-alists - (cdr emulation-mode-map-alists))))) + ,@(if (eq (hydra--color head body-color) 'blue) + `((hydra-disable) + ,@(unless (null (cadr head)) + `((call-interactively #',(cadr head))))) `((call-interactively #',(cadr head)) (when hydra-is-helpful (message ,hint))