[elpa] master ca6142f: hydra: New package

[Oleh Krehel]

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

    hydra: New package
---
 packages/hydra/hydra-examples.el |   85 +++++++++++++++++++++
 packages/hydra/hydra.el          |  154 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 239 insertions(+), 0 deletions(-)

diff --git a/packages/hydra/hydra-examples.el b/packages/hydra/hydra-examples.el
new file mode 100644
index 0000000..c07bd8e
--- /dev/null
+++ b/packages/hydra/hydra-examples.el
@@ -0,0 +1,85 @@
+;;; hydra-examples.el --- Some applications for Hydra
+
+;; Copyright (C) 2015  Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; These are the sample Hydras that you can use.
+
+;;; Code:
+
+(require 'hydra)
+
+(defvar hydra-example-text-scale
+  '(("g" text-scale-increase "zoom in")
+    ("l" text-scale-decrease "zoom out"))
+  "A two-headed hydra for text scale manipulation.")
+
+(require 'windmove)
+
+(defun hydra-move-splitter-left ()
+  "Move window splitter left."
+  (interactive)
+  (if (let ((windmove-wrap-around))
+        (windmove-find-other-window 'right))
+      (shrink-window-horizontally 1)
+    (enlarge-window-horizontally 1)))
+
+(defun hydra-move-splitter-right ()
+  "Move window splitter right."
+  (interactive)
+  (if (let ((windmove-wrap-around))
+        (windmove-find-other-window 'right))
+      (enlarge-window-horizontally 1)
+    (shrink-window-horizontally 1)))
+
+(defun hydra-move-splitter-up ()
+  "Move window splitter up."
+  (interactive)
+  (if (let ((windmove-wrap-around))
+        (windmove-find-other-window 'up))
+      (enlarge-window 1)
+    (shrink-window 1)))
+
+(defun hydra-move-splitter-down ()
+  "Move window splitter down."
+  (interactive)
+  (if (let ((windmove-wrap-around))
+        (windmove-find-other-window 'up))
+      (shrink-window 1)
+    (enlarge-window 1)))
+
+(defvar hydra-example-move-window-splitter
+  '(("h" hydra-move-splitter-left)
+    ("j" hydra-move-splitter-down)
+    ("k" hydra-move-splitter-up)
+    ("l" hydra-move-splitter-right))
+  "A four-headed hydra for the window splitter manipulation.
+Works best if you have not more than 4 windows.")
+
+(defvar hydra-example-goto-error
+  '(("h" first-error "first")
+    ("j" next-error "next")
+    ("k" previous-error "prev"))
+  "A three-headed hydra for jumping between \"errors\".
+Useful for e.g. `occur', `rgrep' and the like.")
+
+(provide 'hydra-examples)
+;;; hydra-examples.el ends here
diff --git a/packages/hydra/hydra.el b/packages/hydra/hydra.el
new file mode 100644
index 0000000..932cea2
--- /dev/null
+++ b/packages/hydra/hydra.el
@@ -0,0 +1,154 @@
+;;; hydra.el --- Make bindings that stick around
+
+;; Copyright (C) 2015  Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel <address@hidden>
+;; Maintainer: Oleh Krehel <address@hidden>
+;; URL: https://github.com/abo-abo/hydra
+;; Version: 0.3.0
+;; Keywords: bindings
+;; Package-Requires: ((cl-lib "0.5"))
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package can be used to tie related commands into a family of
+;; short bindings with a common prefix - a Hydra.
+;;
+;; Once you summon the Hydra (through the prefixed binding), all the
+;; heads can be called in succession with only a short extension.
+;; The Hydra is vanquished once Hercules, any binding that isn't the
+;; Hydra's head, arrives.  Note that Hercules, besides vanquishing the
+;; 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 automagically.
+;;
+;; Here's how to use the examples bundled with Hydra:
+;;
+;;    (require 'hydra-examples)
+;;    (hydra-create "C-M-y" hydra-example-move-window-splitter)
+;;    (hydra-create "M-g" hydra-example-goto-error)
+;;
+;; You can expand the examples in-place, it still looks elegant:
+;;
+;;     (hydra-create "<f2>"
+;;       '(("g" text-scale-increase "zoom in")
+;;         ("l" text-scale-decrease "zoom out")))
+;;
+;; The third element of each list is the optional doc string that will
+;; be displayed in the echo area when `hydra-is-helpful' is t.
+
+;;; Code:
+(require 'cl-lib)
+
+(defgroup hydra nil
+  "Make bindings that stick around."
+  :group 'bindings
+  :prefix "hydra-")
+
+(defcustom hydra-is-helpful t
+  "When t, display a hint with possible bindings in the echo area."
+  :type 'boolean
+  :group 'hydra)
+
+(defalias 'hydra-set-transient-map
+  (if (fboundp 'set-transient-map)
+      'set-transient-map
+    'set-temporary-overlay-map))
+
+(defvar hydra-last nil
+  "The result of the last `hydra-set-transient-map' call.")
+
+;;;###autoload
+(defmacro hydra-create (body heads &optional method)
+  "Create a hydra with a BODY prefix and HEADS with METHOD.
+This will result in `global-set-key' statements with the keys
+being the concatenation of BODY and each head in HEADS.  HEADS is
+an list of (KEY FUNCTION &optional HINT).
+
+After one of the HEADS is called via BODY+KEY, it and the other
+HEADS can be called with only KEY (no need for BODY).  This state
+is broken once any key binding that is not in HEADS is called.
+
+METHOD is a lambda takes two arguments: a KEY and a COMMAND.
+It defaults to `global-set-key'.
+When `(keymapp METHOD)`, it becomes:
+
+    (lambda (key command) (define-key METHOD key command))"
+  (declare (indent 1))
+  (let* ((keymap (make-sparse-keymap))
+         (heads (eval heads))
+         (names (mapcar
+                 (lambda (x)
+                   (define-key keymap (kbd (car x))
+                     (intern (format "hydra-%s-%S" body (cadr x)))))
+                 heads))
+         (hint (format "hydra: %s."
+                       (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 a \"%s\" body and the heads:\n\n%s."
+               body
+               (mapconcat
+                (lambda (x)
+                  (format "\"%s\":    `%S'" (car x) (cadr x)))
+                heads ",\n")))
+         map
+         (method
+          (cond ((null method)
+                 (unless (keymapp (global-key-binding (kbd body)))
+                   (global-set-key (kbd body) nil))
+                 'global-set-key)
+                ((keymapp (setq map (eval method)))
+                 (unless (keymapp (lookup-key map (kbd body)))
+                   (define-key map (kbd body) nil))
+                 `(lambda (key command)
+                    (define-key ,method key command)))
+                (t
+                 method))))
+    `(progn
+       ,@(cl-mapcar
+          (lambda (head name)
+            `(defun ,name ()
+               ,(format "%s\n\nCall the head: `%S'." doc (cadr head))
+               (interactive)
+               ,@(if (null (cadr head))
+                     '((funcall hydra-last))
+                     `((call-interactively #',(cadr head))
+                       (when hydra-is-helpful
+                         (message ,hint))
+                       (setq hydra-last (hydra-set-transient-map ',keymap 
t))))))
+          heads names)
+       (defun ,(intern (format "hydra-%s-body" body)) ()
+         ,doc
+         (interactive)
+         (when hydra-is-helpful
+           (message ,hint))
+         (setq hydra-last (hydra-set-transient-map ',keymap t)))
+       ,@(cl-mapcar
+          (lambda (head name)
+            `(,method ,(vconcat (kbd body) (kbd (car head))) #',name))
+          heads names))))
+
+(provide 'hydra)
+;;; hydra.el ends here