code.delx.au - gnu-emacs-elpa/blob - hydra.el

   1 ;;; hydra.el --- make bindings that stick around.
   2
   3 ;; Copyright (C) 2015 Oleh Krehel
   4
   5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
   6 ;; URL: https://github.com/abo-abo/hydra
   7 ;; Version: 0.1.0
   8 ;; Package-Requires: ((cl-lib "0.5"))
   9 ;; Keywords: bindings
  10
  11 ;; This file is not part of GNU Emacs
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 3, or (at your option)
  16 ;; any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; For a full copy of the GNU General Public License
  24 ;; see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; This package can be used to tie related commands into a family of
  29 ;; short bindings with a common prefix - a Hydra.
  30 ;;
  31 ;; Once you summon the Hydra (through the prefixed binding), all the
  32 ;; heads can be called in succession with only a short extension.  The
  33 ;; Hydra is vanquished once Hercules, any binding that isn't the
  34 ;; Hydra's head, arrives.  Note that Hercules, besides vanquishing the
  35 ;; Hydra, will still serve his orignal purpose, calling his proper
  36 ;; command.  This makes the Hydra very seamless, it's like a minor
  37 ;; mode that disables itself automagically.
  38 ;;
  39 ;; Here's how I use the examples bundled with Hydra:
  40 ;;
  41 ;;    (require 'hydra-examples)
  42 ;;    (hydra-create "C-M-w" hydra-example-move-window-splitter)
  43 ;;
  44 ;; You can expand the examples in-place, it still looks elegant:
  45 ;;
  46 ;;     (hydra-create "<f2>"
  47 ;;       '(("g" . text-scale-increase)
  48 ;;         ("l" . text-scale-decrease)))
  49
  50 ;;; Code:
  51 (require 'cl-lib)
  52
  53 (defgroup hydra nil
  54   "Make bindings that stick around."
  55   :group 'bindings
  56   :prefix "hydra-")
  57
  58 (defcustom hydra-is-helpful t
  59   "When t, display a hint with possible bindings in the echo area."
  60   :type 'boolean
  61   :group 'hydra)
  62
  63 ;;;###autoload
  64 (defmacro hydra-create (body heads &optional method)
  65   "Create a hydra with a BODY prefix and HEADS with METHOD.
  66 This will result in `global-set-key' statements with the keys
  67 being the concatenation of BODY and each head in HEADS.  HEADS is
  68 an alist of (KEY . FUNCTION).
  69
  70 After one of the HEADS is called via BODY+KEY, it and the other
  71 HEADS can be called with only KEY (no need for BODY).  This state
  72 is broken once any key binding that is not in HEADS is called.
  73
  74 METHOD is a lambda takes two arguments: a KEY and a COMMAND.
  75 It defaults to `global-set-key'.
  76 When `(keymapp METHOD)`, it becomes:
  77
  78     (lambda (key command) (define-key METHOD key command))"
  79   (declare (indent 1))
  80   (let* ((keymap (make-sparse-keymap))
  81          (heads (eval heads))
  82          (names (mapcar
  83                  (lambda (x)
  84                    (define-key keymap (car x)
  85                      (intern (format "hydra-%s-%S" body (cdr x)))))
  86                  heads))
  87          (method (cond ((null method)
  88                         'global-set-key)
  89
  90                        ((keymapp (eval method))
  91                         `(lambda (key command) (define-key ,method key command)))
  92
  93                        (t
  94                         method)))
  95          (hint (concat "hydra: " (mapconcat #'car heads " "))))
  96     `(progn
  97        (,method ,(kbd body) nil)
  98        ,@(cl-mapcar
  99           (lambda (head name)
 100             `(defun ,name ()
 101                ,(format
 102                  "Create a hydra with a \"%s\" body and the heads:
 103
 104 %s.
 105
 106 Call the head: `%S'."
 107                  body
 108                  (mapconcat
 109                   (lambda (x)
 110                     (format "\"%s\":    `%S'" (car x) (cdr x)))
 111                   heads ",\n")
 112                  (cdr head))
 113                (interactive)
 114                (call-interactively #',(cdr head))
 115                (when hydra-is-helpful
 116                  (message ,hint))
 117                (set-transient-map ',keymap t)))
 118           heads names)
 119        ,@(cl-mapcar
 120           (lambda (head name)
 121             `(,method ,(kbd (concat body " " (car head))) #',name))
 122           heads names))))
 123
 124 (provide 'hydra)
 125
 126 ;;; hydra.el ends here