From f16dfc70ef5f2ed0dc10d66508d67592c6b237b9 Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 26 Jul 2017 10:47:38 -0300 Subject: Import hydra-el_0.14-1.debian.tar.xz [dgit import tarball hydra-el 0.14-1 hydra-el_0.14-1.debian.tar.xz] --- changelog | 22 ++++++++++++++++++++++ compat | 1 + control | 29 +++++++++++++++++++++++++++++ copyright | 29 +++++++++++++++++++++++++++++ docs | 1 + elpa | 4 ++++ patches/0001-clean-documentation.diff | 31 +++++++++++++++++++++++++++++++ patches/series | 1 + rules | 4 ++++ source/format | 1 + watch | 4 ++++ 11 files changed, 127 insertions(+) create mode 100644 changelog create mode 100644 compat create mode 100644 control create mode 100644 copyright create mode 100644 docs create mode 100644 elpa create mode 100644 patches/0001-clean-documentation.diff create mode 100644 patches/series create mode 100755 rules create mode 100644 source/format create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 0000000..5ce32e2 --- /dev/null +++ b/changelog @@ -0,0 +1,22 @@ +hydra-el (0.14-1) unstable; urgency=medium + + * New upstream version 0.14 + * Clean d/control: remove hardcoded dependency on emacsen-common and + Built-Using field + + -- Lev Lamberov Wed, 26 Jul 2017 18:47:38 +0500 + +hydra-el (0.13.6-2) unstable; urgency=medium + + [ Nicholas D Steeves ] + * Make dependencies comply with Debian Emacs Policy. + - debian/control: Depend on emacsen-common (>= 2.0.8) instead of emacs. + * debian/control: Bump Standards-Version to 4.0.0 (no changes needed). + + -- Lev Lamberov Thu, 13 Jul 2017 17:55:08 +0500 + +hydra-el (0.13.6-1) unstable; urgency=low + + * Initial release (Closes: #843075) + + -- Lev Lamberov Thu, 3 Nov 2016 18:50:41 +0500 diff --git a/compat b/compat new file mode 100644 index 0000000..f599e28 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +10 diff --git a/control b/control new file mode 100644 index 0000000..417f40c --- /dev/null +++ b/control @@ -0,0 +1,29 @@ +Source: hydra-el +Section: lisp +Priority: optional +Maintainer: Debian Emacs addons team +Uploaders: Lev Lamberov +Build-Depends: debhelper (>= 10), + dh-elpa +Standards-Version: 4.0.0 +Testsuite: autopkgtest-pkg-elpa +Homepage: https://github.com/abo-abo/hydra +Vcs-Browser: https://anonscm.debian.org/cgit/pkg-emacsen/pkg/hydra-el.git/ +Vcs-Git: https://anonscm.debian.org/git/pkg-emacsen/pkg/hydra-el.git + +Package: elpa-hydra +Architecture: all +Depends: ${elpa:Depends}, + ${misc:Depends} +Recommends: emacs (>= 46.0) +Enhances: emacs, + emacs24, + emacs25 +Description: make Emacs bindings that stick around + 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. Once you summon + your Hydra through the prefixed binding (the body + any one head), all heads + can be called in succession with only a short extension. Hydra can be vanished + with any binding that isn't the Hydra's head (and that binding will call a + proper command too). This makes the Hydra very seamless, it's like a minor + mode that disables itself automagically. diff --git a/copyright b/copyright new file mode 100644 index 0000000..4ae505b --- /dev/null +++ b/copyright @@ -0,0 +1,29 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: hydra +Upstream-Contact: Oleh Krehel +Source: https://github.com/abo-abo/hydra + +Files: * +Copyright: (C) 2015 Free Software Foundation, Inc. +License: GPL-3+ + +Files: debian/* +Copyright: (C) 2016 Lev Lamberov +License: GPL-3+ + +License: GPL-3+ + This program 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. + . + This program 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 this program. If not, see . + . + On Debian systems, the complete text of the GNU General + Public License version 3 can be found in `/usr/share/common-licenses/GPL-3' diff --git a/docs b/docs new file mode 100644 index 0000000..dd44972 --- /dev/null +++ b/docs @@ -0,0 +1 @@ +*.md diff --git a/elpa b/elpa new file mode 100644 index 0000000..95380f2 --- /dev/null +++ b/elpa @@ -0,0 +1,4 @@ +hydra.el +hydra-examples.el +hydra-ox.el +lv.el diff --git a/patches/0001-clean-documentation.diff b/patches/0001-clean-documentation.diff new file mode 100644 index 0000000..10eaf91 --- /dev/null +++ b/patches/0001-clean-documentation.diff @@ -0,0 +1,31 @@ +From: Lev Lamberov +Subject: Remove badge icon and screenshots from README file + +This patch removes badges icon and screenshots from README files. This icon +is intended rather for developers, badge and screenshots are loaded from +several external web sites and not included in the original source. + +--- a/README.md ++++ b/README.md +@@ -1,10 +1,6 @@ +-[![Build Status](https://travis-ci.org/abo-abo/hydra.svg?branch=master)](https://travis-ci.org/abo-abo/hydra) +- + 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.jpg) +- + ## Description for Poets + + Once you summon the Hydra through the prefixed binding (the body + any one head), all heads can be +@@ -85,10 +81,6 @@ For any Hydra: + + ## The impressive-looking one + +-Here's the result of pressing . in the good-old Buffer menu: +- +-![hydra-buffer-menu](http://oremacs.com/download/hydra-buffer-menu.png) +- + The code is large but very simple: + + ```cl diff --git a/patches/series b/patches/series new file mode 100644 index 0000000..e6c5191 --- /dev/null +++ b/patches/series @@ -0,0 +1 @@ +0001-clean-documentation.diff diff --git a/rules b/rules new file mode 100755 index 0000000..8eb7ccb --- /dev/null +++ b/rules @@ -0,0 +1,4 @@ +#!/usr/bin/make -f + +%: + dh $@ --parallel --with elpa diff --git a/source/format b/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/watch b/watch new file mode 100644 index 0000000..65a0fcc --- /dev/null +++ b/watch @@ -0,0 +1,4 @@ +version=4 + opts="filenamemangle=s%(?:.*?)?v?(\d[\d.]*)\.tar\.gz%hydra-el-$1.tar.gz%" \ + https://github.com/abo-abo/hydra/tags \ + (?:.*?/)?v?(\d[\d.]*)\.tar\.gz debian uupdate -- cgit v1.2.3 From 01dcb620ae9871604d0617daa28d85d6fbff9580 Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 26 Jul 2017 10:47:38 -0300 Subject: Import hydra-el_0.14.orig.tar.gz [dgit import orig hydra-el_0.14.orig.tar.gz] --- .dir-locals.el | 6 + .elpaignore | 6 + .travis.yml | 14 + Makefile | 22 + README.md | 422 +++++++++++++ hydra-examples.el | 386 ++++++++++++ hydra-ox.el | 127 ++++ hydra-test.el | 1561 +++++++++++++++++++++++++++++++++++++++++++++++++ hydra.el | 1403 ++++++++++++++++++++++++++++++++++++++++++++ lv.el | 117 ++++ targets/hydra-init.el | 27 + 11 files changed, 4091 insertions(+) create mode 100644 .dir-locals.el create mode 100644 .elpaignore create mode 100644 .travis.yml create mode 100644 Makefile create mode 100644 README.md create mode 100644 hydra-examples.el create mode 100644 hydra-ox.el create mode 100644 hydra-test.el create mode 100644 hydra.el create mode 100644 lv.el create mode 100644 targets/hydra-init.el diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..eb08357 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,6 @@ +;;; Directory Local Variables +;;; For more information see (info "(emacs) Directory Variables") + +((emacs-lisp-mode + (bug-reference-url-format . "https://github.com/abo-abo/hydra/issues/%s") + (indent-tabs-mode . nil))) diff --git a/.elpaignore b/.elpaignore new file mode 100644 index 0000000..a6b1577 --- /dev/null +++ b/.elpaignore @@ -0,0 +1,6 @@ +targets/ +.travis.yml +.dir-locals.el +Makefile +README.md +hydra-test.el diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..e97acdb --- /dev/null +++ b/.travis.yml @@ -0,0 +1,14 @@ +language: emacs-lisp +env: + matrix: + - emacs=emacs24 + - emacs=emacs-snapshot + +before_install: + - sudo add-apt-repository -y ppa:cassou/emacs + - sudo add-apt-repository -y ppa:ubuntu-elisp + - sudo apt-get update -qq + - sudo apt-get install -qq $emacs + +script: + - make test diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..13fd618 --- /dev/null +++ b/Makefile @@ -0,0 +1,22 @@ +emacs ?= emacs +# emacs = emacs-24.3 + +LOAD = -l lv.el -l hydra.el -l hydra-test.el + +.PHONY: all test clean + +all: test + +test: + @echo "Using $(shell which $(emacs))..." + $(emacs) -batch $(LOAD) -f ert-run-tests-batch-and-exit + +run: + $(emacs) -q $(LOAD) -l targets/hydra-init.el + make clean + +compile: + $(emacs) -batch $(LOAD) -l targets/hydra-init.el + +clean: + rm -f *.elc diff --git a/README.md b/README.md new file mode 100644 index 0000000..d2237d8 --- /dev/null +++ b/README.md @@ -0,0 +1,422 @@ +[![Build Status](https://travis-ci.org/abo-abo/hydra.svg?branch=master)](https://travis-ci.org/abo-abo/hydra) + +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.jpg) + +## Description for Poets + +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. + +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 original purpose, calling his proper +command. This makes the Hydra very seamless, it's like a minor mode that disables itself +auto-magically. + +## Description for Pragmatics + +Imagine that you have bound C-c j and C-c k in your +config. You want to call C-c j and C-c k in some +(arbitrary) sequence. Hydra allows you to: + +- Bind your functions in a way that pressing C-c jjkk3j5k is +equivalent to pressing C-c j C-c j C-c k C-c k M-3 C-c j M-5 C-c +k. Any key other than j or k exits this state. + +- Assign a custom hint to this group of functions, so that you know immediately +after pressing C-c that you can follow up with j or +k. + +If you want to quickly understand the concept, see [the video demo](https://www.youtube.com/watch?v=_qZliI1BKzI). + + +**Table of Contents** + +- [Sample Hydras](#sample-hydras) + - [The one with the least amount of code](#the-one-with-the-least-amount-of-code) + - [The impressive-looking one](#the-impressive-looking-one) +- [Community wiki](#community-wiki) +- [The Rules of Hydra-tics](#the-rules-of-hydra-tics) + - [`hydra-awesome`](#hydra-awesome) + - [`awesome-map` and `awesome-binding`](#awesome-map-and-awesome-binding) + - [`awesome-plist`](#awesome-plist) + - [`:pre` and `:post`](#pre-and-post) + - [`:exit`](#exit) + - [`:foreign-keys`](#foreign-keys) + - [`:color`](#color) + - [`:timeout`](#timeout) + - [`:hint`](#hint) + - [`:bind`](#bind) + - [`awesome-docstring`](#awesome-docstring) + - [`awesome-head-1`](#awesome-head-1) + - [`head-binding`](#head-binding) + - [`head-command`](#head-command) + - [`head-hint`](#head-hint) + - [`head-plist`](#head-plist) + + + +# Sample Hydras + +## The one with the least amount of code + +```cl +(defhydra hydra-zoom (global-map "") + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +With this simple code, you can: + +- Start zooming in with <f2> g. +- Continue to zoom in with g. +- Or zoom out with l. +- Zoom in five times at once with 5g. +- Stop zooming with *any* key that isn't g or l. + +For any Hydra: + +- `digit-argument` can be called with 0-9. +- `negative-argument` can be called with -. +- `universal-argument` can be called with C-u. + +## The impressive-looking one + +Here's the result of pressing . in the good-old Buffer menu: + +![hydra-buffer-menu](http://oremacs.com/download/hydra-buffer-menu.png) + +The code is large but very simple: + +```cl +(defhydra hydra-buffer-menu (:color pink + :hint nil) + " +^Mark^ ^Unmark^ ^Actions^ ^Search +^^^^^^^^----------------------------------------------------------------- +_m_: mark _u_: unmark _x_: execute _R_: re-isearch +_s_: save _U_: unmark up _b_: bury _I_: isearch +_d_: delete ^ ^ _g_: refresh _O_: multi-occur +_D_: delete up ^ ^ _T_: files only: % -28`Buffer-menu-files-only +_~_: modified +" + ("m" Buffer-menu-mark) + ("u" Buffer-menu-unmark) + ("U" Buffer-menu-backup-unmark) + ("d" Buffer-menu-delete) + ("D" Buffer-menu-delete-backwards) + ("s" Buffer-menu-save) + ("~" Buffer-menu-not-modified) + ("x" Buffer-menu-execute) + ("b" Buffer-menu-bury) + ("g" revert-buffer) + ("T" Buffer-menu-toggle-files-only) + ("O" Buffer-menu-multi-occur :color blue) + ("I" Buffer-menu-isearch-buffers :color blue) + ("R" Buffer-menu-isearch-buffers-regexp :color blue) + ("c" nil "cancel") + ("v" Buffer-menu-select "select" :color blue) + ("o" Buffer-menu-other-window "other-window" :color blue) + ("q" quit-window "quit" :color blue)) + +(define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body) +``` + +Looking at the code, you can see `hydra-buffer-menu` as sort of a namespace construct that wraps +each function that it's given in code that shows that hint and makes it easy to call the related +functions. One additional function is created and returned as the result of `defhydra` - +`hydra-buffer-menu/body`. This function does nothing except setting up the hint and the keymap, and +is usually the entry point to complex hydras. + +To write your own hydras, you can: + +- Either modify an existing hydra to do what you want to do. +- Or read [the rules](#the-rules-of-hydra-tics), + [the examples](https://github.com/abo-abo/hydra/blob/master/hydra-examples.el), + the docstrings and comments in the source. + +# Community wiki + +You can find some user created hydras and more documentation in the project's +[community wiki](https://github.com/abo-abo/hydra/wiki/). Feel free to add your +own or edit the existing ones. + +# The Rules of Hydra-tics + +Each hydra (take `awesome` as a prefix to make it more specific) looks like this: + +``` +(defhydra hydra-awesome (awesome-map awesome-binding awesome-plist) + awesome-docstring + awesome-head-1 + awesome-head-2 + awesome-head-3 + ...) +``` + +## `hydra-awesome` + +Each hydra needs a name, and this one is named `hydra-awesome`. You can name your hydras as you wish, +but I prefer to start each one with `hydra-`, because it acts as an additional namespace layer, for example: +`hydra-zoom`, `hydra-helm`, `hydra-apropos` etc. + +If you name your hydra `hydra-awesome`, the return result of `defhydra` will be `hydra-awesome/body`. + +Here's what `hydra-zoom/body` looks like, if you're interested: + +```cl +(defun hydra-zoom/body nil + "Create a hydra with a \"\" body and the heads: + +\"g\": `text-scale-increase', +\"l\": `text-scale-decrease' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (hydra-default-pre) + (when hydra-is-helpful + (if hydra-lv + (lv-message + (eval hydra-zoom/hint)) + (message + (eval hydra-zoom/hint)))) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)) +``` + +## `awesome-map` and `awesome-binding` + +This can be any keymap, for instance, `global-map` or `isearch-mode-map`. + +For this example: + +```cl +(defhydra hydra-zoom (global-map "") + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +- `awesome-map` is `global-map` +- `awesome-binding` is `""` + +And here's the relevant generated code: + +```cl +(unless (keymapp (lookup-key global-map (kbd ""))) + (define-key global-map (kbd "") nil)) +(define-key global-map [f2 103] + (function hydra-zoom/text-scale-increase)) +(define-key global-map [f2 108] + (function hydra-zoom/text-scale-decrease)) +``` + +As you see, `""` is used as a prefix for g (char value 103) and l +(char value 108). + +If you don't want to use a map right now, you can skip it like this: + +```cl +(defhydra hydra-zoom (nil nil) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +Or even simpler: + +```cl +(defhydra hydra-zoom () + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +But then you would have to bind `hydra-zoom/text-scale-increase` and +`hydra-zoom/text-scale-decrease` yourself. + +## `awesome-plist` + +You can read up on what a plist is in +[the Elisp manual](https://www.gnu.org/software/emacs/manual/html_node/elisp/Property-Lists.html). + +You can use `awesome-plist` to modify the behavior of each head in some way. +Below is a list of each key. + +### `:pre` and `:post` + +You can specify code that will be called before each head, and after the body. For example: + +```cl +(defhydra hydra-vi (:pre (set-cursor-color "#40e0d0") + :post (progn + (set-cursor-color "#ffffff") + (message + "Thank you, come again."))) + "vi" + ("l" forward-char) + ("h" backward-char) + ("j" next-line) + ("k" previous-line) + ("q" nil "quit")) +``` + +Thanks to `:pre`, each time any head is called, the cursor color is changed. +And when the hydra quits, the cursor color will be made black again with `:post`. + +### `:exit` + +The `:exit` key is inherited by every head (they can override it) and influences what will happen +after executing head's command: + +- `:exit nil` (the default) means that the hydra state will continue - you'll still see the hint and be able to use short bindings. +- `:exit t` means that the hydra state will stop. + +### `:foreign-keys` + +The `:foreign-keys` key belongs to the body and decides what to do when a key is pressed that doesn't +belong to any head: + +- `:foreign-keys nil` (the default) means that the hydra state will stop and the foreign key will +do whatever it was supposed to do if there was no hydra state. +- `:foreign-keys warn` will not stop the hydra state, but instead will issue a warning without +running the foreign key. +- `:foreign-keys run` will not stop the hydra state, and try to run the foreign key. + +### `:color` + +The `:color` key is a shortcut. It aggregates `:exit` and `:foreign-keys` key in the following way: + + | color | toggle | + |----------+----------------------------| + | red | | + | blue | :exit t | + | amaranth | :foreign-keys warn | + | teal | :foreign-keys warn :exit t | + | pink | :foreign-keys run | + +It's also a trick to make you instantly aware of the current hydra keys that you're about to press: +the keys will be highlighted with the appropriate color. + +### `:timeout` + +The `:timeout` key starts a timer for the corresponding amount of seconds that disables the hydra. +Calling any head will refresh the timer. + +### `:hint` + +The `:hint` key will be inherited by each head. Each head is allowed to override it, of course. +One value that makes sense is `:hint nil`. See below for an explanation of head hint. + +### `:bind` + +The `:bind` key provides a lambda to be used to bind each head. This is quite advanced and rarely +used, you're not likely to need it. But if you would like to bind your heads with e.g. `bind-key` +instead of `define-key` you can use this option. + +The `:bind` key can be overridden by each head. This is useful if you want to have a few heads that +are not bound outside the hydra. + +## `awesome-docstring` + +This can be a simple string used to build the final hydra hint. However, if you start it with a +newline, the key-highlighting and Ruby-style string interpolation becomes enabled, as you can see in +`hydra-buffer-menu` above. + +To highlight a key, just wrap it in underscores. Note that the key must belong to one of the heads. +The key will be highlighted with the color that is appropriate to the behavior of the key, i.e. if +the key will make the hydra exit, the color will be blue. + +To insert an empty character, use `^`. The only use of this is to have your code aligned as +nicely as the result. + +To insert a dynamic Elisp variable, use `%`` followed by the variable. Each time the variable +changes due to a head, the docstring will be updated. `format`-style width specifiers can be used. + +To insert a dynamic Elisp expression, use e.g. `%(length (dired-get-marked-files))`. If a head will +change the amount of marked files, for example, it will be appropriately updated. + +If the result of the Elisp expression is a string and you don't want to quote it, use this form: +`%s(shell-command-to-string "du -hs")`. + +## `awesome-head-1` + +Each head looks like this: + +```cl +(head-binding head-command head-hint head-plist) +``` + +For the head `("g" text-scale-increase "in")`: + +- `head-binding` is `"g"`. +- `head-command` is `text-scale-increase`. +- `head-hint` is `"in"`. +- `head-plist` is `nil`. + +### `head-binding` + +The `head-binding` is a string that can be passed to `kbd`. + +### `head-command` + +The `head-command` can be: + +- command name, like `text-scale-increase`. +- a lambda, like + + ("g" (lambda () + (interactive) + (let ((current-prefix-arg 4)) + (call-interactively #'magit-status))) + "git") + +- nil, which exits the hydra. +- a single sexp, which will be wrapped in an interactive lambda. + +Here's an example of the last option: + +```cl +(defhydra hydra-launcher (:color blue) + "Launch" + ("h" man "man") + ("r" (browse-url "http://www.reddit.com/r/emacs/") "reddit") + ("w" (browse-url "http://www.emacswiki.org/") "emacswiki") + ("s" shell "shell") + ("q" nil "cancel")) +(global-set-key (kbd "C-c r") 'hydra-launcher/body) +``` + +### `head-hint` + +In case of a large body docstring, you usually don't want the head hint to show up, since +you've already documented it the the body docstring. +You can set the head hint to `nil` to do this. + +Example: + +```cl +(defhydra hydra-zoom (global-map "") + " +Press _g_ to zoom in. +" + ("g" text-scale-increase nil) + ("l" text-scale-decrease "out")) +``` + +### `head-plist` + +Here's a list of body keys that can be overridden in each head: + +- `:exit` +- `:color` +- `:bind` diff --git a/hydra-examples.el b/hydra-examples.el new file mode 100644 index 0000000..70f75b0 --- /dev/null +++ b/hydra-examples.el @@ -0,0 +1,386 @@ +;;; 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 . + +;;; Commentary: +;; +;; These are the sample Hydras. +;; +;; If you want to use them plainly, set `hydra-examples-verbatim' to t +;; before requiring this file. But it's probably better to only look +;; at them and use them as templates for building your own. + +;;; Code: + +(require 'hydra) + +;;* Examples +;;** Example 1: text scale +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-zoom (global-map "") + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out"))) + +;; This example generates three commands: +;; +;; `hydra-zoom/text-scale-increase' +;; `hydra-zoom/text-scale-decrease' +;; `hydra-zoom/body' +;; +;; In addition, two of them are bound like this: +;; +;; (global-set-key (kbd " g") 'hydra-zoom/text-scale-increase) +;; (global-set-key (kbd " l") 'hydra-zoom/text-scale-decrease) +;; +;; Note that you can substitute `global-map' with e.g. `emacs-lisp-mode-map' if you need. +;; The functions generated will be the same, except the binding code will change to: +;; +;; (define-key emacs-lisp-mode-map [f2 103] +;; (function hydra-zoom/text-scale-increase)) +;; (define-key emacs-lisp-mode-map [f2 108] +;; (function hydra-zoom/text-scale-decrease)) + +;;** Example 2: move window splitter +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-splitter (global-map "C-M-s") + "splitter" + ("h" hydra-move-splitter-left) + ("j" hydra-move-splitter-down) + ("k" hydra-move-splitter-up) + ("l" hydra-move-splitter-right))) + +;;** Example 3: jump to error +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-error (global-map "M-g") + "goto-error" + ("h" first-error "first") + ("j" next-error "next") + ("k" previous-error "prev") + ("v" recenter-top-bottom "recenter") + ("q" nil "quit"))) + +;; This example introduces only one new thing: since the command +;; passed to the "q" head is nil, it will quit the Hydra without doing +;; anything. Heads that quit the Hydra instead of continuing are +;; referred to as having blue :color. All the other heads have red +;; :color, unless other is specified. + +;;** Example 4: toggle rarely used modes +(when (bound-and-true-p hydra-examples-verbatim) + (defvar whitespace-mode nil) + (global-set-key + (kbd "C-c C-v") + (defhydra hydra-toggle-simple (: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")))) + +;; Note that in this case, `defhydra' returns the `hydra-toggle-simple/body' +;; symbol, which is then passed to `global-set-key'. +;; +;; Another new thing is that both the keymap and the body prefix are +;; skipped. This means that `defhydra' will bind nothing - that's why +;; `global-set-key' is necessary. +;; +;; One more new thing is that you can assign a :color to the body. All +;; heads will inherit this color. The code above is very much equivalent to: +;; +;; (global-set-key (kbd "C-c C-v a") 'abbrev-mode) +;; (global-set-key (kbd "C-c C-v d") 'toggle-debug-on-error) +;; +;; The differences are: +;; +;; * You get a hint immediately after "C-c C-v" +;; * You can cancel and call a command immediately, e.g. "C-c C-v C-n" +;; is equivalent to "C-n" with Hydra approach, while it will error +;; that "C-c C-v C-n" isn't bound with the usual approach. + +;;** Example 5: mini-vi +(defun hydra-vi/pre () + (set-cursor-color "#e52b50")) + +(defun hydra-vi/post () + (set-cursor-color "#ffffff")) + +(when (bound-and-true-p hydra-examples-verbatim) + (global-set-key + (kbd "C-z") + (defhydra hydra-vi (:pre hydra-vi/pre :post hydra-vi/post :color amaranth) + "vi" + ("l" forward-char) + ("h" backward-char) + ("j" next-line) + ("k" previous-line) + ("m" set-mark-command "mark") + ("a" move-beginning-of-line "beg") + ("e" move-end-of-line "end") + ("d" delete-region "del" :color blue) + ("y" kill-ring-save "yank" :color blue) + ("q" nil "quit"))) + (hydra-set-property 'hydra-vi :verbosity 1)) + +;; This example introduces :color amaranth. It's similar to red, +;; except while you can quit red with any binding which isn't a Hydra +;; head, you can quit amaranth only with a blue head. So you can quit +;; this mode only with "d", "y", "q" or "C-g". +;; +;; Another novelty are the :pre and :post handlers. :pre will be +;; called before each command, while :post will be called when the +;; Hydra quits. In this case, they're used to override the cursor +;; color while Hydra is active. + +;;** Example 6: selective global bind +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-next-error (global-map "C-x") + "next-error" + ("`" next-error "next") + ("j" next-error "next" :bind nil) + ("k" previous-error "previous" :bind nil))) + +;; This example will bind "C-x `" in `global-map', but it will not +;; bind "C-x j" and "C-x k". +;; You can still "C-x `jjk" though. + +;;** Example 7: toggle with Ruby-style docstring +(defvar whitespace-mode nil) +(defhydra hydra-toggle (:color pink) + " +_a_ abbrev-mode: %`abbrev-mode +_d_ debug-on-error: %`debug-on-error +_f_ auto-fill-mode: %`auto-fill-function +_t_ truncate-lines: %`truncate-lines +_w_ whitespace-mode: %`whitespace-mode + +" + ("a" abbrev-mode nil) + ("d" toggle-debug-on-error nil) + ("f" auto-fill-mode nil) + ("t" toggle-truncate-lines nil) + ("w" whitespace-mode nil) + ("q" nil "quit")) +;; Recommended binding: +;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body) + +;; Here, using e.g. "_a_" translates to "a" with proper face. +;; More interestingly: +;; +;; "foobar %`abbrev-mode" means roughly (format "foobar %S" abbrev-mode) +;; +;; This means that you actually see the state of the mode that you're changing. + +;;** Example 8: the whole menu for `Buffer-menu-mode' +(defhydra hydra-buffer-menu (:color pink + :hint nil) + " +^Mark^ ^Unmark^ ^Actions^ ^Search +^^^^^^^^----------------------------------------------------------------- (__) +_m_: mark _u_: unmark _x_: execute _R_: re-isearch (oo) +_s_: save _U_: unmark up _b_: bury _I_: isearch /------\\/ +_d_: delete ^ ^ _g_: refresh _O_: multi-occur / | || +_D_: delete up ^ ^ _T_: files only: % -28`Buffer-menu-files-only^^ * /\\---/\\ +_~_: modified ^ ^ ^ ^ ^^ ~~ ~~ +" + ("m" Buffer-menu-mark) + ("u" Buffer-menu-unmark) + ("U" Buffer-menu-backup-unmark) + ("d" Buffer-menu-delete) + ("D" Buffer-menu-delete-backwards) + ("s" Buffer-menu-save) + ("~" Buffer-menu-not-modified) + ("x" Buffer-menu-execute) + ("b" Buffer-menu-bury) + ("g" revert-buffer) + ("T" Buffer-menu-toggle-files-only) + ("O" Buffer-menu-multi-occur :color blue) + ("I" Buffer-menu-isearch-buffers :color blue) + ("R" Buffer-menu-isearch-buffers-regexp :color blue) + ("c" nil "cancel") + ("v" Buffer-menu-select "select" :color blue) + ("o" Buffer-menu-other-window "other-window" :color blue) + ("q" quit-window "quit" :color blue)) +;; Recommended binding: +;; (define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body) + +;;** Example 9: s-expressions in the docstring +;; You can inline s-expresssions into the docstring like this: +(defvar dired-mode-map) +(declare-function dired-mark "dired") +(when (bound-and-true-p hydra-examples-verbatim) + (require 'dired) + (defhydra hydra-marked-items (dired-mode-map "") + " +Number of marked items: %(length (dired-get-marked-files)) +" + ("m" dired-mark "mark"))) + +;; This results in the following dynamic docstring: +;; +;; (format "Number of marked items: %S\n" +;; (length (dired-get-marked-files))) +;; +;; You can use `format'-style width specs, e.g. % 10(length nil). + +;;** Example 10: apropos family +(defhydra hydra-apropos (:color blue + :hint nil) + " +_a_propos _c_ommand +_d_ocumentation _l_ibrary +_v_ariable _u_ser-option +^ ^ valu_e_" + ("a" apropos) + ("d" apropos-documentation) + ("v" apropos-variable) + ("c" apropos-command) + ("l" apropos-library) + ("u" apropos-user-option) + ("e" apropos-value)) +;; Recommended binding: +;; (global-set-key (kbd "C-c h") 'hydra-apropos/body) + +;;** Example 11: rectangle-mark-mode +(require 'rect) +(defhydra hydra-rectangle (:body-pre (rectangle-mark-mode 1) + :color pink + :post (deactivate-mark)) + " + ^_k_^ _d_elete _s_tring +_h_ _l_ _o_k _y_ank + ^_j_^ _n_ew-copy _r_eset +^^^^ _e_xchange _u_ndo +^^^^ ^ ^ _p_aste +" + ("h" rectangle-backward-char nil) + ("l" rectangle-forward-char nil) + ("k" rectangle-previous-line nil) + ("j" rectangle-next-line nil) + ("e" hydra-ex-point-mark nil) + ("n" copy-rectangle-as-kill nil) + ("d" delete-rectangle nil) + ("r" (if (region-active-p) + (deactivate-mark) + (rectangle-mark-mode 1)) nil) + ("y" yank-rectangle nil) + ("u" undo nil) + ("s" string-rectangle nil) + ("p" kill-rectangle nil) + ("o" nil nil)) + +;; Recommended binding: +;; (global-set-key (kbd "C-x SPC") 'hydra-rectangle/body) + +;;** Example 12: org-agenda-view +(defun org-agenda-cts () + (and (eq major-mode 'org-agenda-mode) + (let ((args (get-text-property + (min (1- (point-max)) (point)) + 'org-last-args))) + (nth 2 args)))) + +(defhydra hydra-org-agenda-view (:hint none) + " +_d_: ?d? day _g_: time grid=?g? _a_: arch-trees +_w_: ?w? week _[_: inactive _A_: arch-files +_t_: ?t? fortnight _f_: follow=?f? _r_: clock report=?r? +_m_: ?m? month _e_: entry text=?e? _D_: include diary=?D? +_y_: ?y? year _q_: quit _L__l__c_: log = ?l?" + ("SPC" org-agenda-reset-view) + ("d" org-agenda-day-view (if (eq 'day (org-agenda-cts)) "[x]" "[ ]")) + ("w" org-agenda-week-view (if (eq 'week (org-agenda-cts)) "[x]" "[ ]")) + ("t" org-agenda-fortnight-view (if (eq 'fortnight (org-agenda-cts)) "[x]" "[ ]")) + ("m" org-agenda-month-view (if (eq 'month (org-agenda-cts)) "[x]" "[ ]")) + ("y" org-agenda-year-view (if (eq 'year (org-agenda-cts)) "[x]" "[ ]")) + ("l" org-agenda-log-mode (format "% -3S" org-agenda-show-log)) + ("L" (org-agenda-log-mode '(4))) + ("c" (org-agenda-log-mode 'clockcheck)) + ("f" org-agenda-follow-mode (format "% -3S" org-agenda-follow-mode)) + ("a" org-agenda-archives-mode) + ("A" (org-agenda-archives-mode 'files)) + ("r" org-agenda-clockreport-mode (format "% -3S" org-agenda-clockreport-mode)) + ("e" org-agenda-entry-text-mode (format "% -3S" org-agenda-entry-text-mode)) + ("g" org-agenda-toggle-time-grid (format "% -3S" org-agenda-use-time-grid)) + ("D" org-agenda-toggle-diary (format "% -3S" org-agenda-include-diary)) + ("!" org-agenda-toggle-deadlines) + ("[" (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-redo) + (message "Display now includes inactive timestamps as well"))) + ("q" (message "Abort") :exit t) + ("v" nil)) + +;; Recommended binding: +;; (define-key org-agenda-mode-map "v" 'hydra-org-agenda-view/body) + +;;* Helpers +(require 'windmove) + +(defun hydra-move-splitter-left (arg) + "Move window splitter left." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'right)) + (shrink-window-horizontally arg) + (enlarge-window-horizontally arg))) + +(defun hydra-move-splitter-right (arg) + "Move window splitter right." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'right)) + (enlarge-window-horizontally arg) + (shrink-window-horizontally arg))) + +(defun hydra-move-splitter-up (arg) + "Move window splitter up." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'up)) + (enlarge-window arg) + (shrink-window arg))) + +(defun hydra-move-splitter-down (arg) + "Move window splitter down." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'up)) + (shrink-window arg) + (enlarge-window arg))) + +(defvar rectangle-mark-mode) +(defun hydra-ex-point-mark () + "Exchange point and mark." + (interactive) + (if rectangle-mark-mode + (rectangle-exchange-point-and-mark) + (let ((mk (mark))) + (rectangle-mark-mode 1) + (goto-char mk)))) + +(provide 'hydra-examples) + +;; Local Variables: +;; no-byte-compile: t +;; End: +;;; hydra-examples.el ends here diff --git a/hydra-ox.el b/hydra-ox.el new file mode 100644 index 0000000..a992efc --- /dev/null +++ b/hydra-ox.el @@ -0,0 +1,127 @@ +;;; hydra-ox.el --- Org mode export widget implemented in 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 . + +;;; Commentary: +;; +;; This shows how a complex dispatch menu can be built with Hydra. + +;;; Code: + +(require 'hydra) +(require 'org) +(declare-function org-html-export-as-html 'ox-html) +(declare-function org-html-export-to-html 'ox-html) +(declare-function org-latex-export-as-latex 'ox-latex) +(declare-function org-latex-export-to-latex 'ox-latex) +(declare-function org-latex-export-to-pdf 'ox-latex) +(declare-function org-ascii-export-as-ascii 'ox-ascii) +(declare-function org-ascii-export-to-ascii 'ox-ascii) + +(defhydradio hydra-ox () + (body-only "Export only the body.") + (export-scope "Export scope." [buffer subtree]) + (async-export "When non-nil, export async.") + (visible-only "When non-nil, export visible only") + (force-publishing "Toggle force publishing")) + +(defhydra hydra-ox-html (:color blue) + "ox-html" + ("H" (org-html-export-as-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only) + "As HTML buffer") + ("h" (org-html-export-to-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only) "As HTML file") + ("o" (org-open-file + (org-html-export-to-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only)) "As HTML file and open") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox-latex (:color blue) + "ox-latex" + ("L" org-latex-export-as-latex "As LaTeX buffer") + ("l" org-latex-export-to-latex "As LaTeX file") + ("p" org-latex-export-to-pdf "As PDF file") + ("o" (org-open-file (org-latex-export-to-pdf)) "As PDF file and open") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox-text (:color blue) + "ox-text" + ("A" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset ascii)) + "As ASCII buffer") + + ("a" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset ascii)) + "As ASCII file") + ("L" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset latin1)) + "As Latin1 buffer") + ("l" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset latin1)) + "As Latin1 file") + ("U" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset utf-8)) + "As UTF-8 buffer") + ("u" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset utf-8)) + "As UTF-8 file") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox () + " +_C-b_ Body only: % -15`hydra-ox/body-only^^^ _C-v_ Visible only: %`hydra-ox/visible-only +_C-s_ Export scope: % -15`hydra-ox/export-scope _C-f_ Force publishing: %`hydra-ox/force-publishing +_C-a_ Async export: %`hydra-ox/async-export + +" + ("C-b" (hydra-ox/body-only) nil) + ("C-v" (hydra-ox/visible-only) nil) + ("C-s" (hydra-ox/export-scope) nil) + ("C-f" (hydra-ox/force-publishing) nil) + ("C-a" (hydra-ox/async-export) nil) + ("h" hydra-ox-html/body "Export to HTML" :exit t) + ("l" hydra-ox-latex/body "Export to LaTeX" :exit t) + ("t" hydra-ox-text/body "Export to Plain Text" :exit t) + ("q" nil "quit")) + +(define-key org-mode-map (kbd "C-c C-,") 'hydra-ox/body) + +(provide 'hydra-ox) + +;;; hydra-ox.el ends here diff --git a/hydra-test.el b/hydra-test.el new file mode 100644 index 0000000..ffbfa24 --- /dev/null +++ b/hydra-test.el @@ -0,0 +1,1561 @@ +;;; hydra-test.el --- Tests 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 . + +;;; Commentary: +;; + +;;; Code: + +(require 'ert) +(require 'hydra) +(setq text-quoting-style 'grave) +(message "Emacs version: %s" emacs-version) + +(ert-deftest hydra-red-error () + (should + (equal + (macroexpand + '(defhydra hydra-error (global-map "M-g") + "error" + ("h" first-error "first") + ("j" next-error "next") + ("k" previous-error "prev") + ("SPC" hydra-repeat "rep" :bind nil))) + '(progn + (set + (defvar hydra-error/keymap nil + "Keymap for hydra-error.") + (quote + (keymap + (32 . hydra-repeat) + (107 . hydra-error/previous-error) + (106 . hydra-error/next-error) + (104 . hydra-error/first-error) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra--digit-argument) + (48 . hydra--digit-argument) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-error/heads nil + "Heads for hydra-error.") + (quote + (("h" + first-error + "first" + :exit nil) + ("j" + next-error + "next" + :exit nil) + ("k" + previous-error + "prev" + :exit nil) + ("SPC" + hydra-repeat + "rep" + :bind nil + :exit nil)))) + (set + (defvar hydra-error/hint nil + "Dynamic hint for hydra-error.") + (quote + (format + #("error: [h]: first, [j]: next, [k]: prev, [SPC]: rep." + 8 9 (face hydra-face-red) + 20 21 (face hydra-face-red) + 31 32 (face hydra-face-red) + 42 45 (face hydra-face-red))))) + (defun hydra-error/first-error nil + "Create a hydra with a \"M-g\" body and the heads: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body'. + +Call the head: `first-error'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (condition-case err + (progn + (setq this-command + (quote first-error)) + (hydra--call-interactively-remap-maybe + (function first-error))) + ((quit error) + (message + (error-message-string err)) + (unless hydra-lv (sit-for 0.8)))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-error/next-error nil + "Create a hydra with a \"M-g\" body and the heads: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body'. + +Call the head: `next-error'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (condition-case err + (progn + (setq this-command + (quote next-error)) + (hydra--call-interactively-remap-maybe + (function next-error))) + ((quit error) + (message + (error-message-string err)) + (unless hydra-lv (sit-for 0.8)))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-error/previous-error nil + "Create a hydra with a \"M-g\" body and the heads: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body'. + +Call the head: `previous-error'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (condition-case err + (progn + (setq this-command + (quote previous-error)) + (hydra--call-interactively-remap-maybe + (function previous-error))) + ((quit error) + (message + (error-message-string err)) + (unless hydra-lv (sit-for 0.8)))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (unless (keymapp + (lookup-key + global-map + (kbd "M-g"))) + (define-key global-map (kbd "M-g") + nil)) + (define-key global-map [134217831 104] + (quote hydra-error/first-error)) + (define-key global-map [134217831 106] + (quote hydra-error/next-error)) + (define-key global-map [134217831 107] + (quote + hydra-error/previous-error)) + (defun hydra-error/body nil + "Create a hydra with a \"M-g\" body and the heads: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-blue-toggle () + (should + (equal + (macroexpand + '(defhydra hydra-toggle (:color blue) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel"))) + '(progn + (set + (defvar hydra-toggle/keymap nil + "Keymap for hydra-toggle.") + (quote + (keymap + (113 . hydra-toggle/nil) + (97 . hydra-toggle/abbrev-mode-and-exit) + (102 . hydra-toggle/auto-fill-mode-and-exit) + (116 . hydra-toggle/toggle-truncate-lines-and-exit) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra--digit-argument) + (48 . hydra--digit-argument) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-toggle/heads nil + "Heads for hydra-toggle.") + (quote + (("t" + toggle-truncate-lines + "truncate" + :exit t) + ("f" + auto-fill-mode + "fill" + :exit t) + ("a" + abbrev-mode + "abbrev" + :exit t) + ("q" nil "cancel" :exit t)))) + (set + (defvar hydra-toggle/hint nil + "Dynamic hint for hydra-toggle.") + (quote + (format + #("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))))) + (defun hydra-toggle/toggle-truncate-lines-and-exit 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 `hydra-toggle/body'. + +Call the head: `toggle-truncate-lines'." + (interactive) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) + (progn + (setq this-command + (quote toggle-truncate-lines)) + (hydra--call-interactively-remap-maybe + (function + toggle-truncate-lines)))) + (defun hydra-toggle/auto-fill-mode-and-exit 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 `hydra-toggle/body'. + +Call the head: `auto-fill-mode'." + (interactive) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) + (progn + (setq this-command + (quote auto-fill-mode)) + (hydra--call-interactively-remap-maybe + (function auto-fill-mode)))) + (defun hydra-toggle/abbrev-mode-and-exit 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 `hydra-toggle/body'. + +Call the head: `abbrev-mode'." + (interactive) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) + (progn + (setq this-command + (quote abbrev-mode)) + (hydra--call-interactively-remap-maybe + (function abbrev-mode)))) + (defun hydra-toggle/nil 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 `hydra-toggle/body'. + +Call the head: `nil'." + (interactive) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body))) + (defun hydra-toggle/body 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 `hydra-toggle/body'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body))) + (hydra-show-hint + hydra-toggle/hint + (quote hydra-toggle)) + (hydra-set-transient-map + hydra-toggle/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-amaranth-vi () + (should + (equal + (macroexpand + '(defhydra hydra-vi + (:pre + (set-cursor-color "#e52b50") + :post + (set-cursor-color "#ffffff") + :color amaranth) + "vi" + ("j" next-line) + ("k" previous-line) + ("q" nil "quit"))) + '(progn + (set + (defvar hydra-vi/keymap nil + "Keymap for hydra-vi.") + (quote + (keymap + (113 . hydra-vi/nil) + (107 . hydra-vi/previous-line) + (106 . hydra-vi/next-line) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra--digit-argument) + (48 . hydra--digit-argument) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-vi/heads nil + "Heads for hydra-vi.") + (quote + (("j" next-line "" :exit nil) + ("k" + previous-line + "" + :exit nil) + ("q" nil "quit" :exit t)))) + (set + (defvar hydra-vi/hint nil + "Dynamic hint for hydra-vi.") + (quote + (format + #("vi: j, k, [q]: quit." + 4 5 (face hydra-face-amaranth) + 7 8 (face hydra-face-amaranth) + 11 12 (face hydra-face-teal))))) + (defun hydra-vi/next-line nil + "Create a hydra with no body and the heads: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'. + +Call the head: `next-line'." + (interactive) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (condition-case err + (progn + (setq this-command + (quote next-line)) + (hydra--call-interactively-remap-maybe + (function next-line))) + ((quit error) + (message + (error-message-string err)) + (unless hydra-lv (sit-for 0.8)))) + (hydra-show-hint + hydra-vi/hint + (quote hydra-vi)) + (hydra-set-transient-map + hydra-vi/keymap + (lambda nil + (hydra-keyboard-quit) + (set-cursor-color "#ffffff")) + (quote warn))) + (defun hydra-vi/previous-line nil + "Create a hydra with no body and the heads: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'. + +Call the head: `previous-line'." + (interactive) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (condition-case err + (progn + (setq this-command + (quote previous-line)) + (hydra--call-interactively-remap-maybe + (function previous-line))) + ((quit error) + (message + (error-message-string err)) + (unless hydra-lv (sit-for 0.8)))) + (hydra-show-hint + hydra-vi/hint + (quote hydra-vi)) + (hydra-set-transient-map + hydra-vi/keymap + (lambda nil + (hydra-keyboard-quit) + (set-cursor-color "#ffffff")) + (quote warn))) + (defun hydra-vi/nil nil + "Create a hydra with no body and the heads: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'. + +Call the head: `nil'." + (interactive) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (defun hydra-vi/body nil + "Create a hydra with no body and the heads: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'." + (interactive) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (hydra-show-hint + hydra-vi/hint + (quote hydra-vi)) + (hydra-set-transient-map + hydra-vi/keymap + (lambda nil + (hydra-keyboard-quit) + (set-cursor-color "#ffffff")) + (quote warn)) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-zoom-duplicate-1 () + (should + (equal + (macroexpand + '(defhydra hydra-zoom () + "zoom" + ("r" (text-scale-set 0) "reset") + ("0" (text-scale-set 0) :bind nil :exit t) + ("1" (text-scale-set 0) nil :bind nil :exit t))) + '(progn + (set + (defvar hydra-zoom/keymap nil + "Keymap for hydra-zoom.") + (quote + (keymap + (114 . hydra-zoom/lambda-r) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra-zoom/lambda-0-and-exit) + (48 . hydra-zoom/lambda-0-and-exit) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-zoom/heads nil + "Heads for hydra-zoom.") + (quote + (("r" + (text-scale-set 0) + "reset" + :exit nil) + ("0" + (text-scale-set 0) + "" + :bind nil + :exit t) + ("1" + (text-scale-set 0) + nil + :bind nil + :exit t)))) + (set + (defvar hydra-zoom/hint nil + "Dynamic hint for hydra-zoom.") + (quote + (format + #("zoom: [r 0]: reset." + 7 8 (face hydra-face-red) + 9 10 (face hydra-face-blue))))) + (defun hydra-zoom/lambda-r nil + "Create a hydra with no body and the heads: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'. + +Call the head: `(text-scale-set 0)'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (condition-case err + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0)))) + ((quit error) + (message + (error-message-string err)) + (unless hydra-lv (sit-for 0.8)))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-zoom/lambda-0-and-exit nil + "Create a hydra with no body and the heads: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'. + +Call the head: `(text-scale-set 0)'." + (interactive) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body)) + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0))))) + (defun hydra-zoom/body nil + "Create a hydra with no body and the heads: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-zoom-duplicate-2 () + (should + (equal + (macroexpand + '(defhydra hydra-zoom () + "zoom" + ("r" (text-scale-set 0) "reset") + ("0" (text-scale-set 0) :bind nil :exit t) + ("1" (text-scale-set 0) nil :bind nil))) + '(progn + (set + (defvar hydra-zoom/keymap nil + "Keymap for hydra-zoom.") + (quote + (keymap + (114 . hydra-zoom/lambda-r) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra-zoom/lambda-r) + (48 . hydra-zoom/lambda-0-and-exit) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-zoom/heads nil + "Heads for hydra-zoom.") + (quote + (("r" + (text-scale-set 0) + "reset" + :exit nil) + ("0" + (text-scale-set 0) + "" + :bind nil + :exit t) + ("1" + (text-scale-set 0) + nil + :bind nil + :exit nil)))) + (set + (defvar hydra-zoom/hint nil + "Dynamic hint for hydra-zoom.") + (quote + (format + #("zoom: [r 0]: reset." + 7 8 (face hydra-face-red) + 9 10 (face hydra-face-blue))))) + (defun hydra-zoom/lambda-r nil + "Create a hydra with no body and the heads: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'. + +Call the head: `(text-scale-set 0)'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (condition-case err + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0)))) + ((quit error) + (message + (error-message-string err)) + (unless hydra-lv (sit-for 0.8)))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-zoom/lambda-0-and-exit nil + "Create a hydra with no body and the heads: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'. + +Call the head: `(text-scale-set 0)'." + (interactive) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body)) + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0))))) + (defun hydra-zoom/body nil + "Create a hydra with no body and the heads: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest defhydradio () + (should (equal + (macroexpand + '(defhydradio hydra-test () + (num "Num" [0 1 2 3 4 5 6 7 8 9 10]) + (str "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)) + (defvar hydra-test/names '(hydra-test/num hydra-test/str)))))) + +(ert-deftest hydra-blue-compat () + (should + (equal + (macroexpand + '(defhydra hydra-toggle (:color blue) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel"))) + (macroexpand + '(defhydra hydra-toggle (:exit t) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel")))))) + +(ert-deftest hydra-amaranth-compat () + (should + (equal + (macroexpand + '(defhydra hydra-vi + (:pre + (set-cursor-color "#e52b50") + :post + (set-cursor-color "#ffffff") + :color amaranth) + "vi" + ("j" next-line) + ("k" previous-line) + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-vi + (:pre + (set-cursor-color "#e52b50") + :post + (set-cursor-color "#ffffff") + :foreign-keys warn) + "vi" + ("j" next-line) + ("k" previous-line) + ("q" nil "quit")))))) + +(ert-deftest hydra-pink-compat () + (should + (equal + (macroexpand + '(defhydra hydra-zoom (global-map "" + :color pink) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-zoom (global-map "" + :foreign-keys run) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit")))))) + +(ert-deftest hydra-teal-compat () + (should + (equal + (macroexpand + '(defhydra hydra-zoom (global-map "" + :color teal) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-zoom (global-map "" + :foreign-keys warn + :exit t) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit")))))) + +(ert-deftest hydra-format-1 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'hydra-toggle + nil + " +_a_ abbrev-mode: %`abbrev-mode +_d_ debug-on-error: %`debug-on-error +_f_ auto-fill-mode: %`auto-fill-function +" '(("a" abbrev-mode nil) + ("d" toggle-debug-on-error nil) + ("f" auto-fill-mode nil) + ("g" golden-ratio-mode nil) + ("t" toggle-truncate-lines nil) + ("w" whitespace-mode nil) + ("q" nil "quit")))) + '(concat (format "%s abbrev-mode: %S +%s debug-on-error: %S +%s auto-fill-mode: %S +" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[{q}]: quit.")))) + +(ert-deftest hydra-format-2 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'bar + nil + "\n bar %s`foo\n" + '(("a" (quote t) "" :cmd-name bar/lambda-a :exit nil) + ("q" nil "" :cmd-name bar/nil :exit t)))) + '(concat (format " bar %s\n" foo) "{a}, [q].")))) + +(ert-deftest hydra-format-3 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'bar + nil + "\n__ ^^ace jump\n" + '(("" ace-jump-char-mode nil :cmd-name bar/ace-jump-char-mode)))) + '(concat (format "%s ace jump\n" "{}") "")))) + +(ert-deftest hydra-format-4 () + (should + (equal (hydra--format + nil + '(nil nil :hint nil) + "\n_j_,_k_" + '(("j" nil nil :exit t) ("k" nil nil :exit t))) + '(concat (format "%s,%s" + #("j" 0 1 (face hydra-face-blue)) + #("k" 0 1 (face hydra-face-blue))) "")))) + +(ert-deftest hydra-format-5 () + (should + (equal (hydra--format + nil nil "\n_-_: mark _u_: unmark\n" + '(("-" Buffer-menu-mark) + ("u" Buffer-menu-unmark))) + '(concat + (format + "%s: mark %s: unmark\n" + #("-" 0 1 (face hydra-face-red)) + #("u" 0 1 (face hydra-face-red))) + "")))) + +(ert-deftest hydra-format-6 () + (should + (equal (hydra--format + nil nil "\n[_]_] forward [_[_] backward\n" + '(("]" forward-char) + ("[" backward-char))) + '(concat + (format + "[%s] forward [%s] backward\n" + #("]" + 0 1 (face + hydra-face-red)) + #("[" + 0 1 (face + hydra-face-red))) + "")))) + +(ert-deftest hydra-format-7 () + (should + (equal + (hydra--format nil nil "test" + '(("%" forward-char "" :exit nil) + ("b" backward-char "" :exit nil))) + '(format + #("test: %%%%, b." + 6 7 (face hydra-face-red) + 7 8 (face hydra-face-red) + 8 9 (face hydra-face-red) + 9 10 (face hydra-face-red) + 12 13 (face hydra-face-red))))) + (should + (equal + (hydra--format nil nil "\n_%_ forward\n" + '(("%" forward-char nil :exit nil))) + '(concat + (format + "%s forward\n" + #("%%" + 0 2 (face hydra-face-red))) + "")))) + +(ert-deftest hydra-format-8 () + (should + (equal + (hydra--format nil '(nil nil :hint nil) "test" + '(("f" forward-char nil :exit nil) + ("b" backward-char "back" :exit nil))) + '(format + #("test: [b]: back." + 7 8 (face hydra-face-red)))))) + +(ert-deftest hydra-format-9 () + (should + (equal + (hydra--format nil '(nil nil :hint nil) "\n_f_(foo)" + '(("f" forward-char nil :exit nil))) + '(concat + (format + "%s(foo)" + #("f" 0 1 (face hydra-face-red))) + "")))) + +(ert-deftest hydra-format-with-sexp-1 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'hydra-toggle nil + "\n_n_ narrow-or-widen-dwim %(progn (message \"checking\")(buffer-narrowed-p))asdf\n" + '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t)))) + '(concat (format "%s narrow-or-widen-dwim %Sasdf\n" + "{n}" + (progn + (message "checking") + (buffer-narrowed-p))) + "[[q]]: cancel.")))) + +(ert-deftest hydra-format-with-sexp-2 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'hydra-toggle nil + "\n_n_ narrow-or-widen-dwim %s(progn (message \"checking\")(buffer-narrowed-p))asdf\n" + '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t)))) + '(concat (format "%s narrow-or-widen-dwim %sasdf\n" + "{n}" + (progn + (message "checking") + (buffer-narrowed-p))) + "[[q]]: cancel.")))) + +(ert-deftest hydra-compat-colors-2 () + (should + (equal + (macroexpand + '(defhydra hydra-test (:color amaranth) + ("a" fun-a) + ("b" fun-b :color blue) + ("c" fun-c :color blue) + ("d" fun-d :color blue) + ("e" fun-e :color blue) + ("f" fun-f :color blue))) + (macroexpand + '(defhydra hydra-test (:color teal) + ("a" fun-a :color red) + ("b" fun-b) + ("c" fun-c) + ("d" fun-d) + ("e" fun-e) + ("f" fun-f)))))) + +(ert-deftest hydra-compat-colors-3 () + (should + (equal + (macroexpand + '(defhydra hydra-test () + ("a" fun-a) + ("b" fun-b :color blue) + ("c" fun-c :color blue) + ("d" fun-d :color blue) + ("e" fun-e :color blue) + ("f" fun-f :color blue))) + (macroexpand + '(defhydra hydra-test (:color blue) + ("a" fun-a :color red) + ("b" fun-b) + ("c" fun-c) + ("d" fun-d) + ("e" fun-e) + ("f" fun-f)))))) + +(ert-deftest hydra-compat-colors-4 () + (should + (equal + (macroexpand + '(defhydra hydra-test () + ("a" fun-a) + ("b" fun-b :exit t) + ("c" fun-c :exit t) + ("d" fun-d :exit t) + ("e" fun-e :exit t) + ("f" fun-f :exit t))) + (macroexpand + '(defhydra hydra-test (:exit t) + ("a" fun-a :exit nil) + ("b" fun-b) + ("c" fun-c) + ("d" fun-d) + ("e" fun-e) + ("f" fun-f)))))) + +(ert-deftest hydra--pad () + (should (equal (hydra--pad '(a b c) 3) + '(a b c))) + (should (equal (hydra--pad '(a) 3) + '(a nil nil)))) + +(ert-deftest hydra--matrix () + (should (equal (hydra--matrix '(a b c) 2 2) + '((a b) (c nil)))) + (should (equal (hydra--matrix '(a b c d e f g h i) 4 3) + '((a b c d) (e f g h) (i nil nil nil))))) + +(ert-deftest hydra--cell () + (should (equal (hydra--cell "% -75s %%`%s" '(hydra-lv hydra-verbose)) + "When non-nil, `lv-message' (not `message') will be used to display hints. %`hydra-lv^^^^^ +When non-nil, hydra will issue some non essential style warnings. %`hydra-verbose"))) + +(ert-deftest hydra--vconcat () + (should (equal (hydra--vconcat '("abc\ndef" "012\n34" "def\nabc")) + "abc012def\ndef34abc"))) + +(defhydradio hydra-tng () + (picard "_p_ Captain Jean Luc Picard:") + (riker "_r_ Commander William Riker:") + (data "_d_ Lieutenant Commander Data:") + (worf "_w_ Worf:") + (la-forge "_f_ Geordi La Forge:") + (troi "_t_ Deanna Troi:") + (dr-crusher "_c_ Doctor Beverly Crusher:") + (phaser "_h_ Set phasers to " [stun kill])) + +(ert-deftest hydra--table () + (let ((hydra-cell-format "% -30s %% -8`%s")) + (should (equal (hydra--table hydra-tng/names 5 2) + (substring " +_p_ Captain Jean Luc Picard: % -8`hydra-tng/picard^^ _t_ Deanna Troi: % -8`hydra-tng/troi^^^^^^ +_r_ Commander William Riker: % -8`hydra-tng/riker^^^ _c_ Doctor Beverly Crusher: % -8`hydra-tng/dr-crusher +_d_ Lieutenant Commander Data: % -8`hydra-tng/data^^^^ _h_ Set phasers to % -8`hydra-tng/phaser^^^^ +_w_ Worf: % -8`hydra-tng/worf^^^^ +_f_ Geordi La Forge: % -8`hydra-tng/la-forge" 1))) + (should (equal (hydra--table hydra-tng/names 4 3) + (substring " +_p_ Captain Jean Luc Picard: % -8`hydra-tng/picard _f_ Geordi La Forge: % -8`hydra-tng/la-forge^^ +_r_ Commander William Riker: % -8`hydra-tng/riker^ _t_ Deanna Troi: % -8`hydra-tng/troi^^^^^^ +_d_ Lieutenant Commander Data: % -8`hydra-tng/data^^ _c_ Doctor Beverly Crusher: % -8`hydra-tng/dr-crusher +_w_ Worf: % -8`hydra-tng/worf^^ _h_ Set phasers to % -8`hydra-tng/phaser^^^^" 1))))) + +(ert-deftest hydra--make-funcall () + (should (equal (let ((body-pre 'foo)) + (hydra--make-funcall body-pre) + body-pre) + '(funcall (function foo))))) + +(defhydra hydra-simple-1 (global-map "C-c") + ("a" (insert "j")) + ("b" (insert "k")) + ("q" nil)) + +(defhydra hydra-simple-2 (global-map "C-c" :color amaranth) + ("c" self-insert-command) + ("d" self-insert-command) + ("q" nil)) + +(defhydra hydra-simple-3 (global-map "C-c") + ("g" goto-line) + ("1" find-file) + ("q" nil)) + +(defun remapable-print () + (interactive) + (insert "remapable print was called")) +(defun remaped-print () + (interactive) + (insert "*remaped* print was called")) +(define-key global-map (kbd "C-=") 'remapable-print) +(define-key global-map [remap remapable-print] 'remaped-print) + +(defhydra hydra-simple-with-remap (global-map "C-c") + ("r" remapable-print) + ("q" nil)) + +(defmacro hydra-with (in &rest body) + `(let ((temp-buffer (generate-new-buffer " *temp*"))) + (save-window-excursion + (unwind-protect + (progn + (switch-to-buffer temp-buffer) + (transient-mark-mode 1) + (insert ,in) + (goto-char (point-min)) + (when (search-forward "~" nil t) + (backward-delete-char 1) + (set-mark (point))) + (goto-char (point-max)) + (search-backward "|") + (delete-char 1) + (setq current-prefix-arg nil) + ,@body + (insert "|") + (when (region-active-p) + (exchange-point-and-mark) + (insert "~")) + (buffer-substring-no-properties + (point-min) + (point-max))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer)))))) + +(ert-deftest hydra-integration-1 () + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c aabbaaqaabbaa"))) + "jjkkjjaabbaa|")) + (should (string= (hydra-with "|" + (condition-case nil + (execute-kbd-macro + (kbd "C-c aabb C-g")) + (quit nil)) + (execute-kbd-macro "aaqaabbaa")) + "jjkkaaqaabbaa|"))) + +(ert-deftest hydra-integration-2 () + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c c 1 c 2 d 4 c q"))) + "ccddcccc|")) + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c c 1 c C-u d C-u 10 c q"))) + "ccddddcccccccccc|"))) + +(ert-deftest hydra-integration-3 () + (should (string= (hydra-with "foo\nbar|" + (execute-kbd-macro + (kbd "C-c g 1 RET q"))) + "|foo\nbar"))) + +(ert-deftest hydra-remap-lookup-1 () + "try calling a remapped command while option is disabled " + (setq hydra-look-for-remap nil) + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c rq"))) + "remapable print was called|"))) +(ert-deftest hydra-remap-lookup-2 () + "try calling a remapped command while option is enabled" + (setq hydra-look-for-remap t) + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c rq"))) + "*remaped* print was called|"))) + +(ert-deftest hydra-columns-1 () + (should (equal (eval + (cadr + (nth 2 + (nth 3 + (macroexpand + '(defhydra hydra-info (:color blue + :columns 3) + "Info-mode" + ("?" Info-summary "summary") + ("]" Info-forward-node "forward") + ("[" Info-backward-node "backward") + ("<" Info-top-node "top node") + (">" Info-final-node "final node") + ("h" Info-help "help") + ("d" Info-directory "info dir") + ("f" Info-follow-reference "follow ref") + ("g" Info-goto-node "goto node") + ("l" Info-history-back "hist back") + ("r" Info-history-forward "hist forward") + ("i" Info-index "index") + ("I" Info-virtual-index "virtual index") + ("L" Info-history "hist") + ("n" Info-next "next") + ("p" Info-prev "previous") + ("s" Info-search "search") + ("S" Info-search-case-sensitively "case-search") + ("T" Info-toc "TOC") + ("u" Info-up "up") + ("m" Info-menu "menu") + ("t" hydra-info-to/body "info-to"))))))) + #("Info-mode: +?: summary ]: forward [: backward +<: top node >: final node h: help +d: info dir f: follow ref g: goto node +l: hist back r: hist forward i: index +I: virtual index L: hist n: next +p: previous s: search S: case-search +T: TOC u: up m: menu +t: info-to" + 11 12 (face hydra-face-blue) + 28 29 (face hydra-face-blue) + 45 46 (face hydra-face-blue) + 57 58 (face hydra-face-blue) + 74 75 (face hydra-face-blue) + 91 92 (face hydra-face-blue) + 99 100 (face hydra-face-blue) + 116 117 (face hydra-face-blue) + 133 134 (face hydra-face-blue) + 146 147 (face hydra-face-blue) + 163 164 (face hydra-face-blue) + 180 181 (face hydra-face-blue) + 189 190 (face hydra-face-blue) + 206 207 (face hydra-face-blue) + 223 224 (face hydra-face-blue) + 231 232 (face hydra-face-blue) + 248 249 (face hydra-face-blue) + 265 266 (face hydra-face-blue) + 280 281 (face hydra-face-blue) + 297 298 (face hydra-face-blue) + 314 315 (face hydra-face-blue) + 322 323 (face hydra-face-blue))))) + +;; checked: +;; basic rendering +;; column compatibility with ruby style and no colum specified +;; column declared several time +;; nil column +(ert-deftest hydra-column-basic () + (should (equal (eval + (cadr + (nth 2 + (nth 3 + (macroexpand + '(defhydra hydra-rectangle (:body-pre (rectangle-mark-mode 1) + :color pink + :post (deactivate-mark)) + " + ^_k_^ ()() +_h_ _l_ (O)(o) + ^_j_^ ( O ) +^^^^ (’’)(’’) +^^^^ +" + ("h" backward-char nil) + ("l" forward-char nil) + ("k" previous-line nil) + ("j" next-line nil) + ("Of" 5x5 "outside of table 1") + ("e" exchange-point-and-mark "exchange" :column "firstcol") + ("n" copy-rectangle-as-kill "new-copy") + ("d" delete-rectangle "delete") + ("r" (if (region-active-p) + (deactivate-mark) + (rectangle-mark-mode 1)) "reset" :column "secondcol") + ("y" yank-rectangle "yank") + ("u" undo "undo") + ("s" string-rectangle "string") + ("p" kill-rectangle "paste") + ("o" nil "ok" :column "firstcol") + ("Os" 5x5-bol "outside of table 2" :column nil) + ("Ot" 5x5-eol "outside of table 3"))))))) + #(" k ()() +h l (O)(o) + j ( O ) + (’’)(’’) + + +firstcol | secondcol +----------- | ------------ +e: exchange | r: reset +n: new-copy | y: yank +d: delete | u: undo +o: ok | s: string + | p: paste +[Of]: outside of table 1, [Os]: outside of table 2, [Ot]: outside of table 3." + 2 3 (face hydra-face-pink) + 17 18 (face hydra-face-pink) + 21 22 (face hydra-face-pink) + 38 39 (face hydra-face-pink) + 129 130 (face hydra-face-pink) + 143 144 (face hydra-face-pink) + 152 153 (face hydra-face-pink) + 166 167 (face hydra-face-pink) + 174 175 (face hydra-face-pink) + 188 189 (face hydra-face-pink) + 196 197 (face hydra-face-blue) + 210 211 (face hydra-face-pink) + 234 235 (face hydra-face-pink) + 244 246 (face hydra-face-pink) + 270 272 (face hydra-face-pink) + 296 298 (face hydra-face-pink))))) + +;; check column order is the same as they appear in defhydra +(ert-deftest hydra-column-order () + (should (equal (eval + (cadr + (nth 2 + (nth 3 + (macroexpand + '(defhydra hydra-window-order + (:color red :hint nil :timeout 4) + ("z" ace-window "ace" :color blue :column "Switch") + ("h" windmove-left "← window") + ("j" windmove-down "↓ window") + ("l" windmove-right "→ window") + ("s" split-window-below "split window" :color blue :column "Split Management") + ("v" split-window-right "split window vertically" :color blue) + ("d" delete-window "delete current window") + ("f" follow-mode "toogle follow mode") + ("u" winner-undo "undo window conf" :column "Undo/Redo") + ("r" winner-redo "redo window conf") + ("b" balance-windows "balance window height" :column "1-Sizing") + ("m" maximize-window "maximize current window") + ("k" windmove-up "↑ window" :column "Switch") + ("M" minimize-window "maximize current window" :column "1-Sizing") + ("q" nil "quit menu" :color blue :column nil))))))) + #("hydra: +Switch | Split Management | Undo/Redo | 1-Sizing +----------- | -------------------------- | ------------------- | -------------------------- +z: ace | s: split window | u: undo window conf | b: balance window height +h: ← window | v: split window vertically | r: redo window conf | m: maximize current window +j: ↓ window | d: delete current window | | M: maximize current window +l: → window | f: toogle follow mode | | +k: ↑ window | | | +[q]: quit menu." + 173 174 (face hydra-face-blue) + 187 188 (face hydra-face-blue) + 216 217 (face hydra-face-red) + 238 239 (face hydra-face-red) + 263 264 (face hydra-face-red) + 277 278 (face hydra-face-blue) + 306 307 (face hydra-face-red) + 328 329 (face hydra-face-red) + 355 356 (face hydra-face-red) + 369 370 (face hydra-face-red) + 420 421 (face hydra-face-red) + 447 448 (face hydra-face-red) + 461 462 (face hydra-face-red) + 512 513 (face hydra-face-red) + 578 579 (face hydra-face-blue))))) + +(provide 'hydra-test) + +;;; hydra-test.el ends here diff --git a/hydra.el b/hydra.el new file mode 100644 index 0000000..e3b3703 --- /dev/null +++ b/hydra.el @@ -0,0 +1,1403 @@ +;;; hydra.el --- Make bindings that stick around. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel +;; Maintainer: Oleh Krehel +;; URL: https://github.com/abo-abo/hydra +;; Version: 0.14.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 . + +;;; 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 an example Hydra, bound in the global map (you can use any +;; keymap in place of `global-map'): +;; +;; (defhydra hydra-zoom (global-map "") +;; "zoom" +;; ("g" text-scale-increase "in") +;; ("l" text-scale-decrease "out")) +;; +;; It allows to start a command chain either like this: +;; " gg4ll5g", or " lgllg". +;; +;; Here's another approach, when you just want a "callable keymap": +;; +;; (defhydra hydra-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")) +;; +;; This binds nothing so far, but if you follow up with: +;; +;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body) +;; +;; you will have bound "C-c C-v a", "C-c C-v d" etc. +;; +;; Knowing that `defhydra' defines e.g. `hydra-toggle/body' command, +;; you can nest Hydras if you wish, with `hydra-toggle/body' possibly +;; becoming a blue head of another Hydra. +;; +;; If you want to learn all intricacies of using `defhydra' without +;; having to figure it all out from this source code, check out the +;; wiki: https://github.com/abo-abo/hydra/wiki. There's a wealth of +;; information there. Everyone is welcome to bring the existing pages +;; up to date and add new ones. +;; +;; Additionally, the file hydra-examples.el serves to demo most of the +;; functionality. + +;;; Code: +;;* Requires +(require 'cl-lib) +(require 'lv) +(require 'ring) + +(defvar hydra-curr-map nil + "The keymap of the current Hydra called.") + +(defvar hydra-curr-on-exit nil + "The on-exit predicate for the current Hydra.") + +(defvar hydra-curr-foreign-keys nil + "The current :foreign-keys behavior.") + +(defvar hydra-curr-body-fn nil + "The current hydra-.../body function.") + +(defvar hydra-deactivate nil + "If a Hydra head sets this to t, exit the Hydra. +This will be done even if the head wasn't designated for exiting.") + +(defvar hydra-amaranth-warn-message "An amaranth Hydra can only exit through a blue head" + "Amaranth Warning message. Shown when the user tries to press an unbound/non-exit key while in an amaranth head.") + +(defun hydra-set-transient-map (keymap on-exit &optional foreign-keys) + "Set KEYMAP to the highest priority. + +Call ON-EXIT when the KEYMAP is deactivated. + +FOREIGN-KEYS determines the deactivation behavior, when a command +that isn't in KEYMAP is called: + +nil: deactivate KEYMAP and run the command. +run: keep KEYMAP and run the command. +warn: keep KEYMAP and issue a warning instead of running the command." + (if hydra-deactivate + (hydra-keyboard-quit) + (setq hydra-curr-map keymap) + (setq hydra-curr-on-exit on-exit) + (setq hydra-curr-foreign-keys foreign-keys) + (add-hook 'pre-command-hook 'hydra--clearfun) + (internal-push-keymap keymap 'overriding-terminal-local-map))) + +(defun hydra--clearfun () + "Disable the current Hydra unless `this-command' is a head." + (unless (eq this-command 'hydra-pause-resume) + (when (or + (memq this-command '(handle-switch-frame + keyboard-quit)) + (null overriding-terminal-local-map) + (not (or (eq this-command + (lookup-key hydra-curr-map (this-single-command-keys))) + (cl-case hydra-curr-foreign-keys + (warn + (setq this-command 'hydra-amaranth-warn)) + (run + t) + (t nil))))) + (hydra-disable)))) + +(defvar hydra--ignore nil + "When non-nil, don't call `hydra-curr-on-exit'.") + +(defvar hydra--input-method-function nil + "Store overridden `input-method-function' here.") + +(defun hydra-disable () + "Disable the current Hydra." + (setq hydra-deactivate nil) + (remove-hook 'pre-command-hook 'hydra--clearfun) + (unless hydra--ignore + (if (fboundp 'remove-function) + (remove-function input-method-function #'hydra--imf) + (when hydra--input-method-function + (setq input-method-function hydra--input-method-function) + (setq hydra--input-method-function nil)))) + (dolist (frame (frame-list)) + (with-selected-frame frame + (when overriding-terminal-local-map + (internal-pop-keymap hydra-curr-map 'overriding-terminal-local-map)))) + (unless hydra--ignore + (when hydra-curr-on-exit + (let ((on-exit hydra-curr-on-exit)) + (setq hydra-curr-on-exit nil) + (funcall on-exit))))) + +(unless (fboundp 'internal-push-keymap) + (defun internal-push-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (unless (memq keymap map) + (unless (memq 'add-keymap-witness (symbol-value symbol)) + (setq map (make-composed-keymap nil (symbol-value symbol))) + (push 'add-keymap-witness (cdr map)) + (set symbol map)) + (push keymap (cdr map)))))) + +(unless (fboundp 'internal-pop-keymap) + (defun internal-pop-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (when (memq keymap map) + (setf (cdr map) (delq keymap (cdr map)))) + (let ((tail (cddr map))) + (and (or (null tail) (keymapp tail)) + (eq 'add-keymap-witness (nth 1 map)) + (set symbol tail)))))) + +(defun hydra-amaranth-warn () + "Issue a warning that the current input was ignored." + (interactive) + (message hydra-amaranth-warn-message)) + +;;* Customize +(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) + +(defcustom hydra-default-hint "" + "Default :hint property to use for heads when not specified in +the body or the head." + :type 'sexp + :group 'hydra) + +(defcustom hydra-lv t + "When non-nil, `lv-message' (not `message') will be used to display hints." + :type 'boolean) + +(defcustom hydra-verbose nil + "When non-nil, hydra will issue some non essential style warnings." + :type 'boolean) + +(defcustom hydra-key-format-spec "%s" + "Default `format'-style specifier for _a_ syntax in docstrings. +When nil, you can specify your own at each location like this: _ 5a_." + :type 'string) + +(defcustom hydra-doc-format-spec "%s" + "Default `format'-style specifier for ?a? syntax in docstrings." + :type 'string) + +(defcustom hydra-look-for-remap nil + "When non-nil, hydra binding behaves as keymap binding with [remap]. +When calling a head with a simple command, hydra will lookup for a potential +remap command according to the current active keymap and call it instead if +found" + :type 'boolean) + +(make-obsolete-variable + 'hydra-key-format-spec + "Since the docstrings are aligned by hand anyway, this isn't very useful." + "0.13.1") + +(defface hydra-face-red + '((t (:foreground "#FF0000" :bold t))) + "Red Hydra heads don't exit the Hydra. +Every other command exits the Hydra." + :group 'hydra) + +(defface hydra-face-blue + '((((class color) (background light)) + :foreground "#0000FF" :bold t) + (((class color) (background dark)) + :foreground "#8ac6f2" :bold t)) + "Blue Hydra heads exit the Hydra. +Every other command exits as well.") + +(defface hydra-face-amaranth + '((t (:foreground "#E52B50" :bold t))) + "Amaranth body has red heads and warns on intercepting non-heads. +Exitable only through a blue head.") + +(defface hydra-face-pink + '((t (:foreground "#FF6EB4" :bold t))) + "Pink body has red heads and runs intercepted non-heads. +Exitable only through a blue head.") + +(defface hydra-face-teal + '((t (:foreground "#367588" :bold t))) + "Teal body has blue heads and warns on intercepting non-heads. +Exitable only through a blue head.") + +;;* Fontification +(defun hydra-add-font-lock () + "Fontify `defhydra' statements." + (font-lock-add-keywords + 'emacs-lisp-mode + '(("(\\(defhydra\\)\\_> +\\(.*?\\)\\_>" + (1 font-lock-keyword-face) + (2 font-lock-type-face)) + ("(\\(defhydradio\\)\\_> +\\(.*?\\)\\_>" + (1 font-lock-keyword-face) + (2 font-lock-type-face))))) + +;;* Find Function +(eval-after-load 'find-func + '(defadvice find-function-search-for-symbol + (around hydra-around-find-function-search-for-symbol-advice + (symbol type library) activate) + "Navigate to hydras with `find-function-search-for-symbol'." + ad-do-it + ;; The orignial function returns (cons (current-buffer) (point)) + ;; if it found the point. + (unless (cdr ad-return-value) + (with-current-buffer (find-file-noselect library) + (let ((sn (symbol-name symbol))) + (when (and (null type) + (string-match "\\`\\(hydra-[a-z-A-Z0-9]+\\)/\\(.*\\)\\'" sn) + (re-search-forward (concat "(defhydra " (match-string 1 sn)) + nil t)) + (goto-char (match-beginning 0))) + (cons (current-buffer) (point))))))) + +;;* Universal Argument +(defvar hydra-base-map + (let ((map (make-sparse-keymap))) + (define-key map [?\C-u] 'hydra--universal-argument) + (define-key map [?-] 'hydra--negative-argument) + (define-key map [?0] 'hydra--digit-argument) + (define-key map [?1] 'hydra--digit-argument) + (define-key map [?2] 'hydra--digit-argument) + (define-key map [?3] 'hydra--digit-argument) + (define-key map [?4] 'hydra--digit-argument) + (define-key map [?5] 'hydra--digit-argument) + (define-key map [?6] 'hydra--digit-argument) + (define-key map [?7] 'hydra--digit-argument) + (define-key map [?8] 'hydra--digit-argument) + (define-key map [?9] 'hydra--digit-argument) + (define-key map [kp-0] 'hydra--digit-argument) + (define-key map [kp-1] 'hydra--digit-argument) + (define-key map [kp-2] 'hydra--digit-argument) + (define-key map [kp-3] 'hydra--digit-argument) + (define-key map [kp-4] 'hydra--digit-argument) + (define-key map [kp-5] 'hydra--digit-argument) + (define-key map [kp-6] 'hydra--digit-argument) + (define-key map [kp-7] 'hydra--digit-argument) + (define-key map [kp-8] 'hydra--digit-argument) + (define-key map [kp-9] 'hydra--digit-argument) + (define-key map [kp-subtract] 'hydra--negative-argument) + map) + "Keymap that all Hydras inherit. See `universal-argument-map'.") + +(defun hydra--universal-argument (arg) + "Forward to (`universal-argument' ARG)." + (interactive "P") + (setq prefix-arg (if (consp arg) + (list (* 4 (car arg))) + (if (eq arg '-) + (list -4) + '(4))))) + +(defun hydra--digit-argument (arg) + "Forward to (`digit-argument' ARG)." + (interactive "P") + (let* ((char (if (integerp last-command-event) + last-command-event + (get last-command-event 'ascii-character))) + (digit (- (logand char ?\177) ?0))) + (setq prefix-arg (cond ((integerp arg) + (+ (* arg 10) + (if (< arg 0) + (- digit) + digit))) + ((eq arg '-) + (if (zerop digit) + '- + (- digit))) + (t + digit))))) + +(defun hydra--negative-argument (arg) + "Forward to (`negative-argument' ARG)." + (interactive "P") + (setq prefix-arg (cond ((integerp arg) (- arg)) + ((eq arg '-) nil) + (t '-)))) + +;;* Repeat +(defvar hydra-repeat--prefix-arg nil + "Prefix arg to use with `hydra-repeat'.") + +(defvar hydra-repeat--command nil + "Command to use with `hydra-repeat'.") + +(defun hydra-repeat (&optional arg) + "Repeat last command with last prefix arg. +When ARG is non-nil, use that instead." + (interactive "p") + (if (eq arg 1) + (unless (string-match "hydra-repeat$" (symbol-name last-command)) + (setq hydra-repeat--command last-command) + (setq hydra-repeat--prefix-arg last-prefix-arg)) + (setq hydra-repeat--prefix-arg arg)) + (setq current-prefix-arg hydra-repeat--prefix-arg) + (funcall hydra-repeat--command)) + +;;* Misc internals +(defun hydra--callablep (x) + "Test if X is callable." + (or (functionp x) + (and (consp x) + (memq (car x) '(function quote))))) + +(defun hydra--make-callable (x) + "Generate a callable symbol from X. +If X is a function symbol or a lambda, return it. Otherwise, it +should be a single statement. Wrap it in an interactive lambda." + (cond ((or (symbolp x) (functionp x)) + x) + ((and (consp x) (eq (car x) 'function)) + (cadr x)) + (t + `(lambda () + (interactive) + ,x)))) + +(defun hydra-plist-get-default (plist prop default) + "Extract a value from a property list. +PLIST is a property list, which is a list of the form +\(PROP1 VALUE1 PROP2 VALUE2...). + +Return the value corresponding to PROP, or DEFAULT if PROP is not +one of the properties on the list." + (if (memq prop plist) + (plist-get plist prop) + default)) + +(defun hydra--head-property (h prop &optional default) + "Return for Hydra head H the value of property PROP. +Return DEFAULT if PROP is not in H." + (hydra-plist-get-default (cl-cdddr h) prop default)) + +(defun hydra--head-set-property (h prop value) + "In hydra Head H, set a property PROP to the value VALUE." + (cons (car h) (plist-put (cdr h) prop value))) + +(defun hydra--head-has-property (h prop) + "Return non nil if heads H has the property PROP." + (plist-member (cdr h) prop)) + +(defun hydra--body-foreign-keys (body) + "Return what BODY does with a non-head binding." + (or + (plist-get (cddr body) :foreign-keys) + (let ((color (plist-get (cddr body) :color))) + (cl-case color + ((amaranth teal) 'warn) + (pink 'run))))) + +(defun hydra--body-exit (body) + "Return the exit behavior of BODY." + (or + (plist-get (cddr body) :exit) + (let ((color (plist-get (cddr body) :color))) + (cl-case color + ((blue teal) t) + (t nil))))) + +(defalias 'hydra--imf #'list) + +(defun hydra-default-pre () + "Default setup that happens in each head before :pre." + (when (eq input-method-function 'key-chord-input-method) + (if (fboundp 'add-function) + (add-function :override input-method-function #'hydra--imf) + (unless hydra--input-method-function + (setq hydra--input-method-function input-method-function) + (setq input-method-function nil))))) + +(defvar hydra-timeout-timer (timer-create) + "Timer for `hydra-timeout'.") + +(defvar hydra-message-timer (timer-create) + "Timer for the hint.") + +(defvar hydra--work-around-dedicated t + "When non-nil, assume there's no bug in `pop-to-buffer'. +`pop-to-buffer' should not select a dedicated window.") + +(defun hydra-keyboard-quit () + "Quitting function similar to `keyboard-quit'." + (interactive) + (hydra-disable) + (cancel-timer hydra-timeout-timer) + (cancel-timer hydra-message-timer) + (setq hydra-curr-map nil) + (unless (and hydra--ignore + (null hydra--work-around-dedicated)) + (if hydra-lv + (lv-delete-window) + (message ""))) + nil) + +(defvar hydra-head-format "[%s]: " + "The formatter for each head of a plain docstring.") + +(defvar hydra-key-doc-function 'hydra-key-doc-function-default + "The function for formatting key-doc pairs.") + +(defun hydra-key-doc-function-default (key key-width doc doc-width) + "Doc" + (cond + ((equal key " ") (format (format "%%-%ds" (+ 3 key-width doc-width)) doc)) + (t (format (format "%%%ds: %%%ds" key-width (- -1 doc-width)) key doc)))) + +(defun hydra--to-string (x) + (if (stringp x) + x + (eval x))) + +(defun hydra--hint-heads-wocol (body heads) + "Generate a hint for the echo area. +BODY, and HEADS are parameters to `defhydra'. +Works for heads without a property :column." + (let (alist) + (dolist (h heads) + (let ((val (assoc (cadr h) alist)) + (pstr (hydra-fontify-head h body))) + (unless (null (cl-caddr h)) + (if val + (setf (cadr val) + (concat (cadr val) " " pstr)) + (push + (cons (cadr h) + (cons pstr (cl-caddr h))) + alist))))) + (let ((keys (nreverse (mapcar #'cdr alist))) + (n-cols (plist-get (cddr body) :columns)) + res) + (setq res + (if n-cols + (let ((n-rows (1+ (/ (length keys) n-cols))) + (max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys))) + (max-doc-len (apply #'max (mapcar (lambda (x) + (length (hydra--to-string (cdr x)))) keys)))) + `(concat + "\n" + (mapconcat #'identity + (mapcar + (lambda (x) + (mapconcat + (lambda (y) + (and y + (funcall hydra-key-doc-function + (car y) + ,max-key-len + (hydra--to-string (cdr y)) + ,max-doc-len))) x "")) + ',(hydra--matrix keys n-cols n-rows)) + "\n"))) + + + `(concat + (mapconcat + (lambda (x) + (let ((str (hydra--to-string (cdr x)))) + (format + (if (> (length str) 0) + (concat hydra-head-format str) + "%s") + (car x)))) + ',keys + ", ") + ,(if keys "." "")))) + (if (cl-every #'stringp + (mapcar 'cddr alist)) + (eval res) + res)))) + +(defun hydra--hint (body heads) + "Generate a hint for the echo area. +BODY, and HEADS are parameters to `defhydra'." + (let* ((sorted-heads (hydra--sort-heads (hydra--normalize-heads heads))) + (heads-w-col (cl-remove-if-not (lambda (heads) (hydra--head-property (nth 0 heads) :column)) sorted-heads)) + (heads-wo-col (cl-remove-if (lambda (heads) (hydra--head-property (nth 0 heads) :column)) sorted-heads))) + (concat (when heads-w-col + (concat "\n" (hydra--hint-from-matrix body (hydra--generate-matrix heads-w-col)))) + (when heads-wo-col + (hydra--hint-heads-wocol body (car heads-wo-col)))))) + +(defvar hydra-fontify-head-function nil + "Possible replacement for `hydra-fontify-head-default'.") + +(defun hydra-fontify-head-default (head body) + "Produce a pretty string from HEAD and BODY. +HEAD's binding is returned as a string with a colored face." + (let* ((foreign-keys (hydra--body-foreign-keys body)) + (head-exit (hydra--head-property head :exit)) + (head-color + (if head-exit + (if (eq foreign-keys 'warn) + 'teal + 'blue) + (cl-case foreign-keys + (warn 'amaranth) + (run 'pink) + (t 'red))))) + (when (and (null (cadr head)) + (not head-exit)) + (hydra--complain "nil cmd can only be blue")) + (propertize + (replace-regexp-in-string "%" "%%" (car head)) + 'face + (or (hydra--head-property head :face) + (cl-case head-color + (blue 'hydra-face-blue) + (red 'hydra-face-red) + (amaranth 'hydra-face-amaranth) + (pink 'hydra-face-pink) + (teal 'hydra-face-teal) + (t (error "Unknown color for %S" head))))))) + +(defun hydra-fontify-head-greyscale (head _body) + "Produce a pretty string from HEAD and BODY. +HEAD's binding is returned as a string wrapped with [] or {}." + (format + (if (hydra--head-property head :exit) + "[%s]" + "{%s}") (car head))) + +(defun hydra-fontify-head (head body) + "Produce a pretty string from HEAD and BODY." + (funcall (or hydra-fontify-head-function 'hydra-fontify-head-default) + head body)) + +(defun hydra--strip-align-markers (str) + "Remove ^ from STR, unless they're escaped: \\^." + (let ((start 0)) + (while (setq start (string-match "\\\\?\\^" str start)) + (if (eq (- (match-end 0) (match-beginning 0)) 2) + (progn + (setq str (replace-match "^" nil nil str)) + (cl-incf start)) + (setq str (replace-match "" nil nil str)))) + str)) + +(defvar hydra-docstring-keys-translate-alist + '(("↑" . "") + ("↓" . "") + ("→" . "") + ("←" . "") + ("⌫" . "DEL") + ("⌦" . "") + ("⏎" . "RET"))) + +(defconst hydra-width-spec-regex " ?-?[0-9]*?" + "Regex for the width spec in keys and %` quoted sexps.") + +(defvar hydra-key-regex "\\[\\|]\\|[-[:alnum:] ~.,;:/|?<>={}*+#%@!&^↑↓←→⌫⌦⏎'`()\"$]+?" + "Regex for the key quoted in the docstring.") + +(defun hydra--format (_name body docstring heads) + "Generate a `format' statement from STR. +\"%`...\" expressions are extracted into \"%S\". +_NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'. +The expressions can be auto-expanded according to NAME." + (setq docstring (hydra--strip-align-markers docstring)) + (setq docstring (replace-regexp-in-string "___" "_β_" docstring)) + (let ((rest (if (eq (plist-get (cddr body) :hint) 'none) + "" + (hydra--hint body heads))) + (start 0) + varlist + offset) + (while (setq start + (string-match + (format + "\\(?:%%\\( ?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:[_?]\\(%s\\)\\(%s\\)[_?]\\)" + hydra-width-spec-regex + hydra-key-regex) + docstring start)) + (cond ((eq ?? (aref (match-string 0 docstring) 0)) + (let* ((key (match-string 4 docstring)) + (head (assoc key heads))) + (if head + (progn + (push (nth 2 head) varlist) + (setq docstring + (replace-match + (or + hydra-doc-format-spec + (concat "%" (match-string 3 docstring) "s")) + t nil docstring))) + (setq start (match-end 0)) + (warn "Unrecognized key: ?%s?" key)))) + ((eq ?_ (aref (match-string 0 docstring) 0)) + (let* ((key (match-string 4 docstring)) + (key (if (equal key "β") "_" key)) + normal-key + (head (or (assoc key heads) + (when (setq normal-key + (cdr (assoc + key hydra-docstring-keys-translate-alist))) + (assoc normal-key heads))))) + (if head + (progn + (push (hydra-fontify-head (if normal-key + (cons key (cdr head)) + head) + body) + varlist) + (let ((replacement + (or + hydra-key-format-spec + (concat "%" (match-string 3 docstring) "s")))) + (setq docstring + (replace-match replacement t nil docstring)) + (setq start (+ start (length replacement))))) + (setq start (match-end 0)) + (warn "Unrecognized key: _%s_" key)))) + + (t + (let* ((varp (if (eq ?` (aref (match-string 2 docstring) 0)) 1 0)) + (spec (match-string 1 docstring)) + (lspec (length spec))) + (setq offset + (with-temp-buffer + (insert (substring docstring (+ 1 start varp + (length spec)))) + (goto-char (point-min)) + (push (read (current-buffer)) varlist) + (- (point) (point-min)))) + (when (or (zerop lspec) + (/= (aref spec (1- (length spec))) ?s)) + (setq spec (concat spec "S"))) + (setq docstring + (concat + (substring docstring 0 start) + "%" spec + (substring docstring (+ start offset 1 lspec varp)))))))) + (if (eq ?\n (aref docstring 0)) + `(concat (format ,(substring docstring 1) ,@(nreverse varlist)) + ,rest) + (let ((r `(replace-regexp-in-string + " +$" "" + (concat ,docstring ": " + (replace-regexp-in-string + "\\(%\\)" "\\1\\1" ,rest))))) + (if (stringp rest) + `(format ,(eval r)) + `(format ,r)))))) + +(defun hydra--complain (format-string &rest args) + "Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil." + (if hydra-verbose + (apply #'error format-string args) + (apply #'message format-string args))) + +(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))) + +(defun hydra--call-interactively-remap-maybe (cmd) + "`call-interactively' the given CMD or its remapped equivalent. +Only when `hydra-look-for-remap' is non nil." + (let ((remapped-cmd (if hydra-look-for-remap + (command-remapping `,cmd) + nil))) + (if remapped-cmd + (call-interactively `,remapped-cmd) + (call-interactively `,cmd)))) + +(defun hydra--call-interactively (cmd name) + "Generate a `call-interactively' statement for CMD. +Set `this-command' to NAME." + (if (and (symbolp name) + (not (memq name '(nil body)))) + `(progn + (setq this-command ',name) + (hydra--call-interactively-remap-maybe #',cmd)) + `(hydra--call-interactively-remap-maybe #',cmd))) + +(defun hydra--make-defun (name body doc head + keymap body-pre body-before-exit + &optional body-after-exit) + "Make a defun wrapper, using NAME, BODY, DOC, HEAD, and KEYMAP. +NAME and BODY are the arguments to `defhydra'. +DOC was generated with `hydra--doc'. +HEAD is one of the HEADS passed to `defhydra'. +BODY-PRE is added to the start of the wrapper. +BODY-BEFORE-EXIT will be called before the hydra quits. +BODY-AFTER-EXIT is added to the end of the wrapper." + (let ((cmd-name (hydra--head-name head name)) + (cmd (when (car head) + (hydra--make-callable + (cadr head)))) + (doc (if (car head) + (format "%s\n\nCall the head: `%S'." doc (cadr head)) + doc)) + (hint (intern (format "%S/hint" name))) + (body-foreign-keys (hydra--body-foreign-keys body)) + (body-timeout (plist-get body :timeout)) + (body-idle (plist-get body :idle))) + `(defun ,cmd-name () + ,doc + (interactive) + (hydra-default-pre) + ,@(when body-pre (list body-pre)) + ,@(if (hydra--head-property head :exit) + `((hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name))) + ,@(if body-after-exit + `((unwind-protect + ,(when cmd + (hydra--call-interactively cmd (cadr head))) + ,body-after-exit)) + (when cmd + `(,(hydra--call-interactively cmd (cadr head)))))) + (delq + nil + `((let ((hydra--ignore ,(not (eq (cadr head) 'body)))) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name)))) + ,(when cmd + `(condition-case err + ,(hydra--call-interactively cmd (cadr head)) + ((quit error) + (message (error-message-string err)) + (unless hydra-lv + (sit-for 0.8))))) + ,(if (and body-idle (eq (cadr head) 'body)) + `(hydra-idle-message ,body-idle ,hint ',name) + `(hydra-show-hint ,hint ',name)) + (hydra-set-transient-map + ,keymap + (lambda () (hydra-keyboard-quit) ,body-before-exit) + ,(when body-foreign-keys + (list 'quote body-foreign-keys))) + ,body-after-exit + ,(when body-timeout + `(hydra-timeout ,body-timeout)))))))) + +(defvar hydra-props-alist nil) + +(defun hydra-set-property (name key val) + "Set hydra property. +NAME is the symbolic name of the hydra. +KEY and VAL are forwarded to `plist-put'." + (let ((entry (assoc name hydra-props-alist)) + plist) + (when (null entry) + (add-to-list 'hydra-props-alist (list name)) + (setq entry (assoc name hydra-props-alist))) + (setq plist (cdr entry)) + (setcdr entry (plist-put plist key val)))) + +(defun hydra-get-property (name key) + "Get hydra property. +NAME is the symbolic name of the hydra. +KEY is forwarded to `plist-get'." + (let ((entry (assoc name hydra-props-alist))) + (when entry + (plist-get (cdr entry) key)))) + +(defun hydra-show-hint (hint caller) + (let ((verbosity (plist-get (cdr (assoc caller hydra-props-alist)) + :verbosity))) + (cond ((eq verbosity 0)) + ((eq verbosity 1) + (message (eval hint))) + (t + (when hydra-is-helpful + (if hydra-lv + (lv-message (eval hint)) + (message (eval hint)))))))) + +(defmacro hydra--make-funcall (sym) + "Transform SYM into a `funcall' to call it." + `(when (and ,sym (symbolp ,sym)) + (setq ,sym `(funcall #',,sym)))) + +(defun hydra--head-name (h name) + "Return the symbol for head H of hydra with NAME." + (let ((str (format "%S/%s" name + (cond ((symbolp (cadr h)) + (cadr h)) + ((and (consp (cadr h)) + (eq (cl-caadr h) 'function)) + (cadr (cadr h))) + (t + (concat "lambda-" (car h))))))) + (when (and (hydra--head-property h :exit) + (not (memq (cadr h) '(body nil)))) + (setq str (concat str "-and-exit"))) + (intern str))) + +(defun hydra--delete-duplicates (heads) + "Return HEADS without entries that have the same CMD part. +In duplicate HEADS, :cmd-name is modified to whatever they duplicate." + (let ((ali '(((hydra-repeat . nil) . hydra-repeat))) + res entry) + (dolist (h heads) + (if (setq entry (assoc (cons (cadr h) + (hydra--head-property h :exit)) + ali)) + (setf (cl-cdddr h) (plist-put (cl-cdddr h) :cmd-name (cdr entry))) + (push (cons (cons (cadr h) + (hydra--head-property h :exit)) + (plist-get (cl-cdddr h) :cmd-name)) + ali) + (push h res))) + (nreverse res))) + +(defun hydra--pad (lst n) + "Pad LST with nil until length N." + (let ((len (length lst))) + (if (= len n) + lst + (append lst (make-list (- n len) nil))))) + +(defmacro hydra-multipop (lst n) + "Return LST's first N elements while removing them." + `(if (<= (length ,lst) ,n) + (prog1 ,lst + (setq ,lst nil)) + (prog1 ,lst + (setcdr + (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst)))) + nil)))) + +(defun hydra--matrix (lst rows cols) + "Create a matrix from elements of LST. +The matrix size is ROWS times COLS." + (let ((ls (copy-sequence lst)) + res) + (dotimes (_c cols) + (push (hydra--pad (hydra-multipop ls rows) rows) res)) + (nreverse res))) + +(defun hydra--cell (fstr names) + "Format a rectangular cell based on FSTR and NAMES. +FSTR is a format-style string with two string inputs: one for the +doc and one for the symbol name. +NAMES is a list of variables." + (let ((len (cl-reduce + (lambda (acc it) (max (length (symbol-name it)) acc)) + names + :initial-value 0))) + (mapconcat + (lambda (sym) + (if sym + (format fstr + (documentation-property sym 'variable-documentation) + (let ((name (symbol-name sym))) + (concat name (make-string (- len (length name)) ?^))) + sym) + "")) + names + "\n"))) + +(defun hydra--vconcat (strs &optional joiner) + "Glue STRS vertically. They must be the same height. +JOINER is a function similar to `concat'." + (setq joiner (or joiner #'concat)) + (mapconcat + (lambda (s) + (if (string-match " +$" s) + (replace-match "" nil nil s) + s)) + (apply #'cl-mapcar joiner + (mapcar + (lambda (s) (split-string s "\n")) + strs)) + "\n")) + +(defvar hydra-cell-format "% -20s %% -8`%s" + "The default format for docstring cells.") + +(defun hydra--table (names rows cols &optional cell-formats) + "Format a `format'-style table from variables in NAMES. +The size of the table is ROWS times COLS. +CELL-FORMATS are `format' strings for each column. +If CELL-FORMATS is a string, it's used for all columns. +If CELL-FORMATS is nil, `hydra-cell-format' is used for all columns." + (setq cell-formats + (cond ((null cell-formats) + (make-list cols hydra-cell-format)) + ((stringp cell-formats) + (make-list cols cell-formats)) + (t + cell-formats))) + (hydra--vconcat + (cl-mapcar + #'hydra--cell + cell-formats + (hydra--matrix names rows cols)) + (lambda (&rest x) + (mapconcat #'identity x " ")))) + +(defun hydra-reset-radios (names) + "Set varibles NAMES to their defaults. +NAMES should be defined by `defhydradio' or similar." + (dolist (n names) + (set n (aref (get n 'range) 0)))) + +;; Following functions deal with automatic docstring table generation from :column head property +(defun hydra--normalize-heads (heads) + "Ensure each head from HEADS have a property :column. +Set it to the same value as preceding head or nil if no previous value +was defined." + (let ((current-col nil)) + (mapcar (lambda (head) + (if (hydra--head-has-property head :column) + (setq current-col (hydra--head-property head :column))) + (hydra--head-set-property head :column current-col)) + heads))) + +(defun hydra--sort-heads (normalized-heads) + "Return a list of heads with non-nil doc grouped by column property. +Each head of NORMALIZED-HEADS must have a column property." + (let* ((heads-wo-nil-doc (cl-remove-if-not (lambda (head) (nth 2 head)) normalized-heads)) + (columns-list (delete-dups (mapcar (lambda (head) (hydra--head-property head :column)) + normalized-heads))) + (get-col-index-fun (lambda (head) (cl-position (hydra--head-property head :column) + columns-list + :test 'equal))) + (heads-sorted (cl-sort heads-wo-nil-doc (lambda (it other) + (< (funcall get-col-index-fun it) + (funcall get-col-index-fun other)))))) + ;; this operation partition the sorted head list into lists of heads with same column property + (cl-loop for head in heads-sorted + for column-name = (hydra--head-property head :column) + with prev-column-name = (hydra--head-property (nth 0 heads-sorted) :column) + unless (equal prev-column-name column-name) collect heads-one-column into heads-all-columns + and do (setq heads-one-column nil) + collect head into heads-one-column + do (setq prev-column-name column-name) + finally return (append heads-all-columns (list heads-one-column))))) + +(defun hydra--pad-heads (heads-groups padding-head) + "Return a copy of HEADS-GROUPS padded where applicable with PADDING-HEAD." + (cl-loop for heads-group in heads-groups + for this-head-group-length = (length heads-group) + with head-group-max-length = (apply #'max (mapcar (lambda (heads) (length heads)) heads-groups)) + if (<= this-head-group-length head-group-max-length) + collect (append heads-group (make-list (- head-group-max-length this-head-group-length) padding-head)) + into balanced-heads-groups + else collect heads-group into balanced-heads-groups + finally return balanced-heads-groups)) + +(defun hydra--generate-matrix (heads-groups) + "Return a copy of HEADS-GROUPS decorated with table formating information. +Details of modification: +2 virtual heads acting as table header were added to each heads-group. +Each head is decorated with 2 new properties max-doc-len and max-key-len +representing the maximum dimension of their owning group. + Every heads-group have equal length by adding padding heads where applicable." + (when heads-groups + (cl-loop for heads-group in (hydra--pad-heads heads-groups '(" " nil " " :exit t)) + for column-name = (hydra--head-property (nth 0 heads-group) :column) + for max-key-len = (apply #'max (mapcar (lambda (x) (length (car x))) heads-group)) + for max-doc-len = (apply #'max + (length column-name) + (mapcar (lambda (x) (length (hydra--to-string (nth 2 x)))) heads-group)) + for header-virtual-head = `(" " nil ,column-name :column ,column-name :exit t) + for separator-virtual-head = `(" " nil ,(make-string (+ 2 max-doc-len max-key-len) ?-) :column ,column-name :exit t) + for decorated-heads = (copy-tree (apply 'list header-virtual-head separator-virtual-head heads-group)) + collect (mapcar (lambda (it) + (hydra--head-set-property it :max-key-len max-key-len) + (hydra--head-set-property it :max-doc-len max-doc-len)) + decorated-heads) + into decorated-heads-matrix + finally return decorated-heads-matrix))) + +(defun hydra--hint-from-matrix (body heads-matrix) + "Generate a formated table-style docstring according to BODY and HEADS-MATRIX. +HEADS-MATRIX is expected to be a list of heads with following features: +Each heads must have the same length +Each head must have a property max-key-len and max-doc-len." + (when heads-matrix + (cl-loop with first-heads-col = (nth 0 heads-matrix) + with last-row-index = (- (length first-heads-col) 1) + for row-index from 0 to last-row-index + for heads-in-row = (mapcar (lambda (heads) (nth row-index heads)) heads-matrix) + concat (concat + (replace-regexp-in-string "\s+$" "" + (mapconcat (lambda (head) + (funcall hydra-key-doc-function + (hydra-fontify-head head body) ;; key + (hydra--head-property head :max-key-len) + (nth 2 head) ;; doc + (hydra--head-property head :max-doc-len))) + heads-in-row "| ")) "\n") + into matrix-image + finally return matrix-image))) +;; previous functions dealt with automatic docstring table generation from :column head property + +(defun hydra-idle-message (secs hint name) + "In SECS seconds display HINT." + (cancel-timer hydra-message-timer) + (setq hydra-message-timer (timer-create)) + (timer-set-time hydra-message-timer + (timer-relative-time (current-time) secs)) + (timer-set-function + hydra-message-timer + (lambda () + (hydra-show-hint hint name) + (cancel-timer hydra-message-timer))) + (timer-activate hydra-message-timer)) + +(defun hydra-timeout (secs &optional function) + "In SECS seconds call FUNCTION, then function `hydra-keyboard-quit'. +Cancel the previous `hydra-timeout'." + (cancel-timer hydra-timeout-timer) + (setq hydra-timeout-timer (timer-create)) + (timer-set-time hydra-timeout-timer + (timer-relative-time (current-time) secs)) + (timer-set-function + hydra-timeout-timer + `(lambda () + ,(when function + `(funcall ,function)) + (hydra-keyboard-quit))) + (timer-activate hydra-timeout-timer)) + +;;* Macros +;;;###autoload +(defmacro defhydra (name body &optional docstring &rest heads) + "Create a Hydra - a family of functions with prefix NAME. + +NAME should be a symbol, it will be the prefix of all functions +defined here. + +BODY has the format: + + (BODY-MAP BODY-KEY &rest BODY-PLIST) + +DOCSTRING will be displayed in the echo area to identify the +Hydra. When DOCSTRING starts with a newline, special Ruby-style +substitution will be performed by `hydra--format'. + +Functions are created on basis of HEADS, each of which has the +format: + + (KEY CMD &optional HINT &rest PLIST) + +BODY-MAP is a keymap; `global-map' is used quite often. Each +function generated from HEADS will be bound in BODY-MAP to +BODY-KEY + KEY (both are strings passed to `kbd'), and will set +the transient map so that all following heads can be called +though KEY only. BODY-KEY can be an empty string. + +CMD is a callable expression: either an interactive function +name, or an interactive lambda, or a single sexp (it will be +wrapped in an interactive lambda). + +HINT is a short string that identifies its head. It will be +printed beside KEY in the echo erea if `hydra-is-helpful' is not +nil. If you don't even want the KEY to be printed, set HINT +explicitly to nil. + +The heads inherit their PLIST from BODY-PLIST and are allowed to +override some keys. The keys recognized are :exit and :bind. +:exit can be: + +- nil (default): this head will continue the Hydra state. +- t: this head will stop the Hydra state. + +:bind can be: +- nil: this head will not be bound in BODY-MAP. +- a lambda taking KEY and CMD used to bind a head. + +It is possible to omit both BODY-MAP and BODY-KEY if you don't +want to bind anything. In that case, typically you will bind the +generated NAME/body command. This command is also the return +result of `defhydra'." + (declare (indent defun)) + (setq heads (copy-tree heads)) + (cond ((stringp docstring)) + ((and (consp docstring) + (memq (car docstring) '(hydra--table concat format))) + (setq docstring (concat "\n" (eval docstring)))) + (t + (setq heads (cons docstring heads)) + (setq docstring "hydra"))) + (when (keywordp (car body)) + (setq body (cons nil (cons nil body)))) + (condition-case-unless-debug err + (let* ((keymap (copy-keymap hydra-base-map)) + (keymap-name (intern (format "%S/keymap" name))) + (body-name (intern (format "%S/body" name))) + (body-key (cadr body)) + (body-plist (cddr body)) + (body-map (or (car body) + (plist-get body-plist :bind))) + (body-pre (plist-get body-plist :pre)) + (body-body-pre (plist-get body-plist :body-pre)) + (body-before-exit (or (plist-get body-plist :post) + (plist-get body-plist :before-exit))) + (body-after-exit (plist-get body-plist :after-exit)) + (body-inherit (plist-get body-plist :inherit)) + (body-foreign-keys (hydra--body-foreign-keys body)) + (body-exit (hydra--body-exit body))) + (dolist (base body-inherit) + (setq heads (append heads (copy-sequence (eval base))))) + (dolist (h heads) + (let ((len (length h))) + (cond ((< len 2) + (error "Each head should have at least two items: %S" h)) + ((= len 2) + (setcdr (cdr h) + (list + (hydra-plist-get-default + body-plist :hint hydra-default-hint))) + (setcdr (nthcdr 2 h) (list :exit body-exit))) + (t + (let ((hint (cl-caddr h))) + (unless (or (null hint) + (stringp hint) + (consp hint)) + (let ((inherited-hint + (hydra-plist-get-default + body-plist :hint hydra-default-hint))) + (setcdr (cdr h) (cons + (if (eq 'none inherited-hint) + nil + inherited-hint) + (cddr h)))))) + (let ((hint-and-plist (cddr h))) + (if (null (cdr hint-and-plist)) + (setcdr hint-and-plist (list :exit body-exit)) + (let* ((plist (cl-cdddr h)) + (h-color (plist-get plist :color))) + (if h-color + (progn + (plist-put plist :exit + (cl-case h-color + ((blue teal) t) + (t nil))) + (cl-remf (cl-cdddr h) :color)) + (let ((h-exit (hydra-plist-get-default plist :exit 'default))) + (plist-put plist :exit + (if (eq h-exit 'default) + body-exit + h-exit)))))))))) + (plist-put (cl-cdddr h) :cmd-name (hydra--head-name h name)) + (when (null (cadr h)) (plist-put (cl-cdddr h) :exit t))) + (let ((doc (hydra--doc body-key body-name heads)) + (heads-nodup (hydra--delete-duplicates heads))) + (mapc + (lambda (x) + (define-key keymap (kbd (car x)) + (plist-get (cl-cdddr x) :cmd-name))) + heads) + (hydra--make-funcall body-pre) + (hydra--make-funcall body-body-pre) + (hydra--make-funcall body-before-exit) + (hydra--make-funcall body-after-exit) + (when (memq body-foreign-keys '(run warn)) + (unless (cl-some + (lambda (h) + (hydra--head-property h :exit)) + heads) + (error + "An %S Hydra must have at least one blue head in order to exit" + body-foreign-keys))) + `(progn + ;; create keymap + (set (defvar ,keymap-name + nil + ,(format "Keymap for %S." name)) + ',keymap) + ;; declare heads + (set (defvar ,(intern (format "%S/heads" name)) + nil + ,(format "Heads for %S." name)) + ',(mapcar (lambda (h) + (let ((j (copy-sequence h))) + (cl-remf (cl-cdddr j) :cmd-name) + j)) + heads)) + (set + (defvar ,(intern (format "%S/hint" name)) nil + ,(format "Dynamic hint for %S." name)) + ',(hydra--format name body docstring heads)) + ;; create defuns + ,@(mapcar + (lambda (head) + (hydra--make-defun name body doc head keymap-name + body-pre + body-before-exit + body-after-exit)) + heads-nodup) + ;; free up keymap prefix + ,@(unless (or (null body-key) + (null body-map) + (hydra--callablep body-map)) + `((unless (keymapp (lookup-key ,body-map (kbd ,body-key))) + (define-key ,body-map (kbd ,body-key) nil)))) + ;; bind keys + ,@(delq nil + (mapcar + (lambda (head) + (let ((name (hydra--head-property head :cmd-name))) + (when (and (cadr head) + (or body-key body-map)) + (let ((bind (hydra--head-property head :bind body-map)) + (final-key + (if body-key + (vconcat (kbd body-key) (kbd (car head))) + (kbd (car head))))) + (cond ((null bind) nil) + ((hydra--callablep bind) + `(funcall ,bind ,final-key (function ,name))) + ((and (symbolp bind) + (if (boundp bind) + (keymapp (symbol-value bind)) + t)) + `(define-key ,bind ,final-key (quote ,name))) + (t + (error "Invalid :bind property `%S' for head %S" bind head))))))) + heads)) + ,(hydra--make-defun + name body doc '(nil body) + keymap-name + (or body-body-pre body-pre) body-before-exit + '(setq prefix-arg current-prefix-arg))))) + (error + (hydra--complain "Error in defhydra %S: %s" name (cdr err)) + nil))) + +(defmacro defhydradio (name _body &rest heads) + "Create radios 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)) + `(progn + ,@(apply #'append + (mapcar (lambda (h) + (hydra--radio name h)) + heads)) + (defvar ,(intern (format "%S/names" name)) + ',(mapcar (lambda (h) (intern (format "%S/%S" name (car h)))) + heads)))) + +(defun hydra--radio (parent head) + "Generate a hydradio with PARENT from HEAD." + (let* ((name (car head)) + (full-name (intern (format "%S/%S" parent name))) + (doc (cadr head)) + (val (or (cl-caddr head) [nil t]))) + `((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." + (cond ((null x) + nil) + ((symbolp x) + (list 'quote x)) + (t + 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)) + (cl-incf i))) + (error "Val not in range for %S" sym))) + (set sym + (aref range + (if (>= i l) + 0 + i))))) + +(defvar hydra-pause-ring (make-ring 10) + "Ring for paused hydras.") + +(defun hydra-pause-resume () + "Quit the current hydra and save it to the stack. +If there's no active hydra, pop one from the stack and call its body. +If the stack is empty, call the last hydra's body." + (interactive) + (cond (hydra-curr-map + (ring-insert hydra-pause-ring hydra-curr-body-fn) + (hydra-keyboard-quit)) + ((zerop (ring-length hydra-pause-ring)) + (funcall hydra-curr-body-fn)) + (t + (funcall (ring-remove hydra-pause-ring 0))))) + +;; Local Variables: +;; outline-regexp: ";;\\([;*]+ [^\s\t\n]\\|###autoload\\)\\|(" +;; indent-tabs-mode: nil +;; End: + +(provide 'hydra) + +;;; hydra.el ends here diff --git a/lv.el b/lv.el new file mode 100644 index 0000000..87f7e5e --- /dev/null +++ b/lv.el @@ -0,0 +1,117 @@ +;;; lv.el --- Other echo area + +;; 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 . + +;;; Commentary: +;; +;; This package provides `lv-message' intended to be used in place of +;; `message' when semi-permanent hints are needed, in order to not +;; interfere with Echo Area. +;; +;; "Я тихо-тихо пiдглядаю, +;; І тiшуся собi, як бачу то, +;; Шо страшить i не пiдпускає, +;; А iншi п’ють тебе, як воду пiсок." +;; -- Андрій Кузьменко, L.V. + +;;; Code: + +(defgroup lv nil + "The other echo area." + :group 'minibuffer + :group 'hydra) + +(defcustom lv-use-separator nil + "Whether to draw a line between the LV window and the Echo Area." + :group 'lv + :type 'boolean) + +(defface lv-separator + '((((class color) (background light)) :background "grey80") + (((class color) (background dark)) :background "grey30")) + "Face used to draw line between the lv window and the echo area. +This is only used if option `lv-use-separator' is non-nil. +Only the background color is significant." + :group 'lv) + +(defvar lv-wnd nil + "Holds the current LV window.") + +(defun lv-window () + "Ensure that LV window is live and return it." + (if (window-live-p lv-wnd) + lv-wnd + (let ((ori (selected-window)) + buf) + (prog1 (setq lv-wnd + (select-window + (let ((ignore-window-parameters t)) + (split-window + (frame-root-window) -1 'below)))) + (if (setq buf (get-buffer " *LV*")) + (switch-to-buffer buf) + (switch-to-buffer " *LV*") + (set-window-hscroll lv-wnd 0) + (setq window-size-fixed t) + (setq mode-line-format nil) + (setq cursor-type nil) + (set-window-dedicated-p lv-wnd t) + (set-window-parameter lv-wnd 'no-other-window t)) + (select-window ori))))) + +(defvar golden-ratio-mode) + +(defvar lv-force-update nil + "When non-nil, `lv-message' will refresh even for the same string.") + +(defun lv-message (format-string &rest args) + "Set LV window contents to (`format' FORMAT-STRING ARGS)." + (let* ((str (apply #'format format-string args)) + (n-lines (cl-count ?\n str)) + deactivate-mark + golden-ratio-mode) + (with-selected-window (lv-window) + (unless (and (string= (buffer-string) str) + (null lv-force-update)) + (delete-region (point-min) (point-max)) + (insert str) + (when (and (window-system) lv-use-separator) + (unless (looking-back "\n" nil) + (insert "\n")) + (insert + (propertize "__" 'face 'lv-separator 'display '(space :height (1))) + (propertize "\n" 'face 'lv-separator 'line-height t))) + (set (make-local-variable 'window-min-height) n-lines) + (setq truncate-lines (> n-lines 1)) + (let ((window-resize-pixelwise t) + (window-size-fixed nil)) + (fit-window-to-buffer nil nil 1))) + (goto-char (point-min))))) + +(defun lv-delete-window () + "Delete LV window and kill its buffer." + (when (window-live-p lv-wnd) + (let ((buf (window-buffer lv-wnd))) + (delete-window lv-wnd) + (kill-buffer buf)))) + +(provide 'lv) + +;;; lv.el ends here diff --git a/targets/hydra-init.el b/targets/hydra-init.el new file mode 100644 index 0000000..881ceb6 --- /dev/null +++ b/targets/hydra-init.el @@ -0,0 +1,27 @@ +;;; hydra-test.el --- bare hydra init + +;; 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 . + +(add-to-list 'load-path default-directory) +(require 'hydra) +(setq hydra-examples-verbatim t) +(require 'hydra-examples) +(require 'hydra-test) +(mapc #'byte-compile-file '("hydra.el" "hydra-examples.el" "hydra-ox.el" "hydra-test.el" "lv.el")) -- cgit v1.2.3 From cee8d180ce3e25625caf6b567f7eed65ce447955 Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 26 Jul 2017 10:47:38 -0300 Subject: Remove badge icon and screenshots from README file This patch removes badges icon and screenshots from README files. This icon is intended rather for developers, badge and screenshots are loaded from several external web sites and not included in the original source. Gbp-Pq: Name 0001-clean-documentation.diff --- README.md | 8 -------- 1 file changed, 8 deletions(-) diff --git a/README.md b/README.md index d2237d8..4c2852c 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,6 @@ -[![Build Status](https://travis-ci.org/abo-abo/hydra.svg?branch=master)](https://travis-ci.org/abo-abo/hydra) - 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.jpg) - ## Description for Poets Once you summon the Hydra through the prefixed binding (the body + any one head), all heads can be @@ -85,10 +81,6 @@ For any Hydra: ## The impressive-looking one -Here's the result of pressing . in the good-old Buffer menu: - -![hydra-buffer-menu](http://oremacs.com/download/hydra-buffer-menu.png) - The code is large but very simple: ```cl -- cgit v1.2.3 From 58de592e2725661bf566fb3ab51f0a7a6711884b Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Sat, 2 Jun 2018 20:55:09 -0300 Subject: Remove badge icon and screenshots from README file This patch removes badges icon and screenshots from README files. This icon is intended rather for developers, badge and screenshots are loaded from several external web sites and not included in the original source. Gbp-Pq: Name 0001-clean-documentation.diff --- README.md | 8 -------- 1 file changed, 8 deletions(-) diff --git a/README.md b/README.md index d2237d8..4c2852c 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,6 @@ -[![Build Status](https://travis-ci.org/abo-abo/hydra.svg?branch=master)](https://travis-ci.org/abo-abo/hydra) - 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.jpg) - ## Description for Poets Once you summon the Hydra through the prefixed binding (the body + any one head), all heads can be @@ -85,10 +81,6 @@ For any Hydra: ## The impressive-looking one -Here's the result of pressing . in the good-old Buffer menu: - -![hydra-buffer-menu](http://oremacs.com/download/hydra-buffer-menu.png) - The code is large but very simple: ```cl -- cgit v1.2.3 From 89fdf5584e8c18f7f4e427f0f80c436cd250b37b Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 10 Jul 2019 12:59:25 -0300 Subject: Import hydra-el_0.15.0-1.debian.tar.xz [dgit import tarball hydra-el 0.15.0-1 hydra-el_0.15.0-1.debian.tar.xz] --- changelog | 57 +++++++++++++++++++++++++++++++++++ control | 39 ++++++++++++++++++++++++ copyright | 29 ++++++++++++++++++ elpa-hydra.README.Debian | 12 ++++++++ elpa-hydra.docs | 1 + elpa-hydra.elpa | 3 ++ elpa-lv.elpa | 1 + patches/0001-clean-documentation.diff | 35 +++++++++++++++++++++ patches/0002-lv-version.diff | 14 +++++++++ patches/series | 2 ++ rules | 4 +++ source/format | 1 + watch | 4 +++ 13 files changed, 202 insertions(+) create mode 100644 changelog create mode 100644 control create mode 100644 copyright create mode 100644 elpa-hydra.README.Debian create mode 100644 elpa-hydra.docs create mode 100644 elpa-hydra.elpa create mode 100644 elpa-lv.elpa create mode 100644 patches/0001-clean-documentation.diff create mode 100644 patches/0002-lv-version.diff create mode 100644 patches/series create mode 100755 rules create mode 100644 source/format create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 0000000..385a526 --- /dev/null +++ b/changelog @@ -0,0 +1,57 @@ +hydra-el (0.15.0-1) unstable; urgency=medium + + * New upstream version 0.15.0 + * Package hydra and lv as separate packages + * Migrate to debhelper 12 without d/compat + * d/control: Declare Standards-Version 4.4.0 (no changes needed) + * d/copyright: Bump copyright years + * Remove obsolete patch for tests + * Refresh patch to clean documentation + * Add new patch to add version number to lv.el + * Add README to explain where to find hydra-examples.el + + -- Lev Lamberov Wed, 10 Jul 2019 20:59:25 +0500 + +hydra-el (0.14-3) unstable; urgency=medium + + * Add patch to fix tests for Emacs 26 (Closes: #916808) + * Migrate to dh 11 + * d/control: Update Maintainer (to Debian Emacsen team) + * d/control: Declare Standards-Version 4.3.0 (no changes needed) + * d/control: Add Rules-Requires-Root: no + * d/control: Drop emacs24 and emacs25 from Enhances + * d/copyright: Bump copyright years + * d/rules: Drop --parallel + + -- Lev Lamberov Tue, 01 Jan 2019 14:46:16 +0500 + +hydra-el (0.14-2) unstable; urgency=medium + + * Team upload. + * Rebuild with dh-elpa 1.13 to fix byte-compilation with unversioned + emacs + + -- David Bremner Sat, 02 Jun 2018 20:55:09 -0300 + +hydra-el (0.14-1) unstable; urgency=medium + + * New upstream version 0.14 + * Clean d/control: remove hardcoded dependency on emacsen-common and + Built-Using field + + -- Lev Lamberov Wed, 26 Jul 2017 18:47:38 +0500 + +hydra-el (0.13.6-2) unstable; urgency=medium + + [ Nicholas D Steeves ] + * Make dependencies comply with Debian Emacs Policy. + - debian/control: Depend on emacsen-common (>= 2.0.8) instead of emacs. + * debian/control: Bump Standards-Version to 4.0.0 (no changes needed). + + -- Lev Lamberov Thu, 13 Jul 2017 17:55:08 +0500 + +hydra-el (0.13.6-1) unstable; urgency=low + + * Initial release (Closes: #843075) + + -- Lev Lamberov Thu, 3 Nov 2016 18:50:41 +0500 diff --git a/control b/control new file mode 100644 index 0000000..27137d0 --- /dev/null +++ b/control @@ -0,0 +1,39 @@ +Source: hydra-el +Section: lisp +Priority: optional +Maintainer: Debian Emacsen team +Uploaders: Lev Lamberov +Build-Depends: debhelper-compat (= 12), + dh-elpa +Standards-Version: 4.4.0 +Rules-Requires-Root: no +Testsuite: autopkgtest-pkg-elpa +Homepage: https://github.com/abo-abo/hydra +Vcs-Browser: https://salsa.debian.org/emacsen-team/hydra-el +Vcs-Git: https://salsa.debian.org/emacsen-team/hydra-el.git + +Package: elpa-hydra +Architecture: all +Depends: ${elpa:Depends}, + ${misc:Depends} +Recommends: emacs (>= 46.0) +Enhances: emacs +Description: make Emacs bindings that stick around + 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. Once you summon + your Hydra through the prefixed binding (the body + any one head), all heads + can be called in succession with only a short extension. Hydra can be vanished + with any binding that isn't the Hydra's head (and that binding will call a + proper command too). This makes the Hydra very seamless, it's like a minor + mode that disables itself automagically. + +Package: elpa-lv +Architecture: all +Depends: ${elpa:Depends}, + ${misc:Depends} +Recommends: emacs (>= 46.0) +Enhances: emacs +Description: other echo area + This package provides `lv-message' intended to be used in place of + `message' when semi-permanent hints are needed, in order to not + interfere with Echo Area. diff --git a/copyright b/copyright new file mode 100644 index 0000000..488bf03 --- /dev/null +++ b/copyright @@ -0,0 +1,29 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: hydra +Upstream-Contact: Oleh Krehel +Source: https://github.com/abo-abo/hydra + +Files: * +Copyright: (C) 2015-2019 Free Software Foundation, Inc. +License: GPL-3+ + +Files: debian/* +Copyright: (C) 2016-2019 Lev Lamberov +License: GPL-3+ + +License: GPL-3+ + This program 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. + . + This program 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 this program. If not, see . + . + On Debian systems, the complete text of the GNU General + Public License version 3 can be found in `/usr/share/common-licenses/GPL-3' diff --git a/elpa-hydra.README.Debian b/elpa-hydra.README.Debian new file mode 100644 index 0000000..54ee614 --- /dev/null +++ b/elpa-hydra.README.Debian @@ -0,0 +1,12 @@ +hydra-examples.el in Debian +--------------------------- + +Hydra examples (hydra-examples.el) are installed alongside hydra code +(hydra.el, etc.). This is done to allow users load and use these +example hydras in their Emacs configuration. Those who want to take a +look at the examples will find them at system site-lisp directory, e. +g. /usr/share/emacs/site-lisp/elpa-src/hydra-0.15.0/ (the exact path +depends on your Emacs version and the version of the elpa-hydra +package). + + -- Lev Lamberov , Wed, 10 Jul 2019 20:58:28 +0500 diff --git a/elpa-hydra.docs b/elpa-hydra.docs new file mode 100644 index 0000000..dd44972 --- /dev/null +++ b/elpa-hydra.docs @@ -0,0 +1 @@ +*.md diff --git a/elpa-hydra.elpa b/elpa-hydra.elpa new file mode 100644 index 0000000..9726fae --- /dev/null +++ b/elpa-hydra.elpa @@ -0,0 +1,3 @@ +hydra.el +hydra-examples.el +hydra-ox.el diff --git a/elpa-lv.elpa b/elpa-lv.elpa new file mode 100644 index 0000000..6a5dde4 --- /dev/null +++ b/elpa-lv.elpa @@ -0,0 +1 @@ +lv.el diff --git a/patches/0001-clean-documentation.diff b/patches/0001-clean-documentation.diff new file mode 100644 index 0000000..008e512 --- /dev/null +++ b/patches/0001-clean-documentation.diff @@ -0,0 +1,35 @@ +From: Lev Lamberov +Subject: Remove badge icon and screenshots from README file + +This patch removes badges icon and screenshots from README files. This icon +is intended rather for developers, badge and screenshots are loaded from +several external web sites and not included in the original source. + +--- a/README.md ++++ b/README.md +@@ -1,14 +1,8 @@ + # Hydra + +-[![Build Status](https://travis-ci.org/abo-abo/hydra.svg?branch=master)](https://travis-ci.org/abo-abo/hydra) +-[![MELPA](https://melpa.org/packages/hydra-badge.svg)](https://melpa.org/#/hydra) +-[![MELPA Stable](https://stable.melpa.org/packages/hydra-badge.svg)](https://stable.melpa.org/#/hydra) +- + 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.jpg) +- + ## Description for Poets + + Once you summon the Hydra through the prefixed binding (the body + any one head), all heads can be +@@ -89,10 +83,6 @@ For any Hydra: + + ## The impressive-looking one + +-Here's the result of pressing . in the good-old Buffer menu: +- +-![hydra-buffer-menu](http://oremacs.com/download/hydra-buffer-menu.png) +- + The code is large but very simple: + + ```cl diff --git a/patches/0002-lv-version.diff b/patches/0002-lv-version.diff new file mode 100644 index 0000000..6deeb35 --- /dev/null +++ b/patches/0002-lv-version.diff @@ -0,0 +1,14 @@ +From: Lev Lamberov +Subject: Add version number to lv.el + +This patch adds Package-Version declaration to lv.el as it is done in +the stable MELPA repository. + +--- a/lv.el ++++ b/lv.el +@@ -1,4 +1,5 @@ + ;;; lv.el --- Other echo area ++;; Package-Version: 0.15.0 + + ;; Copyright (C) 2015 Free Software Foundation, Inc. + diff --git a/patches/series b/patches/series new file mode 100644 index 0000000..2d32e94 --- /dev/null +++ b/patches/series @@ -0,0 +1,2 @@ +0001-clean-documentation.diff +0002-lv-version.diff diff --git a/rules b/rules new file mode 100755 index 0000000..e8e22ba --- /dev/null +++ b/rules @@ -0,0 +1,4 @@ +#!/usr/bin/make -f + +%: + dh $@ --with elpa diff --git a/source/format b/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/watch b/watch new file mode 100644 index 0000000..65a0fcc --- /dev/null +++ b/watch @@ -0,0 +1,4 @@ +version=4 + opts="filenamemangle=s%(?:.*?)?v?(\d[\d.]*)\.tar\.gz%hydra-el-$1.tar.gz%" \ + https://github.com/abo-abo/hydra/tags \ + (?:.*?/)?v?(\d[\d.]*)\.tar\.gz debian uupdate -- cgit v1.2.3 From 3222d3227064338ff1a80c20b974aa7301680fa3 Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 10 Jul 2019 12:59:25 -0300 Subject: Import hydra-el_0.15.0.orig.tar.gz [dgit import orig hydra-el_0.15.0.orig.tar.gz] --- .dir-locals.el | 6 + .elpaignore | 6 + .travis.yml | 14 + Makefile | 22 + README.md | 433 +++++++++++++ doc/Changelog.org | 69 ++ hydra-examples.el | 393 +++++++++++ hydra-ox.el | 127 ++++ hydra-test.el | 1722 +++++++++++++++++++++++++++++++++++++++++++++++++ hydra.el | 1536 +++++++++++++++++++++++++++++++++++++++++++ lv.el | 120 ++++ targets/hydra-init.el | 27 + 12 files changed, 4475 insertions(+) create mode 100644 .dir-locals.el create mode 100644 .elpaignore create mode 100644 .travis.yml create mode 100644 Makefile create mode 100644 README.md create mode 100644 doc/Changelog.org create mode 100644 hydra-examples.el create mode 100644 hydra-ox.el create mode 100644 hydra-test.el create mode 100644 hydra.el create mode 100644 lv.el create mode 100644 targets/hydra-init.el diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..eb08357 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,6 @@ +;;; Directory Local Variables +;;; For more information see (info "(emacs) Directory Variables") + +((emacs-lisp-mode + (bug-reference-url-format . "https://github.com/abo-abo/hydra/issues/%s") + (indent-tabs-mode . nil))) diff --git a/.elpaignore b/.elpaignore new file mode 100644 index 0000000..a6b1577 --- /dev/null +++ b/.elpaignore @@ -0,0 +1,6 @@ +targets/ +.travis.yml +.dir-locals.el +Makefile +README.md +hydra-test.el diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..e97acdb --- /dev/null +++ b/.travis.yml @@ -0,0 +1,14 @@ +language: emacs-lisp +env: + matrix: + - emacs=emacs24 + - emacs=emacs-snapshot + +before_install: + - sudo add-apt-repository -y ppa:cassou/emacs + - sudo add-apt-repository -y ppa:ubuntu-elisp + - sudo apt-get update -qq + - sudo apt-get install -qq $emacs + +script: + - make test diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..13fd618 --- /dev/null +++ b/Makefile @@ -0,0 +1,22 @@ +emacs ?= emacs +# emacs = emacs-24.3 + +LOAD = -l lv.el -l hydra.el -l hydra-test.el + +.PHONY: all test clean + +all: test + +test: + @echo "Using $(shell which $(emacs))..." + $(emacs) -batch $(LOAD) -f ert-run-tests-batch-and-exit + +run: + $(emacs) -q $(LOAD) -l targets/hydra-init.el + make clean + +compile: + $(emacs) -batch $(LOAD) -l targets/hydra-init.el + +clean: + rm -f *.elc diff --git a/README.md b/README.md new file mode 100644 index 0000000..35aedca --- /dev/null +++ b/README.md @@ -0,0 +1,433 @@ +# Hydra + +[![Build Status](https://travis-ci.org/abo-abo/hydra.svg?branch=master)](https://travis-ci.org/abo-abo/hydra) +[![MELPA](https://melpa.org/packages/hydra-badge.svg)](https://melpa.org/#/hydra) +[![MELPA Stable](https://stable.melpa.org/packages/hydra-badge.svg)](https://stable.melpa.org/#/hydra) + +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.jpg) + +## Description for Poets + +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. + +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 original purpose, calling his proper +command. This makes the Hydra very seamless, it's like a minor mode that disables itself +auto-magically. + +## Description for Pragmatics + +Imagine that you have bound C-c j and C-c k in your +config. You want to call C-c j and C-c k in some +(arbitrary) sequence. Hydra allows you to: + +- Bind your functions in a way that pressing C-c jjkk3j5k is +equivalent to pressing C-c j C-c j C-c k C-c k M-3 C-c j M-5 C-c +k. Any key other than j or k exits this state. + +- Assign a custom hint to this group of functions, so that you know immediately +after pressing C-c that you can follow up with j or +k. + +If you want to quickly understand the concept, see [the video demo](https://www.youtube.com/watch?v=_qZliI1BKzI). + + +**Table of Contents** + +- [Sample Hydras](#sample-hydras) + - [The one with the least amount of code](#the-one-with-the-least-amount-of-code) + - [The impressive-looking one](#the-impressive-looking-one) +- [Community wiki](#community-wiki) +- [The Rules of Hydra-tics](#the-rules-of-hydra-tics) + - [`hydra-awesome`](#hydra-awesome) + - [`awesome-map` and `awesome-binding`](#awesome-map-and-awesome-binding) + - [`awesome-plist`](#awesome-plist) + - [`:pre` and `:post`](#pre-and-post) + - [`:exit`](#exit) + - [`:foreign-keys`](#foreign-keys) + - [`:color`](#color) + - [`:timeout`](#timeout) + - [`:hint`](#hint) + - [`:bind`](#bind) + - [`awesome-docstring`](#awesome-docstring) + - [`awesome-head-1`](#awesome-head-1) + - [`head-binding`](#head-binding) + - [`head-command`](#head-command) + - [`head-hint`](#head-hint) + - [`head-plist`](#head-plist) + + + +# Sample Hydras + +## The one with the least amount of code + +```cl +(defhydra hydra-zoom (global-map "") + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +With this simple code, you can: + +- Start zooming in with <f2> g. +- Continue to zoom in with g. +- Or zoom out with l. +- Zoom in five times at once with 5g. +- Stop zooming with *any* key that isn't g or l. + +For any Hydra: + +- `digit-argument` can be called with 0-9. +- `negative-argument` can be called with -. +- `universal-argument` can be called with C-u. + +## The impressive-looking one + +Here's the result of pressing . in the good-old Buffer menu: + +![hydra-buffer-menu](http://oremacs.com/download/hydra-buffer-menu.png) + +The code is large but very simple: + +```cl +(defhydra hydra-buffer-menu (:color pink + :hint nil) + " +^Mark^ ^Unmark^ ^Actions^ ^Search +^^^^^^^^----------------------------------------------------------------- +_m_: mark _u_: unmark _x_: execute _R_: re-isearch +_s_: save _U_: unmark up _b_: bury _I_: isearch +_d_: delete ^ ^ _g_: refresh _O_: multi-occur +_D_: delete up ^ ^ _T_: files only: % -28`Buffer-menu-files-only +_~_: modified +" + ("m" Buffer-menu-mark) + ("u" Buffer-menu-unmark) + ("U" Buffer-menu-backup-unmark) + ("d" Buffer-menu-delete) + ("D" Buffer-menu-delete-backwards) + ("s" Buffer-menu-save) + ("~" Buffer-menu-not-modified) + ("x" Buffer-menu-execute) + ("b" Buffer-menu-bury) + ("g" revert-buffer) + ("T" Buffer-menu-toggle-files-only) + ("O" Buffer-menu-multi-occur :color blue) + ("I" Buffer-menu-isearch-buffers :color blue) + ("R" Buffer-menu-isearch-buffers-regexp :color blue) + ("c" nil "cancel") + ("v" Buffer-menu-select "select" :color blue) + ("o" Buffer-menu-other-window "other-window" :color blue) + ("q" quit-window "quit" :color blue)) + +(define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body) +``` + +Looking at the code, you can see `hydra-buffer-menu` as sort of a namespace construct that wraps +each function that it's given in code that shows that hint and makes it easy to call the related +functions. One additional function is created and returned as the result of `defhydra` - +`hydra-buffer-menu/body`. This function does nothing except setting up the hint and the keymap, and +is usually the entry point to complex hydras. + +To write your own hydras, you can: + +- Either modify an existing hydra to do what you want to do. +- Or read [the rules](#the-rules-of-hydra-tics), + [the examples](https://github.com/abo-abo/hydra/blob/master/hydra-examples.el), + the docstrings and comments in the source. + +# Community wiki + +You can find some user created hydras and more documentation in the project's +[community wiki](https://github.com/abo-abo/hydra/wiki/). Feel free to add your +own or edit the existing ones. + +# The Rules of Hydra-tics + +Each hydra (take `awesome` as a prefix to make it more specific) looks like this: + +``` +(defhydra hydra-awesome (awesome-map awesome-binding awesome-plist) + awesome-docstring + awesome-head-1 + awesome-head-2 + awesome-head-3 + ...) +``` + +## `hydra-awesome` + +Each hydra needs a name, and this one is named `hydra-awesome`. You can name your hydras as you wish, +but I prefer to start each one with `hydra-`, because it acts as an additional namespace layer, for example: +`hydra-zoom`, `hydra-helm`, `hydra-apropos` etc. + +If you name your hydra `hydra-awesome`, the return result of `defhydra` will be `hydra-awesome/body`. + +Here's what `hydra-zoom/body` looks like, if you're interested: + +```cl +(defun hydra-zoom/body nil + "Create a hydra with a \"\" body and the heads: + +\"g\": `text-scale-increase', +\"l\": `text-scale-decrease' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (hydra-default-pre) + (when hydra-is-helpful + (if hydra-lv + (lv-message + (eval hydra-zoom/hint)) + (message + (eval hydra-zoom/hint)))) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)) +``` + +## `awesome-map` and `awesome-binding` + +This can be any keymap, for instance, `global-map` or `isearch-mode-map`. + +For this example: + +```cl +(defhydra hydra-zoom (global-map "") + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +- `awesome-map` is `global-map` +- `awesome-binding` is `""` + +And here's the relevant generated code: + +```cl +(unless (keymapp (lookup-key global-map (kbd ""))) + (define-key global-map (kbd "") nil)) +(define-key global-map [f2 103] + (function hydra-zoom/text-scale-increase)) +(define-key global-map [f2 108] + (function hydra-zoom/text-scale-decrease)) +``` + +As you see, `""` is used as a prefix for g (char value 103) and l +(char value 108). + +If you don't want to use a map right now, you can skip it like this: + +```cl +(defhydra hydra-zoom (nil nil) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +Or even simpler: + +```cl +(defhydra hydra-zoom () + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out")) +``` + +But then you would have to bind `hydra-zoom/text-scale-increase` and +`hydra-zoom/text-scale-decrease` yourself. + +## `awesome-plist` + +You can read up on what a plist is in +[the Elisp manual](https://www.gnu.org/software/emacs/manual/html_node/elisp/Property-Lists.html). + +You can use `awesome-plist` to modify the behavior of each head in some way. +Below is a list of each key. + +### `:pre` and `:post` + +You can specify code that will be called before each head, and after the body. For example: + +```cl +(defhydra hydra-vi (:pre (set-cursor-color "#40e0d0") + :post (progn + (set-cursor-color "#ffffff") + (message + "Thank you, come again."))) + "vi" + ("l" forward-char) + ("h" backward-char) + ("j" next-line) + ("k" previous-line) + ("q" nil "quit")) +``` + +Thanks to `:pre`, each time any head is called, the cursor color is changed. +And when the hydra quits, the cursor color will be made black again with `:post`. + +### `:exit` + +The `:exit` key is inherited by every head (they can override it) and influences what will happen +after executing head's command: + +- `:exit nil` (the default) means that the hydra state will continue - you'll still see the hint and be able to use short bindings. +- `:exit t` means that the hydra state will stop. + +### `:foreign-keys` + +The `:foreign-keys` key belongs to the body and decides what to do when a key is pressed that doesn't +belong to any head: + +- `:foreign-keys nil` (the default) means that the hydra state will stop and the foreign key will +do whatever it was supposed to do if there was no hydra state. +- `:foreign-keys warn` will not stop the hydra state, but instead will issue a warning without +running the foreign key. +- `:foreign-keys run` will not stop the hydra state, and try to run the foreign key. + +### `:color` + +The `:color` key is a shortcut. It aggregates `:exit` and `:foreign-keys` key in the following way: + + | color | toggle | + |----------+----------------------------| + | red | | + | blue | :exit t | + | amaranth | :foreign-keys warn | + | teal | :foreign-keys warn :exit t | + | pink | :foreign-keys run | + +It's also a trick to make you instantly aware of the current hydra keys that you're about to press: +the keys will be highlighted with the appropriate color. + +### `:timeout` + +The `:timeout` key starts a timer for the corresponding amount of seconds that disables the hydra. +Calling any head will refresh the timer. + +### `:hint` + +The `:hint` key will be inherited by each head. Each head is allowed to override it, of course. +One value that makes sense is `:hint nil`. See below for an explanation of head hint. + +### `:bind` + +The `:bind` key provides a lambda to be used to bind each head. This is quite advanced and rarely +used, you're not likely to need it. But if you would like to bind your heads with e.g. `bind-key` +instead of `define-key` you can use this option. + +The `:bind` key can be overridden by each head. This is useful if you want to have a few heads that +are not bound outside the hydra. + +### `:base-map` +Use this option if you want to override `hydra-base-map` for the current hydra. + +## `awesome-docstring` + +This can be a simple string used to build the final hydra hint. However, if you start it with a +newline, the key-highlighting and Ruby-style string interpolation becomes enabled, as you can see in +`hydra-buffer-menu` above. + +To highlight a key, just wrap it in underscores. Note that the key must belong to one of the heads. +The key will be highlighted with the color that is appropriate to the behavior of the key, i.e. if +the key will make the hydra exit, the color will be blue. + +To insert an empty character, use `^`. The only use of this is to have your code aligned as +nicely as the result. + +To insert a dynamic Elisp variable, use `%`` followed by the variable. Each time the variable +changes due to a head, the docstring will be updated. `format`-style width specifiers can be used. + +To insert a dynamic Elisp expression, use e.g. `%(length (dired-get-marked-files))`. If a head will +change the amount of marked files, for example, it will be appropriately updated. + +If the result of the Elisp expression is a string and you don't want to quote it, use this form: +`%s(shell-command-to-string "du -hs")`. + +## `awesome-head-1` + +Each head looks like this: + +```cl +(head-binding head-command head-hint head-plist) +``` + +For the head `("g" text-scale-increase "in")`: + +- `head-binding` is `"g"`. +- `head-command` is `text-scale-increase`. +- `head-hint` is `"in"`. +- `head-plist` is `nil`. + +### `head-binding` + +The `head-binding` is a string that can be passed to `kbd`. + +### `head-command` + +The `head-command` can be: + +- command name, like `text-scale-increase`. +- a lambda, like + + ("g" (lambda () + (interactive) + (let ((current-prefix-arg 4)) + (call-interactively #'magit-status))) + "git") + +- nil, which exits the hydra. +- a single sexp, which will be wrapped in an interactive lambda. + +Here's an example of the last option: + +```cl +(defhydra hydra-launcher (:color blue) + "Launch" + ("h" man "man") + ("r" (browse-url "http://www.reddit.com/r/emacs/") "reddit") + ("w" (browse-url "http://www.emacswiki.org/") "emacswiki") + ("s" shell "shell") + ("q" nil "cancel")) +(global-set-key (kbd "C-c r") 'hydra-launcher/body) +``` + +### `head-hint` + +In case of a large body docstring, you usually don't want the head hint to show up, since +you've already documented it in the body docstring. +You can set the head hint to `nil` to do this. + +Example: + +```cl +(defhydra hydra-zoom (global-map "") + " +Press _g_ to zoom in. +" + ("g" text-scale-increase nil) + ("l" text-scale-decrease "out")) +``` + +### `head-plist` + +Here's a list of body keys that can be overridden in each head: + +- `:exit` +- `:color` +- `:bind` +- `:column` + +Use `:column` feature to have an aligned rectangular docstring without defining it manually. +See [hydra-examples.el](https://github.com/abo-abo/hydra/blob/05871dd6c8af7b2268bd1a10eb9f8a3e423209cd/hydra-examples.el#L337) for an example code. diff --git a/doc/Changelog.org b/doc/Changelog.org new file mode 100644 index 0000000..429a7dd --- /dev/null +++ b/doc/Changelog.org @@ -0,0 +1,69 @@ +* 0.15.0 +** New Features + +*** defhydra + +**** New :base-map option in body plist +In case your hydra conficts with el:hydra-base-map, you can now override it. + +Example: +#+begin_src elisp +(defhydra hydra-numbers (:base-map (make-sparse-keymap)) + "test" + ("0" (message "zero")) + ("1" (message "one"))) +#+end_src +See [[https://github.com/abo-abo/hydra/issues/285][#285]]. + +**** Make no docstring equivalent to :hint nil +Example: +#+begin_src elisp +(defhydra hydra-clock (:color blue) + ("q" nil "quit" :column "Clock") + ("c" org-clock-cancel "cancel" :color pink :column "Do") + ("d" org-clock-display "display") + ("e" org-clock-modify-effort-estimate "effort") + ("i" org-clock-in "in") + ("j" org-clock-goto "jump") + ("o" org-clock-out "out") + ("r" org-clock-report "report")) +#+end_src +See [[https://github.com/abo-abo/hydra/issues/291][#291]]. + +**** Declare /params and /docstring +See [[https://github.com/abo-abo/hydra/issues/185][#185]]. + +**** Sexp hints are now supported for :columns +Example +#+begin_src elisp +(defhydra hydra-test () + "Test" + ("j" next-line (format-time-string "%H:%M:%S" (current-time)) :column "One") + ("k" previous-line (format-time-string "%H:%M:%S" (current-time))) + ("l" backward-char "back" :column "Two")) +#+end_src +See [[https://github.com/abo-abo/hydra/issues/311][#311]]. + + +*** defhydra+ +New macro. Allows to add heads to an existing hydra. + +Example: +#+begin_src elisp +(defhydra hydra-extendable () + "extendable" + ("j" next-line "down")) + +(defhydra+ hydra-extendable () + ("k" previous-line "up")) +#+end_src +See [[https://github.com/abo-abo/hydra/issues/185][#185]]. + +*** el:hydra-hint-display-type +Customize what to use to display the hint: +- el:message +- el:lv-message +- posframe + +el:hydra-lv is now obsolete. +See [[https://github.com/abo-abo/hydra/issues/317][#317]]. diff --git a/hydra-examples.el b/hydra-examples.el new file mode 100644 index 0000000..5262ec6 --- /dev/null +++ b/hydra-examples.el @@ -0,0 +1,393 @@ +;;; 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 . + +;;; Commentary: +;; +;; These are the sample Hydras. +;; +;; If you want to use them plainly, set `hydra-examples-verbatim' to t +;; before requiring this file. But it's probably better to only look +;; at them and use them as templates for building your own. + +;;; Code: + +(require 'hydra) + +;;* Examples +;;** Example 1: text scale +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-zoom (global-map "") + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out"))) + +;; This example generates three commands: +;; +;; `hydra-zoom/text-scale-increase' +;; `hydra-zoom/text-scale-decrease' +;; `hydra-zoom/body' +;; +;; In addition, two of them are bound like this: +;; +;; (global-set-key (kbd " g") 'hydra-zoom/text-scale-increase) +;; (global-set-key (kbd " l") 'hydra-zoom/text-scale-decrease) +;; +;; Note that you can substitute `global-map' with e.g. `emacs-lisp-mode-map' if you need. +;; The functions generated will be the same, except the binding code will change to: +;; +;; (define-key emacs-lisp-mode-map [f2 103] +;; (function hydra-zoom/text-scale-increase)) +;; (define-key emacs-lisp-mode-map [f2 108] +;; (function hydra-zoom/text-scale-decrease)) + +;;** Example 2: move window splitter +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-splitter (global-map "C-M-s") + "splitter" + ("h" hydra-move-splitter-left) + ("j" hydra-move-splitter-down) + ("k" hydra-move-splitter-up) + ("l" hydra-move-splitter-right))) + +;;** Example 3: jump to error +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-error (global-map "M-g") + "goto-error" + ("h" first-error "first") + ("j" next-error "next") + ("k" previous-error "prev") + ("v" recenter-top-bottom "recenter") + ("q" nil "quit"))) + +;; This example introduces only one new thing: since the command +;; passed to the "q" head is nil, it will quit the Hydra without doing +;; anything. Heads that quit the Hydra instead of continuing are +;; referred to as having blue :color. All the other heads have red +;; :color, unless other is specified. + +;;** Example 4: toggle rarely used modes +(when (bound-and-true-p hydra-examples-verbatim) + (defvar whitespace-mode nil) + (global-set-key + (kbd "C-c C-v") + (defhydra hydra-toggle-simple (: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")))) + +;; Note that in this case, `defhydra' returns the `hydra-toggle-simple/body' +;; symbol, which is then passed to `global-set-key'. +;; +;; Another new thing is that both the keymap and the body prefix are +;; skipped. This means that `defhydra' will bind nothing - that's why +;; `global-set-key' is necessary. +;; +;; One more new thing is that you can assign a :color to the body. All +;; heads will inherit this color. The code above is very much equivalent to: +;; +;; (global-set-key (kbd "C-c C-v a") 'abbrev-mode) +;; (global-set-key (kbd "C-c C-v d") 'toggle-debug-on-error) +;; +;; The differences are: +;; +;; * You get a hint immediately after "C-c C-v" +;; * You can cancel and call a command immediately, e.g. "C-c C-v C-n" +;; is equivalent to "C-n" with Hydra approach, while it will error +;; that "C-c C-v C-n" isn't bound with the usual approach. + +;;** Example 5: mini-vi +(defun hydra-vi/pre () + (set-cursor-color "#e52b50")) + +(defun hydra-vi/post () + (set-cursor-color "#ffffff")) + +(when (bound-and-true-p hydra-examples-verbatim) + (global-set-key + (kbd "C-z") + (defhydra hydra-vi (:pre hydra-vi/pre :post hydra-vi/post :color amaranth) + "vi" + ("l" forward-char) + ("h" backward-char) + ("j" next-line) + ("k" previous-line) + ("m" set-mark-command "mark") + ("a" move-beginning-of-line "beg") + ("e" move-end-of-line "end") + ("d" delete-region "del" :color blue) + ("y" kill-ring-save "yank" :color blue) + ("q" nil "quit"))) + (hydra-set-property 'hydra-vi :verbosity 1)) + +;; This example introduces :color amaranth. It's similar to red, +;; except while you can quit red with any binding which isn't a Hydra +;; head, you can quit amaranth only with a blue head. So you can quit +;; this mode only with "d", "y", "q" or "C-g". +;; +;; Another novelty are the :pre and :post handlers. :pre will be +;; called before each command, while :post will be called when the +;; Hydra quits. In this case, they're used to override the cursor +;; color while Hydra is active. + +;;** Example 6: selective global bind +(when (bound-and-true-p hydra-examples-verbatim) + (defhydra hydra-next-error (global-map "C-x") + "next-error" + ("`" next-error "next") + ("j" next-error "next" :bind nil) + ("k" previous-error "previous" :bind nil))) + +;; This example will bind "C-x `" in `global-map', but it will not +;; bind "C-x j" and "C-x k". +;; You can still "C-x `jjk" though. + +;;** Example 7: toggle with Ruby-style docstring +(defvar whitespace-mode nil) +(defhydra hydra-toggle (:color pink) + " +_a_ abbrev-mode: %`abbrev-mode +_d_ debug-on-error: %`debug-on-error +_f_ auto-fill-mode: %`auto-fill-function +_t_ truncate-lines: %`truncate-lines +_w_ whitespace-mode: %`whitespace-mode + +" + ("a" abbrev-mode nil) + ("d" toggle-debug-on-error nil) + ("f" auto-fill-mode nil) + ("t" toggle-truncate-lines nil) + ("w" whitespace-mode nil) + ("q" nil "quit")) +;; Recommended binding: +;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body) + +;; Here, using e.g. "_a_" translates to "a" with proper face. +;; More interestingly: +;; +;; "foobar %`abbrev-mode" means roughly (format "foobar %S" abbrev-mode) +;; +;; This means that you actually see the state of the mode that you're changing. + +;;** Example 8: the whole menu for `Buffer-menu-mode' +(defhydra hydra-buffer-menu (:color pink + :hint nil) + " +^Mark^ ^Unmark^ ^Actions^ ^Search +^^^^^^^^----------------------------------------------------------------- (__) +_m_: mark _u_: unmark _x_: execute _R_: re-isearch (oo) +_s_: save _U_: unmark up _b_: bury _I_: isearch /------\\/ +_d_: delete ^ ^ _g_: refresh _O_: multi-occur / | || +_D_: delete up ^ ^ _T_: files only: % -28`Buffer-menu-files-only^^ * /\\---/\\ +_~_: modified ^ ^ ^ ^ ^^ ~~ ~~ +" + ("m" Buffer-menu-mark) + ("u" Buffer-menu-unmark) + ("U" Buffer-menu-backup-unmark) + ("d" Buffer-menu-delete) + ("D" Buffer-menu-delete-backwards) + ("s" Buffer-menu-save) + ("~" Buffer-menu-not-modified) + ("x" Buffer-menu-execute) + ("b" Buffer-menu-bury) + ("g" revert-buffer) + ("T" Buffer-menu-toggle-files-only) + ("O" Buffer-menu-multi-occur :color blue) + ("I" Buffer-menu-isearch-buffers :color blue) + ("R" Buffer-menu-isearch-buffers-regexp :color blue) + ("c" nil "cancel") + ("v" Buffer-menu-select "select" :color blue) + ("o" Buffer-menu-other-window "other-window" :color blue) + ("q" quit-window "quit" :color blue)) +;; Recommended binding: +;; (define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body) + +;;** Example 9: s-expressions in the docstring +;; You can inline s-expresssions into the docstring like this: +(defvar dired-mode-map) +(declare-function dired-mark "dired") +(when (bound-and-true-p hydra-examples-verbatim) + (require 'dired) + (defhydra hydra-marked-items (dired-mode-map "") + " +Number of marked items: %(length (dired-get-marked-files)) +" + ("m" dired-mark "mark"))) + +;; This results in the following dynamic docstring: +;; +;; (format "Number of marked items: %S\n" +;; (length (dired-get-marked-files))) +;; +;; You can use `format'-style width specs, e.g. % 10(length nil). + +;;** Example 10: apropos family +(defhydra hydra-apropos (:color blue + :hint nil) + " +_a_propos _c_ommand +_d_ocumentation _l_ibrary +_v_ariable _u_ser-option +^ ^ valu_e_" + ("a" apropos) + ("d" apropos-documentation) + ("v" apropos-variable) + ("c" apropos-command) + ("l" apropos-library) + ("u" apropos-user-option) + ("e" apropos-value)) +;; Recommended binding: +;; (global-set-key (kbd "C-c h") 'hydra-apropos/body) + +;;** Example 11: rectangle-mark-mode +(require 'rect) +(defhydra hydra-rectangle (:body-pre (rectangle-mark-mode 1) + :color pink + :post (deactivate-mark)) + " + ^_k_^ _d_elete _s_tring +_h_ _l_ _o_k _y_ank + ^_j_^ _n_ew-copy _r_eset +^^^^ _e_xchange _u_ndo +^^^^ ^ ^ _x_kill +" + ("h" rectangle-backward-char nil) + ("l" rectangle-forward-char nil) + ("k" rectangle-previous-line nil) + ("j" rectangle-next-line nil) + ("e" hydra-ex-point-mark nil) + ("n" copy-rectangle-as-kill nil) + ("d" delete-rectangle nil) + ("r" (if (region-active-p) + (deactivate-mark) + (rectangle-mark-mode 1)) nil) + ("y" yank-rectangle nil) + ("u" undo nil) + ("s" string-rectangle nil) + ("x" kill-rectangle nil) + ("o" nil nil)) + +;; Recommended binding: +;; (global-set-key (kbd "C-x SPC") 'hydra-rectangle/body) + +;;** Example 12: org-agenda-view +(defun org-agenda-cts () + (and (eq major-mode 'org-agenda-mode) + (let ((args (get-text-property + (min (1- (point-max)) (point)) + 'org-last-args))) + (nth 2 args)))) + +(defhydra hydra-org-agenda-view (:hint none) + " +_d_: ?d? day _g_: time grid=?g? _a_: arch-trees +_w_: ?w? week _[_: inactive _A_: arch-files +_t_: ?t? fortnight _f_: follow=?f? _r_: clock report=?r? +_m_: ?m? month _e_: entry text=?e? _D_: include diary=?D? +_y_: ?y? year _q_: quit _L__l__c_: log = ?l?" + ("SPC" org-agenda-reset-view) + ("d" org-agenda-day-view (if (eq 'day (org-agenda-cts)) "[x]" "[ ]")) + ("w" org-agenda-week-view (if (eq 'week (org-agenda-cts)) "[x]" "[ ]")) + ("t" org-agenda-fortnight-view (if (eq 'fortnight (org-agenda-cts)) "[x]" "[ ]")) + ("m" org-agenda-month-view (if (eq 'month (org-agenda-cts)) "[x]" "[ ]")) + ("y" org-agenda-year-view (if (eq 'year (org-agenda-cts)) "[x]" "[ ]")) + ("l" org-agenda-log-mode (format "% -3S" org-agenda-show-log)) + ("L" (org-agenda-log-mode '(4))) + ("c" (org-agenda-log-mode 'clockcheck)) + ("f" org-agenda-follow-mode (format "% -3S" org-agenda-follow-mode)) + ("a" org-agenda-archives-mode) + ("A" (org-agenda-archives-mode 'files)) + ("r" org-agenda-clockreport-mode (format "% -3S" org-agenda-clockreport-mode)) + ("e" org-agenda-entry-text-mode (format "% -3S" org-agenda-entry-text-mode)) + ("g" org-agenda-toggle-time-grid (format "% -3S" org-agenda-use-time-grid)) + ("D" org-agenda-toggle-diary (format "% -3S" org-agenda-include-diary)) + ("!" org-agenda-toggle-deadlines) + ("[" (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-redo) + (message "Display now includes inactive timestamps as well"))) + ("q" (message "Abort") :exit t) + ("v" nil)) + +;; Recommended binding: +;; (define-key org-agenda-mode-map "v" 'hydra-org-agenda-view/body) + +;;** Example 13: automatic columns +(defhydra hydra-movement () + ("j" next-line "down" :column "Vertical") + ("k" previous-line "up") + ("l" forward-char "forward" :column "Horizontal") + ("h" backward-char "back")) + +;;* Helpers +(require 'windmove) + +(defun hydra-move-splitter-left (arg) + "Move window splitter left." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'right)) + (shrink-window-horizontally arg) + (enlarge-window-horizontally arg))) + +(defun hydra-move-splitter-right (arg) + "Move window splitter right." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'right)) + (enlarge-window-horizontally arg) + (shrink-window-horizontally arg))) + +(defun hydra-move-splitter-up (arg) + "Move window splitter up." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'up)) + (enlarge-window arg) + (shrink-window arg))) + +(defun hydra-move-splitter-down (arg) + "Move window splitter down." + (interactive "p") + (if (let ((windmove-wrap-around)) + (windmove-find-other-window 'up)) + (shrink-window arg) + (enlarge-window arg))) + +(defvar rectangle-mark-mode) +(defun hydra-ex-point-mark () + "Exchange point and mark." + (interactive) + (if rectangle-mark-mode + (rectangle-exchange-point-and-mark) + (let ((mk (mark))) + (rectangle-mark-mode 1) + (goto-char mk)))) + +(provide 'hydra-examples) + +;; Local Variables: +;; no-byte-compile: t +;; End: +;;; hydra-examples.el ends here diff --git a/hydra-ox.el b/hydra-ox.el new file mode 100644 index 0000000..a992efc --- /dev/null +++ b/hydra-ox.el @@ -0,0 +1,127 @@ +;;; hydra-ox.el --- Org mode export widget implemented in 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 . + +;;; Commentary: +;; +;; This shows how a complex dispatch menu can be built with Hydra. + +;;; Code: + +(require 'hydra) +(require 'org) +(declare-function org-html-export-as-html 'ox-html) +(declare-function org-html-export-to-html 'ox-html) +(declare-function org-latex-export-as-latex 'ox-latex) +(declare-function org-latex-export-to-latex 'ox-latex) +(declare-function org-latex-export-to-pdf 'ox-latex) +(declare-function org-ascii-export-as-ascii 'ox-ascii) +(declare-function org-ascii-export-to-ascii 'ox-ascii) + +(defhydradio hydra-ox () + (body-only "Export only the body.") + (export-scope "Export scope." [buffer subtree]) + (async-export "When non-nil, export async.") + (visible-only "When non-nil, export visible only") + (force-publishing "Toggle force publishing")) + +(defhydra hydra-ox-html (:color blue) + "ox-html" + ("H" (org-html-export-as-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only) + "As HTML buffer") + ("h" (org-html-export-to-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only) "As HTML file") + ("o" (org-open-file + (org-html-export-to-html + hydra-ox/async-export + (eq hydra-ox/export-scope 'subtree) + hydra-ox/visible-only + hydra-ox/body-only)) "As HTML file and open") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox-latex (:color blue) + "ox-latex" + ("L" org-latex-export-as-latex "As LaTeX buffer") + ("l" org-latex-export-to-latex "As LaTeX file") + ("p" org-latex-export-to-pdf "As PDF file") + ("o" (org-open-file (org-latex-export-to-pdf)) "As PDF file and open") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox-text (:color blue) + "ox-text" + ("A" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset ascii)) + "As ASCII buffer") + + ("a" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset ascii)) + "As ASCII file") + ("L" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset latin1)) + "As Latin1 buffer") + ("l" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset latin1)) + "As Latin1 file") + ("U" (org-ascii-export-as-ascii + nil nil nil nil + '(:ascii-charset utf-8)) + "As UTF-8 buffer") + ("u" (org-ascii-export-to-ascii + nil nil nil nil + '(:ascii-charset utf-8)) + "As UTF-8 file") + ("b" hydra-ox/body "back") + ("q" nil "quit")) + +(defhydra hydra-ox () + " +_C-b_ Body only: % -15`hydra-ox/body-only^^^ _C-v_ Visible only: %`hydra-ox/visible-only +_C-s_ Export scope: % -15`hydra-ox/export-scope _C-f_ Force publishing: %`hydra-ox/force-publishing +_C-a_ Async export: %`hydra-ox/async-export + +" + ("C-b" (hydra-ox/body-only) nil) + ("C-v" (hydra-ox/visible-only) nil) + ("C-s" (hydra-ox/export-scope) nil) + ("C-f" (hydra-ox/force-publishing) nil) + ("C-a" (hydra-ox/async-export) nil) + ("h" hydra-ox-html/body "Export to HTML" :exit t) + ("l" hydra-ox-latex/body "Export to LaTeX" :exit t) + ("t" hydra-ox-text/body "Export to Plain Text" :exit t) + ("q" nil "quit")) + +(define-key org-mode-map (kbd "C-c C-,") 'hydra-ox/body) + +(provide 'hydra-ox) + +;;; hydra-ox.el ends here diff --git a/hydra-test.el b/hydra-test.el new file mode 100644 index 0000000..f09689d --- /dev/null +++ b/hydra-test.el @@ -0,0 +1,1722 @@ +;;; hydra-test.el --- Tests 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 . + +;;; Commentary: +;; + +;;; Code: + +(require 'ert) +(require 'hydra) +(setq text-quoting-style 'grave) +(message "Emacs version: %s" emacs-version) + +(ert-deftest hydra-red-error () + (should + (equal + (macroexpand + '(defhydra hydra-error (global-map "M-g") + "error" + ("h" first-error "first") + ("j" next-error "next") + ("k" previous-error "prev") + ("SPC" hydra-repeat "rep" :bind nil))) + '(progn + (set + (defvar hydra-error/params nil + "Params of hydra-error.") + (quote (global-map "M-g"))) + (set + (defvar hydra-error/docstring nil + "Docstring of hydra-error.") + "error") + (set + (defvar hydra-error/heads nil + "Heads for hydra-error.") + (quote + (("h" + first-error + "first" + :exit nil) + ("j" + next-error + "next" + :exit nil) + ("k" + previous-error + "prev" + :exit nil) + ("SPC" + hydra-repeat + "rep" + :bind nil + :exit nil)))) + (set + (defvar hydra-error/keymap nil + "Keymap for hydra-error.") + (quote + (keymap + (32 . hydra-repeat) + (107 . hydra-error/previous-error) + (106 . hydra-error/next-error) + (104 . hydra-error/first-error) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra--digit-argument) + (48 . hydra--digit-argument) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-error/hint nil + "Dynamic hint for hydra-error.") + (quote + (format + #("error: [h]: first, [j]: next, [k]: prev, [SPC]: rep." + 8 9 (face hydra-face-red) + 20 21 (face hydra-face-red) + 31 32 (face hydra-face-red) + 42 45 (face hydra-face-red))))) + (defun hydra-error/first-error nil + "Call the head `first-error' in the \"hydra-error\" hydra. + +The heads for the associated hydra are: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body', which is bound to \"M-g\"." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (condition-case err + (progn + (setq this-command + (quote first-error)) + (hydra--call-interactively-remap-maybe + (function first-error))) + ((quit error) + (message + (error-message-string err)))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-error/next-error nil + "Call the head `next-error' in the \"hydra-error\" hydra. + +The heads for the associated hydra are: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body', which is bound to \"M-g\"." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (condition-case err + (progn + (setq this-command + (quote next-error)) + (hydra--call-interactively-remap-maybe + (function next-error))) + ((quit error) + (message + (error-message-string err)))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-error/previous-error nil + "Call the head `previous-error' in the \"hydra-error\" hydra. + +The heads for the associated hydra are: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body', which is bound to \"M-g\"." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (condition-case err + (progn + (setq this-command + (quote previous-error)) + (hydra--call-interactively-remap-maybe + (function previous-error))) + ((quit error) + (message + (error-message-string err)))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (unless (keymapp + (lookup-key + global-map + (kbd "M-g"))) + (define-key global-map (kbd "M-g") + nil)) + (define-key global-map [134217831 104] + (quote hydra-error/first-error)) + (define-key global-map [134217831 106] + (quote hydra-error/next-error)) + (define-key global-map [134217831 107] + (quote + hydra-error/previous-error)) + (defun hydra-error/body nil + "Call the body in the \"hydra-error\" hydra. + +The heads for the associated hydra are: + +\"h\": `first-error', +\"j\": `next-error', +\"k\": `previous-error', +\"SPC\": `hydra-repeat' + +The body can be accessed via `hydra-error/body', which is bound to \"M-g\"." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-error/body))) + (hydra-show-hint + hydra-error/hint + (quote hydra-error)) + (hydra-set-transient-map + hydra-error/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-blue-toggle () + (should + (equal + (macroexpand + '(defhydra hydra-toggle (:color blue) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel"))) + '(progn + (set + (defvar hydra-toggle/params nil + "Params of hydra-toggle.") + (quote + (nil + nil + :exit t + :foreign-keys nil))) + (set + (defvar hydra-toggle/docstring nil + "Docstring of hydra-toggle.") + "toggle") + (set + (defvar hydra-toggle/heads nil + "Heads for hydra-toggle.") + (quote + (("t" + toggle-truncate-lines + "truncate" + :exit t) + ("f" + auto-fill-mode + "fill" + :exit t) + ("a" + abbrev-mode + "abbrev" + :exit t) + ("q" nil "cancel" :exit t)))) + (set + (defvar hydra-toggle/keymap nil + "Keymap for hydra-toggle.") + (quote + (keymap + (113 . hydra-toggle/nil) + (97 . hydra-toggle/abbrev-mode-and-exit) + (102 . hydra-toggle/auto-fill-mode-and-exit) + (116 . hydra-toggle/toggle-truncate-lines-and-exit) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra--digit-argument) + (48 . hydra--digit-argument) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-toggle/hint nil + "Dynamic hint for hydra-toggle.") + (quote + (format + #("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))))) + (defun hydra-toggle/toggle-truncate-lines-and-exit nil + "Call the head `toggle-truncate-lines' in the \"hydra-toggle\" hydra. + +The heads for the associated hydra are: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `hydra-toggle/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) + (progn + (setq this-command + (quote toggle-truncate-lines)) + (hydra--call-interactively-remap-maybe + (function + toggle-truncate-lines)))) + (defun hydra-toggle/auto-fill-mode-and-exit nil + "Call the head `auto-fill-mode' in the \"hydra-toggle\" hydra. + +The heads for the associated hydra are: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `hydra-toggle/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) + (progn + (setq this-command + (quote auto-fill-mode)) + (hydra--call-interactively-remap-maybe + (function auto-fill-mode)))) + (defun hydra-toggle/abbrev-mode-and-exit nil + "Call the head `abbrev-mode' in the \"hydra-toggle\" hydra. + +The heads for the associated hydra are: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `hydra-toggle/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body)) + (progn + (setq this-command + (quote abbrev-mode)) + (hydra--call-interactively-remap-maybe + (function abbrev-mode)))) + (defun hydra-toggle/nil nil + "Call the head `nil' in the \"hydra-toggle\" hydra. + +The heads for the associated hydra are: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `hydra-toggle/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body))) + (defun hydra-toggle/body nil + "Call the body in the \"hydra-toggle\" hydra. + +The heads for the associated hydra are: + +\"t\": `toggle-truncate-lines', +\"f\": `auto-fill-mode', +\"a\": `abbrev-mode', +\"q\": `nil' + +The body can be accessed via `hydra-toggle/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-toggle/body))) + (hydra-show-hint + hydra-toggle/hint + (quote hydra-toggle)) + (hydra-set-transient-map + hydra-toggle/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-amaranth-vi () + (should + (equal + (macroexpand + '(defhydra hydra-vi + (:pre + (set-cursor-color "#e52b50") + :post + (set-cursor-color "#ffffff") + :color amaranth) + "vi" + ("j" next-line) + ("k" previous-line) + ("q" nil "quit"))) + '(progn + (set + (defvar hydra-vi/params nil + "Params of hydra-vi.") + (quote + (nil + nil + :exit nil + :foreign-keys warn + :post (set-cursor-color "#ffffff") + :pre (set-cursor-color "#e52b50")))) + (set + (defvar hydra-vi/docstring nil + "Docstring of hydra-vi.") + "vi") + (set + (defvar hydra-vi/heads nil + "Heads for hydra-vi.") + (quote + (("j" next-line "" :exit nil) + ("k" + previous-line + "" + :exit nil) + ("q" nil "quit" :exit t)))) + (set + (defvar hydra-vi/keymap nil + "Keymap for hydra-vi.") + (quote + (keymap + (113 . hydra-vi/nil) + (107 . hydra-vi/previous-line) + (106 . hydra-vi/next-line) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra--digit-argument) + (48 . hydra--digit-argument) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-vi/hint nil + "Dynamic hint for hydra-vi.") + (quote + (format + #("vi: j, k, [q]: quit." + 4 5 (face hydra-face-amaranth) + 7 8 (face hydra-face-amaranth) + 11 12 (face hydra-face-teal))))) + (defun hydra-vi/next-line nil + "Call the head `next-line' in the \"hydra-vi\" hydra. + +The heads for the associated hydra are: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (condition-case err + (progn + (setq this-command + (quote next-line)) + (hydra--call-interactively-remap-maybe + (function next-line))) + ((quit error) + (message + (error-message-string err)))) + (hydra-show-hint + hydra-vi/hint + (quote hydra-vi)) + (hydra-set-transient-map + hydra-vi/keymap + (lambda nil + (hydra-keyboard-quit) + (set-cursor-color "#ffffff")) + (quote warn))) + (defun hydra-vi/previous-line nil + "Call the head `previous-line' in the \"hydra-vi\" hydra. + +The heads for the associated hydra are: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (condition-case err + (progn + (setq this-command + (quote previous-line)) + (hydra--call-interactively-remap-maybe + (function previous-line))) + ((quit error) + (message + (error-message-string err)))) + (hydra-show-hint + hydra-vi/hint + (quote hydra-vi)) + (hydra-set-transient-map + hydra-vi/keymap + (lambda nil + (hydra-keyboard-quit) + (set-cursor-color "#ffffff")) + (quote warn))) + (defun hydra-vi/nil nil + "Call the head `nil' in the \"hydra-vi\" hydra. + +The heads for the associated hydra are: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (defun hydra-vi/body nil + "Call the body in the \"hydra-vi\" hydra. + +The heads for the associated hydra are: + +\"j\": `next-line', +\"k\": `previous-line', +\"q\": `nil' + +The body can be accessed via `hydra-vi/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (set-cursor-color "#e52b50") + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-vi/body))) + (hydra-show-hint + hydra-vi/hint + (quote hydra-vi)) + (hydra-set-transient-map + hydra-vi/keymap + (lambda nil + (hydra-keyboard-quit) + (set-cursor-color "#ffffff")) + (quote warn)) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-zoom-duplicate-1 () + (should + (equal + (macroexpand + '(defhydra hydra-zoom () + "zoom" + ("r" (text-scale-set 0) "reset") + ("0" (text-scale-set 0) :bind nil :exit t) + ("1" (text-scale-set 0) nil :bind nil :exit t))) + '(progn + (set + (defvar hydra-zoom/params nil + "Params of hydra-zoom.") + (quote (nil nil))) + (set + (defvar hydra-zoom/docstring nil + "Docstring of hydra-zoom.") + "zoom") + (set + (defvar hydra-zoom/heads nil + "Heads for hydra-zoom.") + (quote + (("r" + (text-scale-set 0) + "reset" + :exit nil) + ("0" + (text-scale-set 0) + "" + :bind nil + :exit t) + ("1" + (text-scale-set 0) + nil + :bind nil + :exit t)))) + (set + (defvar hydra-zoom/keymap nil + "Keymap for hydra-zoom.") + (quote + (keymap + (114 . hydra-zoom/lambda-r) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra-zoom/lambda-0-and-exit) + (48 . hydra-zoom/lambda-0-and-exit) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-zoom/hint nil + "Dynamic hint for hydra-zoom.") + (quote + (format + #("zoom: [r 0]: reset." + 7 8 (face hydra-face-red) + 9 10 (face hydra-face-blue))))) + (defun hydra-zoom/lambda-r nil + "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra. + +The heads for the associated hydra are: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (condition-case err + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0)))) + ((quit error) + (message + (error-message-string err)))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-zoom/lambda-0-and-exit nil + "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra. + +The heads for the associated hydra are: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body)) + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0))))) + (defun hydra-zoom/body nil + "Call the body in the \"hydra-zoom\" hydra. + +The heads for the associated hydra are: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest hydra-zoom-duplicate-2 () + (should + (equal + (macroexpand + '(defhydra hydra-zoom () + "zoom" + ("r" (text-scale-set 0) "reset") + ("0" (text-scale-set 0) :bind nil :exit t) + ("1" (text-scale-set 0) nil :bind nil))) + '(progn + (set + (defvar hydra-zoom/params nil + "Params of hydra-zoom.") + (quote (nil nil))) + (set + (defvar hydra-zoom/docstring nil + "Docstring of hydra-zoom.") + "zoom") + (set + (defvar hydra-zoom/heads nil + "Heads for hydra-zoom.") + (quote + (("r" + (text-scale-set 0) + "reset" + :exit nil) + ("0" + (text-scale-set 0) + "" + :bind nil + :exit t) + ("1" + (text-scale-set 0) + nil + :bind nil + :exit nil)))) + (set + (defvar hydra-zoom/keymap nil + "Keymap for hydra-zoom.") + (quote + (keymap + (114 . hydra-zoom/lambda-r) + (kp-subtract . hydra--negative-argument) + (kp-9 . hydra--digit-argument) + (kp-8 . hydra--digit-argument) + (kp-7 . hydra--digit-argument) + (kp-6 . hydra--digit-argument) + (kp-5 . hydra--digit-argument) + (kp-4 . hydra--digit-argument) + (kp-3 . hydra--digit-argument) + (kp-2 . hydra--digit-argument) + (kp-1 . hydra--digit-argument) + (kp-0 . hydra--digit-argument) + (57 . hydra--digit-argument) + (56 . hydra--digit-argument) + (55 . hydra--digit-argument) + (54 . hydra--digit-argument) + (53 . hydra--digit-argument) + (52 . hydra--digit-argument) + (51 . hydra--digit-argument) + (50 . hydra--digit-argument) + (49 . hydra-zoom/lambda-r) + (48 . hydra-zoom/lambda-0-and-exit) + (45 . hydra--negative-argument) + (21 . hydra--universal-argument)))) + (set + (defvar hydra-zoom/hint nil + "Dynamic hint for hydra-zoom.") + (quote + (format + #("zoom: [r 0]: reset." + 7 8 (face hydra-face-red) + 9 10 (face hydra-face-blue))))) + (defun hydra-zoom/lambda-r nil + "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra. + +The heads for the associated hydra are: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore t)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (condition-case err + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0)))) + ((quit error) + (message + (error-message-string err)))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil)) + (defun hydra-zoom/lambda-0-and-exit nil + "Call the head `(text-scale-set 0)' in the \"hydra-zoom\" hydra. + +The heads for the associated hydra are: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body)) + (hydra--call-interactively-remap-maybe + (function + (lambda nil + (interactive) + (text-scale-set 0))))) + (defun hydra-zoom/body nil + "Call the body in the \"hydra-zoom\" hydra. + +The heads for the associated hydra are: + +\"r\": `(text-scale-set 0)', +\"0\": `(text-scale-set 0)', +\"1\": `(text-scale-set 0)' + +The body can be accessed via `hydra-zoom/body'." + (interactive) + (require (quote hydra)) + (hydra-default-pre) + (let ((hydra--ignore nil)) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn + (quote hydra-zoom/body))) + (hydra-show-hint + hydra-zoom/hint + (quote hydra-zoom)) + (hydra-set-transient-map + hydra-zoom/keymap + (lambda nil + (hydra-keyboard-quit) + nil) + nil) + (setq prefix-arg + current-prefix-arg)))))) + +(ert-deftest defhydradio () + (should (equal + (macroexpand + '(defhydradio hydra-test () + (num "Num" [0 1 2 3 4 5 6 7 8 9 10]) + (str "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)) + (defvar hydra-test/names '(hydra-test/num hydra-test/str)))))) + +(ert-deftest hydra-blue-compat () + (should + (equal + (macroexpand + '(defhydra hydra-toggle (:color blue) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel"))) + (macroexpand + '(defhydra hydra-toggle (:exit t) + "toggle" + ("t" toggle-truncate-lines "truncate") + ("f" auto-fill-mode "fill") + ("a" abbrev-mode "abbrev") + ("q" nil "cancel")))))) + +(ert-deftest hydra-amaranth-compat () + (should + (equal + (macroexpand + '(defhydra hydra-vi + (:pre + (set-cursor-color "#e52b50") + :post + (set-cursor-color "#ffffff") + :color amaranth) + "vi" + ("j" next-line) + ("k" previous-line) + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-vi + (:pre + (set-cursor-color "#e52b50") + :post + (set-cursor-color "#ffffff") + :foreign-keys warn) + "vi" + ("j" next-line) + ("k" previous-line) + ("q" nil "quit")))))) + +(ert-deftest hydra-pink-compat () + (should + (equal + (macroexpand + '(defhydra hydra-zoom (global-map "" + :color pink) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-zoom (global-map "" + :foreign-keys run) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit")))))) + +(ert-deftest hydra-teal-compat () + (should + (equal + (macroexpand + '(defhydra hydra-zoom (global-map "" + :color teal) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit"))) + (macroexpand + '(defhydra hydra-zoom (global-map "" + :foreign-keys warn + :exit t) + "zoom" + ("g" text-scale-increase "in") + ("l" text-scale-decrease "out") + ("q" nil "quit")))))) + +(ert-deftest hydra-format-1 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'hydra-toggle + nil + " +_a_ abbrev-mode: %`abbrev-mode +_d_ debug-on-error: %`debug-on-error +_f_ auto-fill-mode: %`auto-fill-function +" '(("a" abbrev-mode nil) + ("d" toggle-debug-on-error nil) + ("f" auto-fill-mode nil) + ("g" golden-ratio-mode nil) + ("t" toggle-truncate-lines nil) + ("w" whitespace-mode nil) + ("q" nil "quit")))) + '(format + "%s abbrev-mode: %S +%s debug-on-error: %S +%s auto-fill-mode: %S +[{q}]: quit." + "{a}" abbrev-mode + "{d}" debug-on-error + "{f}" auto-fill-function)))) + +(ert-deftest hydra-format-2 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'bar + nil + "\n bar %s`foo\n" + '(("a" (quote t) "" :cmd-name bar/lambda-a :exit nil) + ("q" nil "" :cmd-name bar/nil :exit t)))) + '(format " bar %s\n{a}, [q]." foo)))) + +(ert-deftest hydra-format-3 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'bar + nil + "\n__ ^^ace jump\n" + '(("" ace-jump-char-mode nil :cmd-name bar/ace-jump-char-mode)))) + '(format "%s ace jump\n" "{}")))) + +(ert-deftest hydra-format-4 () + (should + (equal (hydra--format + nil + '(nil nil :hint nil) + "\n_j_,_k_" + '(("j" nil nil :exit t) ("k" nil nil :exit t))) + '(format "%s,%s" + #("j" 0 1 (face hydra-face-blue)) + #("k" 0 1 (face hydra-face-blue)))))) + +(ert-deftest hydra-format-5 () + (should + (equal (hydra--format + nil nil "\n_-_: mark _u_: unmark\n" + '(("-" Buffer-menu-mark nil) + ("u" Buffer-menu-unmark nil))) + '(format + "%s: mark %s: unmark\n" + #("-" 0 1 (face hydra-face-red)) + #("u" 0 1 (face hydra-face-red)))))) + +(ert-deftest hydra-format-6 () + (should + (equal (hydra--format + nil nil "\n[_]_] forward [_[_] backward\n" + '(("]" forward-char nil) + ("[" backward-char nil))) + '(format + "[%s] forward [%s] backward\n" + #("]" + 0 1 (face + hydra-face-red)) + #("[" + 0 1 (face + hydra-face-red)))))) + +(ert-deftest hydra-format-7 () + (should + (equal + (hydra--format nil nil "test" + '(("%" forward-char "" :exit nil) + ("b" backward-char "" :exit nil))) + '(format + #("test: %%%%, b." + 6 7 (face hydra-face-red) + 7 8 (face hydra-face-red) + 8 9 (face hydra-face-red) + 9 10 (face hydra-face-red) + 12 13 (face hydra-face-red))))) + (should + (equal + (hydra--format nil nil "\n_%_ forward\n" + '(("%" forward-char nil :exit nil))) + '(format + "%s forward\n" + #("%%" + 0 2 (face hydra-face-red)))))) + +(ert-deftest hydra-format-8 () + (should + (equal + (hydra--format nil '(nil nil :hint nil) "test" + '(("f" forward-char nil :exit nil) + ("b" backward-char "back" :exit nil))) + '(format + #("test: [b]: back." + 7 8 (face hydra-face-red)))))) + +(ert-deftest hydra-format-9 () + (should + (equal + (hydra--format nil '(nil nil :hint nil) "\n_f_(foo)" + '(("f" forward-char nil :exit nil))) + '(format + "%s(foo)" + #("f" 0 1 (face hydra-face-red)))))) + +(ert-deftest hydra-format-10 () + (should + (equal + (hydra--format nil '(nil nil) "Test:" + '(("j" next-line (format-time-string "%H:%M:%S" (current-time)) + :exit nil))) + '(concat + (format "Test:\n") + (mapconcat + (function + hydra--eval-and-format) + (quote + ((#("j" 0 1 (face hydra-face-red)) + format-time-string + "%H:%M:%S" + (current-time)))) + ", ") + ".")))) + +(ert-deftest hydra-format-with-sexp-1 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'hydra-toggle nil + "\n_n_ narrow-or-widen-dwim %(progn (message \"checking\")(buffer-narrowed-p))asdf\n" + '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t)))) + '(format + "%s narrow-or-widen-dwim %Sasdf\n[[q]]: cancel." + "{n}" + (progn + (message "checking") + (buffer-narrowed-p)))))) + +(ert-deftest hydra-format-with-sexp-2 () + (should (equal + (let ((hydra-fontify-head-function + 'hydra-fontify-head-greyscale)) + (hydra--format + 'hydra-toggle nil + "\n_n_ narrow-or-widen-dwim %s(progn (message \"checking\")(buffer-narrowed-p))asdf\n" + '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t)))) + '(format + "%s narrow-or-widen-dwim %sasdf\n[[q]]: cancel." + "{n}" + (progn + (message "checking") + (buffer-narrowed-p)))))) + +(ert-deftest hydra-compat-colors-2 () + (should + (equal + (cddr (macroexpand + '(defhydra hydra-test (:color amaranth) + ("a" fun-a) + ("b" fun-b :color blue) + ("c" fun-c :color blue) + ("d" fun-d :color blue) + ("e" fun-e :color blue) + ("f" fun-f :color blue)))) + (cddr (macroexpand + '(defhydra hydra-test (:color teal) + ("a" fun-a :color red) + ("b" fun-b) + ("c" fun-c) + ("d" fun-d) + ("e" fun-e) + ("f" fun-f))))))) + +(ert-deftest hydra-compat-colors-3 () + (should + (equal + (cddr (macroexpand + '(defhydra hydra-test () + ("a" fun-a) + ("b" fun-b :color blue) + ("c" fun-c :color blue) + ("d" fun-d :color blue) + ("e" fun-e :color blue) + ("f" fun-f :color blue)))) + (cddr (macroexpand + '(defhydra hydra-test (:color blue) + ("a" fun-a :color red) + ("b" fun-b) + ("c" fun-c) + ("d" fun-d) + ("e" fun-e) + ("f" fun-f))))))) + +(ert-deftest hydra-compat-colors-4 () + (should + (equal + (cddr (macroexpand + '(defhydra hydra-test () + ("a" fun-a) + ("b" fun-b :exit t) + ("c" fun-c :exit t) + ("d" fun-d :exit t) + ("e" fun-e :exit t) + ("f" fun-f :exit t)))) + (cddr (macroexpand + '(defhydra hydra-test (:exit t) + ("a" fun-a :exit nil) + ("b" fun-b) + ("c" fun-c) + ("d" fun-d) + ("e" fun-e) + ("f" fun-f))))))) + +(ert-deftest hydra--pad () + (should (equal (hydra--pad '(a b c) 3) + '(a b c))) + (should (equal (hydra--pad '(a) 3) + '(a nil nil)))) + +(ert-deftest hydra--matrix () + (should (equal (hydra--matrix '(a b c) 2 2) + '((a b) (c nil)))) + (should (equal (hydra--matrix '(a b c d e f g h i) 4 3) + '((a b c d) (e f g h) (i nil nil nil))))) + +(ert-deftest hydra--cell () + (should (equal (hydra--cell "% -75s %%`%s" '(hydra-lv hydra-verbose)) + "When non-nil, `lv-message' (not `message') will be used to display hints. %`hydra-lv^^^^^ +When non-nil, hydra will issue some non essential style warnings. %`hydra-verbose"))) + +(ert-deftest hydra--vconcat () + (should (equal (hydra--vconcat '("abc\ndef" "012\n34" "def\nabc")) + "abc012def\ndef34abc"))) + +(defhydradio hydra-tng () + (picard "_p_ Captain Jean Luc Picard:") + (riker "_r_ Commander William Riker:") + (data "_d_ Lieutenant Commander Data:") + (worf "_w_ Worf:") + (la-forge "_f_ Geordi La Forge:") + (troi "_t_ Deanna Troi:") + (dr-crusher "_c_ Doctor Beverly Crusher:") + (phaser "_h_ Set phasers to " [stun kill])) + +(ert-deftest hydra--table () + (let ((hydra-cell-format "% -30s %% -8`%s")) + (should (equal (hydra--table hydra-tng/names 5 2) + (substring " +_p_ Captain Jean Luc Picard: % -8`hydra-tng/picard^^ _t_ Deanna Troi: % -8`hydra-tng/troi^^^^^^ +_r_ Commander William Riker: % -8`hydra-tng/riker^^^ _c_ Doctor Beverly Crusher: % -8`hydra-tng/dr-crusher +_d_ Lieutenant Commander Data: % -8`hydra-tng/data^^^^ _h_ Set phasers to % -8`hydra-tng/phaser^^^^ +_w_ Worf: % -8`hydra-tng/worf^^^^ +_f_ Geordi La Forge: % -8`hydra-tng/la-forge" 1))) + (should (equal (hydra--table hydra-tng/names 4 3) + (substring " +_p_ Captain Jean Luc Picard: % -8`hydra-tng/picard _f_ Geordi La Forge: % -8`hydra-tng/la-forge^^ +_r_ Commander William Riker: % -8`hydra-tng/riker^ _t_ Deanna Troi: % -8`hydra-tng/troi^^^^^^ +_d_ Lieutenant Commander Data: % -8`hydra-tng/data^^ _c_ Doctor Beverly Crusher: % -8`hydra-tng/dr-crusher +_w_ Worf: % -8`hydra-tng/worf^^ _h_ Set phasers to % -8`hydra-tng/phaser^^^^" 1))))) + +(ert-deftest hydra--make-funcall () + (should (equal (let ((body-pre 'foo)) + (hydra--make-funcall body-pre) + body-pre) + '(funcall (function foo))))) + +(defhydra hydra-simple-1 (global-map "C-c") + ("a" (insert "j")) + ("b" (insert "k")) + ("q" nil)) + +(defhydra hydra-simple-2 (global-map "C-c" :color amaranth) + ("c" self-insert-command) + ("d" self-insert-command) + ("q" nil)) + +(defhydra hydra-simple-3 (global-map "C-c") + ("g" goto-line) + ("1" find-file) + ("q" nil)) + +(defun remapable-print () + (interactive) + (insert "remapable print was called")) +(defun remaped-print () + (interactive) + (insert "*remaped* print was called")) +(define-key global-map (kbd "C-=") 'remapable-print) +(define-key global-map [remap remapable-print] 'remaped-print) + +(defhydra hydra-simple-with-remap (global-map "C-c") + ("r" remapable-print) + ("q" nil)) + +(defmacro hydra-with (in &rest body) + `(let ((temp-buffer (generate-new-buffer " *temp*"))) + (save-window-excursion + (unwind-protect + (progn + (switch-to-buffer temp-buffer) + (transient-mark-mode 1) + (insert ,in) + (goto-char (point-min)) + (when (search-forward "~" nil t) + (backward-delete-char 1) + (set-mark (point))) + (goto-char (point-max)) + (search-backward "|") + (delete-char 1) + (setq current-prefix-arg nil) + ,@body + (insert "|") + (when (region-active-p) + (exchange-point-and-mark) + (insert "~")) + (buffer-substring-no-properties + (point-min) + (point-max))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer)))))) + +(ert-deftest hydra-integration-1 () + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c aabbaaqaabbaa"))) + "jjkkjjaabbaa|")) + (should (string= (hydra-with "|" + (condition-case nil + (execute-kbd-macro + (kbd "C-c aabb C-g")) + (quit nil)) + (execute-kbd-macro "aaqaabbaa")) + "jjkkaaqaabbaa|"))) + +(ert-deftest hydra-integration-2 () + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c c 1 c 2 d 4 c q"))) + "ccddcccc|")) + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c c 1 c C-u d C-u 10 c q"))) + "ccddddcccccccccc|"))) + +(ert-deftest hydra-integration-3 () + (should (string= (hydra-with "foo\nbar|" + (execute-kbd-macro + (kbd "C-c g 1 RET q"))) + "|foo\nbar"))) + +(ert-deftest hydra-remap-lookup-1 () + "try calling a remapped command while option is disabled " + (setq hydra-look-for-remap nil) + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c rq"))) + "remapable print was called|"))) +(ert-deftest hydra-remap-lookup-2 () + "try calling a remapped command while option is enabled" + (setq hydra-look-for-remap t) + (should (string= (hydra-with "|" + (execute-kbd-macro + (kbd "C-c rq"))) + "*remaped* print was called|"))) + +(ert-deftest hydra-columns-1 () + (should (equal (eval + (cadr + (nth 2 + (nth 5 + (macroexpand + '(defhydra hydra-info (:color blue + :columns 3) + "Info-mode" + ("?" Info-summary "summary") + ("]" Info-forward-node "forward") + ("[" Info-backward-node "backward") + ("<" Info-top-node "top node") + (">" Info-final-node "final node") + ("h" Info-help "help") + ("d" Info-directory "info dir") + ("f" Info-follow-reference "follow ref") + ("g" Info-goto-node "goto node") + ("l" Info-history-back "hist back") + ("r" Info-history-forward "hist forward") + ("i" Info-index "index") + ("I" Info-virtual-index "virtual index") + ("L" Info-history "hist") + ("n" Info-next "next") + ("p" Info-prev "previous") + ("s" Info-search "search") + ("S" Info-search-case-sensitively "case-search") + ("T" Info-toc "TOC") + ("u" Info-up "up") + ("m" Info-menu "menu") + ("t" hydra-info-to/body "info-to"))))))) + #("Info-mode: +?: summary ]: forward [: backward +<: top node >: final node h: help +d: info dir f: follow ref g: goto node +l: hist back r: hist forward i: index +I: virtual index L: hist n: next +p: previous s: search S: case-search +T: TOC u: up m: menu +t: info-to" + 11 12 (face hydra-face-blue) + 28 29 (face hydra-face-blue) + 45 46 (face hydra-face-blue) + 57 58 (face hydra-face-blue) + 74 75 (face hydra-face-blue) + 91 92 (face hydra-face-blue) + 99 100 (face hydra-face-blue) + 116 117 (face hydra-face-blue) + 133 134 (face hydra-face-blue) + 146 147 (face hydra-face-blue) + 163 164 (face hydra-face-blue) + 180 181 (face hydra-face-blue) + 189 190 (face hydra-face-blue) + 206 207 (face hydra-face-blue) + 223 224 (face hydra-face-blue) + 231 232 (face hydra-face-blue) + 248 249 (face hydra-face-blue) + 265 266 (face hydra-face-blue) + 280 281 (face hydra-face-blue) + 297 298 (face hydra-face-blue) + 314 315 (face hydra-face-blue) + 322 323 (face hydra-face-blue))))) + +(ert-deftest hydra-columns-2 () + (should (equal (eval + (cadr + (nth 2 + (nth 5 + (macroexpand + '(defhydra hydra-foo (:color blue) + "Silly hydra" + ("x" forward-char "forward" :column "sideways") + ("y" backward-char "back") + ("a" next-line "down" :column "vertical") + ("b" previous-line "up"))))))) + #("Silly hydra: +sideways | vertical +----------- | ----------- +x: forward | a: down +y: back | b: up +" + 62 63 (face hydra-face-blue) + 76 77 (face hydra-face-blue) + 84 85 (face hydra-face-blue) + 98 99 (face hydra-face-blue))))) + +;; checked: +;; basic rendering +;; column compatibility with ruby style and no colum specified +;; column declared several time +;; nil column +(ert-deftest hydra-column-basic () + (should (equal (eval + (cadr + (nth 2 + (nth 5 + (macroexpand + '(defhydra hydra-rectangle (:body-pre (rectangle-mark-mode 1) + :color pink + :post (deactivate-mark)) + " + ^_k_^ ()() +_h_ _l_ (O)(o) + ^_j_^ ( O ) +^^^^ (’’)(’’) +^^^^ +" + ("h" backward-char nil) + ("l" forward-char nil) + ("k" previous-line nil) + ("j" next-line nil) + ("Of" 5x5 "outside of table 1") + ("e" exchange-point-and-mark "exchange" :column "firstcol") + ("n" copy-rectangle-as-kill "new-copy") + ("d" delete-rectangle "delete") + ("r" (if (region-active-p) + (deactivate-mark) + (rectangle-mark-mode 1)) "reset" :column "secondcol") + ("y" yank-rectangle "yank") + ("u" undo "undo") + ("s" string-rectangle "string") + ("p" kill-rectangle "paste") + ("o" nil "ok" :column "firstcol") + ("Os" 5x5-bol "outside of table 2" :column nil) + ("Ot" 5x5-eol "outside of table 3"))))))) + #(" k ()() +h l (O)(o) + j ( O ) + (’’)(’’) + +firstcol | secondcol +----------- | ------------ +e: exchange | r: reset +n: new-copy | y: yank +d: delete | u: undo +o: ok | s: string + | p: paste +[Of]: outside of table 1, [Os]: outside of table 2, [Ot]: outside of table 3." + 2 3 (face hydra-face-pink) + 17 18 (face hydra-face-pink) + 21 22 (face hydra-face-pink) + 38 39 (face hydra-face-pink) + 128 129 (face hydra-face-pink) + 142 143 (face hydra-face-pink) + 151 152 (face hydra-face-pink) + 165 166 (face hydra-face-pink) + 173 174 (face hydra-face-pink) + 187 188 (face hydra-face-pink) + 195 196 (face hydra-face-blue) + 209 210 (face hydra-face-pink) + 233 234 (face hydra-face-pink) + 243 245 (face hydra-face-pink) + 269 271 (face hydra-face-pink) + 295 297 (face hydra-face-pink))))) + +;; check column order is the same as they appear in defhydra +(ert-deftest hydra-column-order () + (should (equal (eval + (cadr + (nth 2 + (nth 5 + (macroexpand + '(defhydra hydra-window-order + (:color red :timeout 4) + ("z" ace-window "ace" :color blue :column "Switch") + ("h" windmove-left "← window") + ("j" windmove-down "↓ window") + ("l" windmove-right "→ window") + ("s" split-window-below "split window" :color blue :column "Split Management") + ("v" split-window-right "split window vertically" :color blue) + ("d" delete-window "delete current window") + ("f" follow-mode "toogle follow mode") + ("u" winner-undo "undo window conf" :column "Undo/Redo") + ("r" winner-redo "redo window conf") + ("b" balance-windows "balance window height" :column "1-Sizing") + ("m" maximize-window "maximize current window") + ("k" windmove-up "↑ window" :column "Switch") + ("M" minimize-window "minimize current window" :column "1-Sizing") + ("q" nil "quit menu" :color blue :column nil))))))) + #("Switch | Split Management | Undo/Redo | 1-Sizing +----------- | -------------------------- | ------------------- | -------------------------- +z: ace | s: split window | u: undo window conf | b: balance window height +h: ← window | v: split window vertically | r: redo window conf | m: maximize current window +j: ↓ window | d: delete current window | | M: minimize current window +l: → window | f: toogle follow mode | | +k: ↑ window | | | +[q]: quit menu." + 173 174 (face hydra-face-blue) + 187 188 (face hydra-face-blue) + 216 217 (face hydra-face-red) + 238 239 (face hydra-face-red) + 263 264 (face hydra-face-red) + 277 278 (face hydra-face-blue) + 306 307 (face hydra-face-red) + 328 329 (face hydra-face-red) + 355 356 (face hydra-face-red) + 369 370 (face hydra-face-red) + 420 421 (face hydra-face-red) + 447 448 (face hydra-face-red) + 461 462 (face hydra-face-red) + 512 513 (face hydra-face-red) + 578 579 (face hydra-face-blue))))) + +(ert-deftest hydra-column-sexp () + (should (equal + (eval (nth 5 + (macroexpand + '(defhydra hydra-toggle-stuff () + "Toggle" + ("d" toggle-debug-on-error "debug-on-error" :column "Misc") + ("a" abbrev-mode + (format "abbrev: %s" + (if (bound-and-true-p abbrev-mode) + "[x]" + "[ ]"))))))) + '(concat + (format "Toggle:\n") + "Misc" + "\n" + "-----------------" + "\n" + #("d: debug-on-error" + 0 1 (face hydra-face-red)) + "\n" + (format + "%1s: %-15s" + #("a" 0 1 (face hydra-face-red)) + (format + "abbrev: %s" + (if (bound-and-true-p abbrev-mode) + "[x]" + "[ ]"))) + "\n")))) + +(defhydra hydra-extendable () + "extendable" + ("j" next-line "down")) + +(ert-deftest hydra-extend () + (should (equal (macroexpand + '(defhydra+ hydra-extendable () + ("k" previous-line "up"))) + (macroexpand + '(defhydra hydra-extendable () + "extendable" + ("j" next-line "down") + ("k" previous-line "up"))))) + (should (equal (macroexpand + '(defhydra+ hydra-extendable () + ("k" previous-line "up" :exit t))) + (macroexpand + '(defhydra hydra-extendable () + "extendable" + ("j" next-line "down") + ("k" previous-line "up" :exit t)))))) + +(provide 'hydra-test) + +;;; hydra-test.el ends here diff --git a/hydra.el b/hydra.el new file mode 100644 index 0000000..4137823 --- /dev/null +++ b/hydra.el @@ -0,0 +1,1536 @@ +;;; hydra.el --- Make bindings that stick around. -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2019 Free Software Foundation, Inc. + +;; Author: Oleh Krehel +;; Maintainer: Oleh Krehel +;; URL: https://github.com/abo-abo/hydra +;; Version: 0.15.0 +;; Keywords: bindings +;; Package-Requires: ((cl-lib "0.5") (lv "0")) + +;; 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 . + +;;; 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 an example Hydra, bound in the global map (you can use any +;; keymap in place of `global-map'): +;; +;; (defhydra hydra-zoom (global-map "") +;; "zoom" +;; ("g" text-scale-increase "in") +;; ("l" text-scale-decrease "out")) +;; +;; It allows to start a command chain either like this: +;; " gg4ll5g", or " lgllg". +;; +;; Here's another approach, when you just want a "callable keymap": +;; +;; (defhydra hydra-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")) +;; +;; This binds nothing so far, but if you follow up with: +;; +;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body) +;; +;; you will have bound "C-c C-v a", "C-c C-v d" etc. +;; +;; Knowing that `defhydra' defines e.g. `hydra-toggle/body' command, +;; you can nest Hydras if you wish, with `hydra-toggle/body' possibly +;; becoming a blue head of another Hydra. +;; +;; If you want to learn all intricacies of using `defhydra' without +;; having to figure it all out from this source code, check out the +;; wiki: https://github.com/abo-abo/hydra/wiki. There's a wealth of +;; information there. Everyone is welcome to bring the existing pages +;; up to date and add new ones. +;; +;; Additionally, the file hydra-examples.el serves to demo most of the +;; functionality. + +;;; Code: +;;* Requires +(require 'cl-lib) +(require 'lv) +(require 'ring) + +(defvar hydra-curr-map nil + "The keymap of the current Hydra called.") + +(defvar hydra-curr-on-exit nil + "The on-exit predicate for the current Hydra.") + +(defvar hydra-curr-foreign-keys nil + "The current :foreign-keys behavior.") + +(defvar hydra-curr-body-fn nil + "The current hydra-.../body function.") + +(defvar hydra-deactivate nil + "If a Hydra head sets this to t, exit the Hydra. +This will be done even if the head wasn't designated for exiting.") + +(defvar hydra-amaranth-warn-message "An amaranth Hydra can only exit through a blue head" + "Amaranth Warning message. Shown when the user tries to press an unbound/non-exit key while in an amaranth head.") + +(defun hydra-set-transient-map (keymap on-exit &optional foreign-keys) + "Set KEYMAP to the highest priority. + +Call ON-EXIT when the KEYMAP is deactivated. + +FOREIGN-KEYS determines the deactivation behavior, when a command +that isn't in KEYMAP is called: + +nil: deactivate KEYMAP and run the command. +run: keep KEYMAP and run the command. +warn: keep KEYMAP and issue a warning instead of running the command." + (if hydra-deactivate + (hydra-keyboard-quit) + (setq hydra-curr-map keymap) + (setq hydra-curr-on-exit on-exit) + (setq hydra-curr-foreign-keys foreign-keys) + (add-hook 'pre-command-hook 'hydra--clearfun) + (internal-push-keymap keymap 'overriding-terminal-local-map))) + +(defun hydra--clearfun () + "Disable the current Hydra unless `this-command' is a head." + (unless (eq this-command 'hydra-pause-resume) + (when (or + (memq this-command '(handle-switch-frame + keyboard-quit)) + (null overriding-terminal-local-map) + (not (or (eq this-command + (lookup-key hydra-curr-map (this-single-command-keys))) + (cl-case hydra-curr-foreign-keys + (warn + (setq this-command 'hydra-amaranth-warn)) + (run + t) + (t nil))))) + (hydra-disable)))) + +(defvar hydra--ignore nil + "When non-nil, don't call `hydra-curr-on-exit'.") + +(defvar hydra--input-method-function nil + "Store overridden `input-method-function' here.") + +(defun hydra-disable () + "Disable the current Hydra." + (setq hydra-deactivate nil) + (remove-hook 'pre-command-hook 'hydra--clearfun) + (unless hydra--ignore + (if (fboundp 'remove-function) + (remove-function input-method-function #'hydra--imf) + (when hydra--input-method-function + (setq input-method-function hydra--input-method-function) + (setq hydra--input-method-function nil)))) + (dolist (frame (frame-list)) + (with-selected-frame frame + (when overriding-terminal-local-map + (internal-pop-keymap hydra-curr-map 'overriding-terminal-local-map)))) + (unless hydra--ignore + (when hydra-curr-on-exit + (let ((on-exit hydra-curr-on-exit)) + (setq hydra-curr-on-exit nil) + (funcall on-exit))))) + +(unless (fboundp 'internal-push-keymap) + (defun internal-push-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (unless (memq keymap map) + (unless (memq 'add-keymap-witness (symbol-value symbol)) + (setq map (make-composed-keymap nil (symbol-value symbol))) + (push 'add-keymap-witness (cdr map)) + (set symbol map)) + (push keymap (cdr map)))))) + +(unless (fboundp 'internal-pop-keymap) + (defun internal-pop-keymap (keymap symbol) + (let ((map (symbol-value symbol))) + (when (memq keymap map) + (setf (cdr map) (delq keymap (cdr map)))) + (let ((tail (cddr map))) + (and (or (null tail) (keymapp tail)) + (eq 'add-keymap-witness (nth 1 map)) + (set symbol tail)))))) + +(defun hydra-amaranth-warn () + "Issue a warning that the current input was ignored." + (interactive) + (message hydra-amaranth-warn-message)) + +;;* Customize +(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) + +(defcustom hydra-default-hint "" + "Default :hint property to use for heads when not specified in +the body or the head." + :type 'sexp + :group 'hydra) + +(declare-function posframe-show "posframe") +(declare-function posframe-hide "posframe") +(declare-function posframe-poshandler-window-center "posframe") + +(defun hydra-posframe-show (str) + (require 'posframe) + (posframe-show + " *hydra-posframe*" + :string str + :poshandler #'posframe-poshandler-window-center)) + +(defun hydra-posframe-hide () + (posframe-hide " *hydra-posframe*")) + +(defvar hydra-hint-display-alist + (list (list 'lv #'lv-message #'lv-delete-window) + (list 'message #'message (lambda () (message ""))) + (list 'posframe #'hydra-posframe-show #'hydra-posframe-hide)) + "Store the functions for `hydra-hint-display-type'.") + +(defcustom hydra-hint-display-type 'lv + "The utility to show hydra hint" + :type '(choice + (const message) + (const lv) + (const posframe)) + :group 'hydra) + +(define-obsolete-variable-alias + 'hydra-lv 'hydra-hint-display-type "0.14.0" + "Use either `hydra-hint-display-type' or `hydra-set-property' :verbosity.") + +(defcustom hydra-lv t + "When non-nil, `lv-message' (not `message') will be used to display hints." + :type 'boolean) + +(defcustom hydra-verbose nil + "When non-nil, hydra will issue some non essential style warnings." + :type 'boolean) + +(defcustom hydra-key-format-spec "%s" + "Default `format'-style specifier for _a_ syntax in docstrings. +When nil, you can specify your own at each location like this: _ 5a_." + :type 'string) + +(defcustom hydra-doc-format-spec "%s" + "Default `format'-style specifier for ?a? syntax in docstrings." + :type 'string) + +(defcustom hydra-look-for-remap nil + "When non-nil, hydra binding behaves as keymap binding with [remap]. +When calling a head with a simple command, hydra will lookup for a potential +remap command according to the current active keymap and call it instead if +found" + :type 'boolean) + +(make-obsolete-variable + 'hydra-key-format-spec + "Since the docstrings are aligned by hand anyway, this isn't very useful." + "0.13.1") + +(defface hydra-face-red + '((t (:foreground "#FF0000" :bold t))) + "Red Hydra heads don't exit the Hydra. +Every other command exits the Hydra." + :group 'hydra) + +(defface hydra-face-blue + '((((class color) (background light)) + :foreground "#0000FF" :bold t) + (((class color) (background dark)) + :foreground "#8ac6f2" :bold t)) + "Blue Hydra heads exit the Hydra. +Every other command exits as well.") + +(defface hydra-face-amaranth + '((t (:foreground "#E52B50" :bold t))) + "Amaranth body has red heads and warns on intercepting non-heads. +Exitable only through a blue head.") + +(defface hydra-face-pink + '((t (:foreground "#FF6EB4" :bold t))) + "Pink body has red heads and runs intercepted non-heads. +Exitable only through a blue head.") + +(defface hydra-face-teal + '((t (:foreground "#367588" :bold t))) + "Teal body has blue heads and warns on intercepting non-heads. +Exitable only through a blue head.") + +;;* Fontification +(defun hydra-add-font-lock () + "Fontify `defhydra' statements." + (font-lock-add-keywords + 'emacs-lisp-mode + '(("(\\(defhydra\\)\\_> +\\(.*?\\)\\_>" + (1 font-lock-keyword-face) + (2 font-lock-type-face)) + ("(\\(defhydradio\\)\\_> +\\(.*?\\)\\_>" + (1 font-lock-keyword-face) + (2 font-lock-type-face))))) + +;;* Find Function +(eval-after-load 'find-func + '(defadvice find-function-search-for-symbol + (around hydra-around-find-function-search-for-symbol-advice + (symbol type library) activate) + "Navigate to hydras with `find-function-search-for-symbol'." + ad-do-it + ;; The orignial function returns (cons (current-buffer) (point)) + ;; if it found the point. + (unless (cdr ad-return-value) + (with-current-buffer (find-file-noselect library) + (let ((sn (symbol-name symbol))) + (when (and (null type) + (string-match "\\`\\(hydra-[a-z-A-Z0-9]+\\)/\\(.*\\)\\'" sn) + (re-search-forward (concat "(defhydra " (match-string 1 sn)) + nil t)) + (goto-char (match-beginning 0))) + (cons (current-buffer) (point))))))) + +;;* Universal Argument +(defvar hydra-base-map + (let ((map (make-sparse-keymap))) + (define-key map [?\C-u] 'hydra--universal-argument) + (define-key map [?-] 'hydra--negative-argument) + (define-key map [?0] 'hydra--digit-argument) + (define-key map [?1] 'hydra--digit-argument) + (define-key map [?2] 'hydra--digit-argument) + (define-key map [?3] 'hydra--digit-argument) + (define-key map [?4] 'hydra--digit-argument) + (define-key map [?5] 'hydra--digit-argument) + (define-key map [?6] 'hydra--digit-argument) + (define-key map [?7] 'hydra--digit-argument) + (define-key map [?8] 'hydra--digit-argument) + (define-key map [?9] 'hydra--digit-argument) + (define-key map [kp-0] 'hydra--digit-argument) + (define-key map [kp-1] 'hydra--digit-argument) + (define-key map [kp-2] 'hydra--digit-argument) + (define-key map [kp-3] 'hydra--digit-argument) + (define-key map [kp-4] 'hydra--digit-argument) + (define-key map [kp-5] 'hydra--digit-argument) + (define-key map [kp-6] 'hydra--digit-argument) + (define-key map [kp-7] 'hydra--digit-argument) + (define-key map [kp-8] 'hydra--digit-argument) + (define-key map [kp-9] 'hydra--digit-argument) + (define-key map [kp-subtract] 'hydra--negative-argument) + map) + "Keymap that all Hydras inherit. See `universal-argument-map'.") + +(defun hydra--universal-argument (arg) + "Forward to (`universal-argument' ARG)." + (interactive "P") + (setq prefix-arg (if (consp arg) + (list (* 4 (car arg))) + (if (eq arg '-) + (list -4) + '(4))))) + +(defun hydra--digit-argument (arg) + "Forward to (`digit-argument' ARG)." + (interactive "P") + (let* ((char (if (integerp last-command-event) + last-command-event + (get last-command-event 'ascii-character))) + (digit (- (logand char ?\177) ?0))) + (setq prefix-arg (cond ((integerp arg) + (+ (* arg 10) + (if (< arg 0) + (- digit) + digit))) + ((eq arg '-) + (if (zerop digit) + '- + (- digit))) + (t + digit))))) + +(defun hydra--negative-argument (arg) + "Forward to (`negative-argument' ARG)." + (interactive "P") + (setq prefix-arg (cond ((integerp arg) (- arg)) + ((eq arg '-) nil) + (t '-)))) + +;;* Repeat +(defvar hydra-repeat--prefix-arg nil + "Prefix arg to use with `hydra-repeat'.") + +(defvar hydra-repeat--command nil + "Command to use with `hydra-repeat'.") + +(defun hydra-repeat (&optional arg) + "Repeat last command with last prefix arg. +When ARG is non-nil, use that instead." + (interactive "p") + (if (eq arg 1) + (unless (string-match "hydra-repeat$" (symbol-name last-command)) + (setq hydra-repeat--command last-command) + (setq hydra-repeat--prefix-arg last-prefix-arg)) + (setq hydra-repeat--prefix-arg arg)) + (setq current-prefix-arg hydra-repeat--prefix-arg) + (funcall hydra-repeat--command)) + +;;* Misc internals +(defun hydra--callablep (x) + "Test if X is callable." + (or (functionp x) + (and (consp x) + (memq (car x) '(function quote))))) + +(defun hydra--make-callable (x) + "Generate a callable symbol from X. +If X is a function symbol or a lambda, return it. Otherwise, it +should be a single statement. Wrap it in an interactive lambda." + (cond ((or (symbolp x) (functionp x)) + x) + ((and (consp x) (eq (car x) 'function)) + (cadr x)) + (t + `(lambda () + (interactive) + ,x)))) + +(defun hydra-plist-get-default (plist prop default) + "Extract a value from a property list. +PLIST is a property list, which is a list of the form +\(PROP1 VALUE1 PROP2 VALUE2...). + +Return the value corresponding to PROP, or DEFAULT if PROP is not +one of the properties on the list." + (if (memq prop plist) + (plist-get plist prop) + default)) + +(defun hydra--head-property (h prop &optional default) + "Return for Hydra head H the value of property PROP. +Return DEFAULT if PROP is not in H." + (hydra-plist-get-default (cl-cdddr h) prop default)) + +(defun hydra--head-set-property (h prop value) + "In hydra Head H, set a property PROP to the value VALUE." + (cons (car h) (plist-put (cdr h) prop value))) + +(defun hydra--head-has-property (h prop) + "Return non nil if heads H has the property PROP." + (plist-member (cdr h) prop)) + +(defun hydra--body-foreign-keys (body) + "Return what BODY does with a non-head binding." + (or + (plist-get (cddr body) :foreign-keys) + (let ((color (plist-get (cddr body) :color))) + (cl-case color + ((amaranth teal) 'warn) + (pink 'run))))) + +(defun hydra--body-exit (body) + "Return the exit behavior of BODY." + (or + (plist-get (cddr body) :exit) + (let ((color (plist-get (cddr body) :color))) + (cl-case color + ((blue teal) t) + (t nil))))) + +(defun hydra--normalize-body (body) + "Put BODY in a normalized format. +Add :exit and :foreign-keys if they are not there. +Remove :color key. And sort the plist alphabetically." + (let ((plist (cddr body))) + (plist-put plist :exit (hydra--body-exit body)) + (plist-put plist :foreign-keys (hydra--body-foreign-keys body)) + (let* ((alist0 (cl-loop for (k v) on plist + by #'cddr collect (cons k v))) + (alist1 (assq-delete-all :color alist0)) + (alist2 (cl-sort alist1 #'string< + :key (lambda (x) (symbol-name (car x)))))) + (append (list (car body) (cadr body)) + (cl-mapcan (lambda (x) (list (car x) (cdr x))) alist2))))) + +(defalias 'hydra--imf #'list) + +(defun hydra-default-pre () + "Default setup that happens in each head before :pre." + (when (eq input-method-function 'key-chord-input-method) + (if (fboundp 'add-function) + (add-function :override input-method-function #'hydra--imf) + (unless hydra--input-method-function + (setq hydra--input-method-function input-method-function) + (setq input-method-function nil))))) + +(defvar hydra-timeout-timer (timer-create) + "Timer for `hydra-timeout'.") + +(defvar hydra-message-timer (timer-create) + "Timer for the hint.") + +(defvar hydra--work-around-dedicated t + "When non-nil, assume there's no bug in `pop-to-buffer'. +`pop-to-buffer' should not select a dedicated window.") + +(defun hydra-keyboard-quit () + "Quitting function similar to `keyboard-quit'." + (interactive) + (hydra-disable) + (cancel-timer hydra-timeout-timer) + (cancel-timer hydra-message-timer) + (setq hydra-curr-map nil) + (unless (and hydra--ignore + (null hydra--work-around-dedicated)) + (funcall + (nth 2 (assoc hydra-hint-display-type hydra-hint-display-alist)))) + nil) + +(defvar hydra-head-format "[%s]: " + "The formatter for each head of a plain docstring.") + +(defvar hydra-key-doc-function 'hydra-key-doc-function-default + "The function for formatting key-doc pairs.") + +(defun hydra-key-doc-function-default (key key-width doc doc-width) + (cond + ((equal key " ") (format (format "%%-%ds" (+ 3 key-width doc-width)) doc)) + ((listp doc) + `(format ,(format "%%%ds: %%%ds" key-width (- -1 doc-width)) ,key ,doc)) + (t (format (format "%%%ds: %%%ds" key-width (- -1 doc-width)) key doc)))) + +(defun hydra--to-string (x) + (if (stringp x) + x + (eval x))) + +(defun hydra--eval-and-format (x) + (let ((str (hydra--to-string (cdr x)))) + (format + (if (> (length str) 0) + (concat hydra-head-format str) + "%s") + (car x)))) + +(defun hydra--hint-heads-wocol (body heads) + "Generate a hint for the echo area. +BODY, and HEADS are parameters to `defhydra'. +Works for heads without a property :column." + (let (alist) + (dolist (h heads) + (let ((val (assoc (cadr h) alist)) + (pstr (hydra-fontify-head h body))) + (if val + (setf (cadr val) + (concat (cadr val) " " pstr)) + (push + (cons (cadr h) + (cons pstr (cl-caddr h))) + alist)))) + (let ((keys (nreverse (mapcar #'cdr alist))) + (n-cols (plist-get (cddr body) :columns)) + res) + (setq res + (if n-cols + (let ((n-rows (1+ (/ (length keys) n-cols))) + (max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) keys))) + (max-doc-len (apply #'max (mapcar (lambda (x) + (length (hydra--to-string (cdr x)))) keys)))) + `(concat + "\n" + (mapconcat #'identity + (mapcar + (lambda (x) + (mapconcat + (lambda (y) + (and y + (funcall hydra-key-doc-function + (car y) + ,max-key-len + (hydra--to-string (cdr y)) + ,max-doc-len))) x "")) + ',(hydra--matrix keys n-cols n-rows)) + "\n"))) + + + `(concat + (mapconcat + #'hydra--eval-and-format + ',keys + ", ") + ,(if keys "." "")))) + (if (cl-every #'stringp + (mapcar 'cddr alist)) + (eval res) + res)))) + +(defun hydra--hint (body heads) + "Generate a hint for the echo area. +BODY, and HEADS are parameters to `defhydra'." + (let* ((sorted-heads (hydra--sort-heads (hydra--normalize-heads heads))) + (heads-w-col (cl-remove-if-not (lambda (heads) (hydra--head-property (nth 0 heads) :column)) sorted-heads)) + (heads-wo-col (cl-remove-if (lambda (heads) (hydra--head-property (nth 0 heads) :column)) sorted-heads)) + (hint-w-col (when heads-w-col + (hydra--hint-from-matrix body (hydra--generate-matrix heads-w-col)))) + (hint-wo-col (when heads-wo-col + (hydra--hint-heads-wocol body (car heads-wo-col))))) + (if (null hint-w-col) + hint-wo-col + (if (stringp hint-wo-col) + `(concat ,@hint-w-col ,hint-wo-col) + `(concat ,@hint-w-col ,@(cdr hint-wo-col)))))) + +(defvar hydra-fontify-head-function nil + "Possible replacement for `hydra-fontify-head-default'.") + +(defun hydra-fontify-head-default (head body) + "Produce a pretty string from HEAD and BODY. +HEAD's binding is returned as a string with a colored face." + (let* ((foreign-keys (hydra--body-foreign-keys body)) + (head-exit (hydra--head-property head :exit)) + (head-color + (if head-exit + (if (eq foreign-keys 'warn) + 'teal + 'blue) + (cl-case foreign-keys + (warn 'amaranth) + (run 'pink) + (t 'red))))) + (when (and (null (cadr head)) + (not head-exit)) + (hydra--complain "nil cmd can only be blue")) + (propertize + (replace-regexp-in-string "%" "%%" (car head)) + 'face + (or (hydra--head-property head :face) + (cl-case head-color + (blue 'hydra-face-blue) + (red 'hydra-face-red) + (amaranth 'hydra-face-amaranth) + (pink 'hydra-face-pink) + (teal 'hydra-face-teal) + (t (error "Unknown color for %S" head))))))) + +(defun hydra-fontify-head-greyscale (head _body) + "Produce a pretty string from HEAD and BODY. +HEAD's binding is returned as a string wrapped with [] or {}." + (format + (if (hydra--head-property head :exit) + "[%s]" + "{%s}") (car head))) + +(defun hydra-fontify-head (head body) + "Produce a pretty string from HEAD and BODY." + (funcall (or hydra-fontify-head-function 'hydra-fontify-head-default) + head body)) + +(defun hydra--strip-align-markers (str) + "Remove ^ from STR, unless they're escaped: \\^." + (let ((start 0)) + (while (setq start (string-match "\\\\?\\^" str start)) + (if (eq (- (match-end 0) (match-beginning 0)) 2) + (progn + (setq str (replace-match "^" nil nil str)) + (cl-incf start)) + (setq str (replace-match "" nil nil str)))) + str)) + +(defvar hydra-docstring-keys-translate-alist + '(("↑" . "") + ("↓" . "") + ("→" . "") + ("←" . "") + ("⌫" . "DEL") + ("⌦" . "") + ("⏎" . "RET"))) + +(defconst hydra-width-spec-regex " ?-?[0-9]*?" + "Regex for the width spec in keys and %` quoted sexps.") + +(defvar hydra-key-regex "\\[\\|]\\|[-\\[:alnum:] ~.,;:/|?<>={}*+#%@!&^↑↓←→⌫⌦⏎'`()\"$]+?" + "Regex for the key quoted in the docstring.") + +(defun hydra--format (_name body docstring heads) + "Generate a `format' statement from STR. +\"%`...\" expressions are extracted into \"%S\". +_NAME, BODY, DOCSTRING and HEADS are parameters of `defhydra'. +The expressions can be auto-expanded according to NAME." + (unless (memq 'elisp--witness--lisp (mapcar #'cadr heads)) + (setq docstring (hydra--strip-align-markers docstring)) + (setq docstring (replace-regexp-in-string "___" "_β_" docstring)) + (let ((rest (if (eq (plist-get (cddr body) :hint) 'none) + "" + (hydra--hint body heads))) + (start 0) + (inner-regex (format "\\(%s\\)\\(%s\\)" hydra-width-spec-regex hydra-key-regex)) + varlist + offset) + (while (setq start + (string-match + (format + "\\(?:%%\\( ?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_%s_\\)\\|\\(?:[?]%s[?]\\)" + inner-regex + inner-regex) + docstring start)) + (cond ((eq ?? (aref (match-string 0 docstring) 0)) + (let* ((key (match-string 6 docstring)) + (head (assoc key heads))) + (if head + (progn + (push (nth 2 head) varlist) + (setq docstring + (replace-match + (or + hydra-doc-format-spec + (concat "%" (match-string 3 docstring) "s")) + t nil docstring))) + (setq start (match-end 0)) + (warn "Unrecognized key: ?%s?" key)))) + ((eq ?_ (aref (match-string 0 docstring) 0)) + (let* ((key (match-string 4 docstring)) + (key (if (equal key "β") "_" key)) + normal-key + (head (or (assoc key heads) + (when (setq normal-key + (cdr (assoc + key hydra-docstring-keys-translate-alist))) + (assoc normal-key heads))))) + (if head + (progn + (push (hydra-fontify-head (if normal-key + (cons key (cdr head)) + head) + body) + varlist) + (let ((replacement + (or + hydra-key-format-spec + (concat "%" (match-string 3 docstring) "s")))) + (setq docstring + (replace-match replacement t nil docstring)) + (setq start (+ start (length replacement))))) + (setq start (match-end 0)) + (warn "Unrecognized key: _%s_" key)))) + + (t + (let* ((varp (if (eq ?` (aref (match-string 2 docstring) 0)) 1 0)) + (spec (match-string 1 docstring)) + (lspec (length spec))) + (setq offset + (with-temp-buffer + (insert (substring docstring (+ 1 start varp + (length spec)))) + (goto-char (point-min)) + (push (read (current-buffer)) varlist) + (- (point) (point-min)))) + (when (or (zerop lspec) + (/= (aref spec (1- (length spec))) ?s)) + (setq spec (concat spec "S"))) + (setq docstring + (concat + (substring docstring 0 start) + "%" spec + (substring docstring (+ start offset 1 lspec varp)))))))) + (hydra--format-1 docstring rest varlist)))) + +(defun hydra--format-1 (docstring rest varlist) + (cond + ((string= docstring "") + rest) + ((listp rest) + (unless (string-match-p "[:\n]" docstring) + (setq docstring (concat docstring ":\n"))) + (unless (or (string-match-p "\n\\'" docstring) + (equal (cadr rest) "\n")) + (setq docstring (concat docstring "\n"))) + `(concat (format ,(replace-regexp-in-string "\\`\n" "" docstring) ,@(nreverse varlist)) + ,@(cdr rest))) + ((eq ?\n (aref docstring 0)) + `(format ,(concat (substring docstring 1) rest) ,@(nreverse varlist))) + (t + (let ((r `(replace-regexp-in-string + " +$" "" + (concat ,docstring + ,(cond ((string-match-p "\\`\n" rest) + ":") + ((string-match-p "\n" rest) + ":\n") + (t + ": ")) + (replace-regexp-in-string + "\\(%\\)" "\\1\\1" ,rest))))) + (if (stringp rest) + `(format ,(eval r)) + `(format ,r)))))) + +(defun hydra--complain (format-string &rest args) + "Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil." + (if hydra-verbose + (apply #'error format-string args) + (apply #'message format-string args))) + +(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 + "The heads for the associated hydra are:\n\n%s\n\n%s%s." + (mapconcat + (lambda (x) + (format "\"%s\": `%S'" (car x) (cadr x))) + heads ",\n") + (format "The body can be accessed via `%S'" body-name) + (if body-key + (format ", which is bound to \"%s\"" body-key) + ""))) + +(defun hydra--call-interactively-remap-maybe (cmd) + "`call-interactively' the given CMD or its remapped equivalent. +Only when `hydra-look-for-remap' is non nil." + (let ((remapped-cmd (if hydra-look-for-remap + (command-remapping `,cmd) + nil))) + (if remapped-cmd + (call-interactively `,remapped-cmd) + (call-interactively `,cmd)))) + +(defun hydra--call-interactively (cmd name) + "Generate a `call-interactively' statement for CMD. +Set `this-command' to NAME." + (if (and (symbolp name) + (not (memq name '(nil body)))) + `(progn + (setq this-command ',name) + (hydra--call-interactively-remap-maybe #',cmd)) + `(hydra--call-interactively-remap-maybe #',cmd))) + +(defun hydra--make-defun (name body doc head + keymap body-pre body-before-exit + &optional body-after-exit) + "Make a defun wrapper, using NAME, BODY, DOC, HEAD, and KEYMAP. +NAME and BODY are the arguments to `defhydra'. +DOC was generated with `hydra--doc'. +HEAD is one of the HEADS passed to `defhydra'. +BODY-PRE is added to the start of the wrapper. +BODY-BEFORE-EXIT will be called before the hydra quits. +BODY-AFTER-EXIT is added to the end of the wrapper." + (let ((cmd-name (hydra--head-name head name)) + (cmd (when (car head) + (hydra--make-callable + (cadr head)))) + (doc (if (car head) + (format "Call the head `%S' in the \"%s\" hydra.\n\n%s" + (cadr head) name doc) + (format "Call the body in the \"%s\" hydra.\n\n%s" + name doc))) + (hint (intern (format "%S/hint" name))) + (body-foreign-keys (hydra--body-foreign-keys body)) + (body-timeout (plist-get body :timeout)) + (body-idle (plist-get body :idle))) + `(defun ,cmd-name () + ,doc + (interactive) + (require 'hydra) + (hydra-default-pre) + ,@(when body-pre (list body-pre)) + ,@(if (hydra--head-property head :exit) + `((hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name))) + ,@(if body-after-exit + `((unwind-protect + ,(when cmd + (hydra--call-interactively cmd (cadr head))) + ,body-after-exit)) + (when cmd + `(,(hydra--call-interactively cmd (cadr head)))))) + (delq + nil + `((let ((hydra--ignore ,(not (eq (cadr head) 'body)))) + (hydra-keyboard-quit) + (setq hydra-curr-body-fn ',(intern (format "%S/body" name)))) + ,(when cmd + `(condition-case err + ,(hydra--call-interactively cmd (cadr head)) + ((quit error) + (message (error-message-string err))))) + ,(if (and body-idle (eq (cadr head) 'body)) + `(hydra-idle-message ,body-idle ,hint ',name) + `(hydra-show-hint ,hint ',name)) + (hydra-set-transient-map + ,keymap + (lambda () (hydra-keyboard-quit) ,body-before-exit) + ,(when body-foreign-keys + (list 'quote body-foreign-keys))) + ,body-after-exit + ,(when body-timeout + `(hydra-timeout ,body-timeout)))))))) + +(defvar hydra-props-alist nil) + +(defun hydra-set-property (name key val) + "Set hydra property. +NAME is the symbolic name of the hydra. +KEY and VAL are forwarded to `plist-put'." + (let ((entry (assoc name hydra-props-alist)) + plist) + (when (null entry) + (add-to-list 'hydra-props-alist (list name)) + (setq entry (assoc name hydra-props-alist))) + (setq plist (cdr entry)) + (setcdr entry (plist-put plist key val)))) + +(defun hydra-get-property (name key) + "Get hydra property. +NAME is the symbolic name of the hydra. +KEY is forwarded to `plist-get'." + (let ((entry (assoc name hydra-props-alist))) + (when entry + (plist-get (cdr entry) key)))) + +(defun hydra-show-hint (hint caller) + (let ((verbosity (plist-get (cdr (assoc caller hydra-props-alist)) + :verbosity))) + (cond ((eq verbosity 0)) + ((eq verbosity 1) + (message (eval hint))) + (t + (when hydra-is-helpful + (funcall + (nth 1 (assoc hydra-hint-display-type hydra-hint-display-alist)) + (eval hint))))))) + +(defmacro hydra--make-funcall (sym) + "Transform SYM into a `funcall' to call it." + `(when (and ,sym (symbolp ,sym)) + (setq ,sym `(funcall #',,sym)))) + +(defun hydra--head-name (h name) + "Return the symbol for head H of hydra with NAME." + (let ((str (format "%S/%s" name + (cond ((symbolp (cadr h)) + (cadr h)) + ((and (consp (cadr h)) + (eq (cl-caadr h) 'function)) + (cadr (cadr h))) + (t + (concat "lambda-" (car h))))))) + (when (and (hydra--head-property h :exit) + (not (memq (cadr h) '(body nil)))) + (setq str (concat str "-and-exit"))) + (intern str))) + +(defun hydra--delete-duplicates (heads) + "Return HEADS without entries that have the same CMD part. +In duplicate HEADS, :cmd-name is modified to whatever they duplicate." + (let ((ali '(((hydra-repeat . nil) . hydra-repeat))) + res entry) + (dolist (h heads) + (if (setq entry (assoc (cons (cadr h) + (hydra--head-property h :exit)) + ali)) + (setf (cl-cdddr h) (plist-put (cl-cdddr h) :cmd-name (cdr entry))) + (push (cons (cons (cadr h) + (hydra--head-property h :exit)) + (plist-get (cl-cdddr h) :cmd-name)) + ali) + (push h res))) + (nreverse res))) + +(defun hydra--pad (lst n) + "Pad LST with nil until length N." + (let ((len (length lst))) + (if (= len n) + lst + (append lst (make-list (- n len) nil))))) + +(defmacro hydra-multipop (lst n) + "Return LST's first N elements while removing them." + `(if (<= (length ,lst) ,n) + (prog1 ,lst + (setq ,lst nil)) + (prog1 ,lst + (setcdr + (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst)))) + nil)))) + +(defun hydra--matrix (lst rows cols) + "Create a matrix from elements of LST. +The matrix size is ROWS times COLS." + (let ((ls (copy-sequence lst)) + res) + (dotimes (_c cols) + (push (hydra--pad (hydra-multipop ls rows) rows) res)) + (nreverse res))) + +(defun hydra--cell (fstr names) + "Format a rectangular cell based on FSTR and NAMES. +FSTR is a format-style string with two string inputs: one for the +doc and one for the symbol name. +NAMES is a list of variables." + (let ((len (cl-reduce + (lambda (acc it) (max (length (symbol-name it)) acc)) + names + :initial-value 0))) + (mapconcat + (lambda (sym) + (if sym + (format fstr + (documentation-property sym 'variable-documentation) + (let ((name (symbol-name sym))) + (concat name (make-string (- len (length name)) ?^))) + sym) + "")) + names + "\n"))) + +(defun hydra--vconcat (strs &optional joiner) + "Glue STRS vertically. They must be the same height. +JOINER is a function similar to `concat'." + (setq joiner (or joiner #'concat)) + (mapconcat + (lambda (s) + (if (string-match " +$" s) + (replace-match "" nil nil s) + s)) + (apply #'cl-mapcar joiner + (mapcar + (lambda (s) (split-string s "\n")) + strs)) + "\n")) + +(defvar hydra-cell-format "% -20s %% -8`%s" + "The default format for docstring cells.") + +(defun hydra--table (names rows cols &optional cell-formats) + "Format a `format'-style table from variables in NAMES. +The size of the table is ROWS times COLS. +CELL-FORMATS are `format' strings for each column. +If CELL-FORMATS is a string, it's used for all columns. +If CELL-FORMATS is nil, `hydra-cell-format' is used for all columns." + (setq cell-formats + (cond ((null cell-formats) + (make-list cols hydra-cell-format)) + ((stringp cell-formats) + (make-list cols cell-formats)) + (t + cell-formats))) + (hydra--vconcat + (cl-mapcar + #'hydra--cell + cell-formats + (hydra--matrix names rows cols)) + (lambda (&rest x) + (mapconcat #'identity x " ")))) + +(defun hydra-reset-radios (names) + "Set varibles NAMES to their defaults. +NAMES should be defined by `defhydradio' or similar." + (dolist (n names) + (set n (aref (get n 'range) 0)))) + +;; Following functions deal with automatic docstring table generation from :column head property +(defun hydra--normalize-heads (heads) + "Ensure each head from HEADS have a property :column. +Set it to the same value as preceding head or nil if no previous value +was defined." + (let ((current-col nil)) + (mapcar (lambda (head) + (if (hydra--head-has-property head :column) + (setq current-col (hydra--head-property head :column))) + (hydra--head-set-property head :column current-col)) + heads))) + +(defun hydra--sort-heads (normalized-heads) + "Return a list of heads with non-nil doc grouped by column property. +Each head of NORMALIZED-HEADS must have a column property." + (let* ((heads-wo-nil-doc (cl-remove-if-not (lambda (head) (nth 2 head)) normalized-heads)) + (columns-list (delete-dups (mapcar (lambda (head) (hydra--head-property head :column)) + normalized-heads))) + (get-col-index-fun (lambda (head) (cl-position (hydra--head-property head :column) + columns-list + :test 'equal))) + (heads-sorted (cl-sort heads-wo-nil-doc (lambda (it other) + (< (funcall get-col-index-fun it) + (funcall get-col-index-fun other)))))) + ;; this operation partition the sorted head list into lists of heads with same column property + (cl-loop for head in heads-sorted + for column-name = (hydra--head-property head :column) + with prev-column-name = (hydra--head-property (nth 0 heads-sorted) :column) + unless (equal prev-column-name column-name) collect heads-one-column into heads-all-columns + and do (setq heads-one-column nil) + collect head into heads-one-column + do (setq prev-column-name column-name) + finally return (append heads-all-columns (list heads-one-column))))) + +(defun hydra--pad-heads (heads-groups padding-head) + "Return a copy of HEADS-GROUPS padded where applicable with PADDING-HEAD." + (cl-loop for heads-group in heads-groups + for this-head-group-length = (length heads-group) + with head-group-max-length = (apply #'max (mapcar (lambda (heads) (length heads)) heads-groups)) + if (<= this-head-group-length head-group-max-length) + collect (append heads-group (make-list (- head-group-max-length this-head-group-length) padding-head)) + into balanced-heads-groups + else collect heads-group into balanced-heads-groups + finally return balanced-heads-groups)) + +(defun hydra--generate-matrix (heads-groups) + "Return a copy of HEADS-GROUPS decorated with table formating information. +Details of modification: +2 virtual heads acting as table header were added to each heads-group. +Each head is decorated with 2 new properties max-doc-len and max-key-len +representing the maximum dimension of their owning group. + Every heads-group have equal length by adding padding heads where applicable." + (when heads-groups + (let ((res nil)) + (dolist (heads-group (hydra--pad-heads heads-groups '(" " nil " " :exit t))) + (let* ((column-name (hydra--head-property (nth 0 heads-group) :column)) + (max-key-len (apply #'max (mapcar (lambda (x) (length (car x))) heads-group))) + (max-doc-len (apply #'max + (length column-name) + (mapcar (lambda (x) (length (hydra--to-string (nth 2 x)))) heads-group))) + (header-virtual-head `(" " nil ,column-name :column ,column-name :exit t)) + (separator-virtual-head `(" " nil ,(make-string (+ 2 max-doc-len max-key-len) ?-) :column ,column-name :exit t)) + (decorated-heads (copy-tree (apply 'list header-virtual-head separator-virtual-head heads-group)))) + (push (mapcar (lambda (it) + (hydra--head-set-property it :max-key-len max-key-len) + (hydra--head-set-property it :max-doc-len max-doc-len)) + decorated-heads) res))) + (nreverse res)))) + +(defun hydra-interpose (x lst) + "Insert X in between each element of LST." + (let (res y) + (while (setq y (pop lst)) + (push y res) + (push x res)) + (nreverse (cdr res)))) + +(defun hydra--hint-row (heads body) + (let ((lst (hydra-interpose + "| " + (mapcar (lambda (head) + (funcall hydra-key-doc-function + (hydra-fontify-head head body) + (let ((n (hydra--head-property head :max-key-len))) + (+ n (cl-count ?% (car head)))) + (nth 2 head) ;; doc + (hydra--head-property head :max-doc-len))) + heads)))) + (when (stringp (car (last lst))) + (let ((len (length lst)) + (new-last (replace-regexp-in-string "\s+$" "" (car (last lst))))) + (when (= 0 (length (setf (nth (- len 1) lst) new-last))) + (setf (nth (- len 2) lst) "|")))) + lst)) + + +(defun hydra--hint-from-matrix (body heads-matrix) + "Generate a formated table-style docstring according to BODY and HEADS-MATRIX. +HEADS-MATRIX is expected to be a list of heads with following features: +Each heads must have the same length +Each head must have a property max-key-len and max-doc-len." + (when heads-matrix + (let ((lines (hydra--hint-from-matrix-1 body heads-matrix))) + `(,@(apply #'append (hydra-interpose '("\n") lines)) + "\n")))) + +(defun hydra--hint-from-matrix-1 (body heads-matrix) + (let* ((first-heads-col (nth 0 heads-matrix)) + (last-row-index (- (length first-heads-col) 1)) + (lines nil)) + (dolist (row-index (number-sequence 0 last-row-index)) + (let ((heads-in-row (mapcar + (lambda (heads) (nth row-index heads)) + heads-matrix))) + (push (hydra--hint-row heads-in-row body) + lines))) + (nreverse lines))) + +(defun hydra-idle-message (secs hint name) + "In SECS seconds display HINT." + (cancel-timer hydra-message-timer) + (setq hydra-message-timer (timer-create)) + (timer-set-time hydra-message-timer + (timer-relative-time (current-time) secs)) + (timer-set-function + hydra-message-timer + (lambda () + (hydra-show-hint hint name) + (cancel-timer hydra-message-timer))) + (timer-activate hydra-message-timer)) + +(defun hydra-timeout (secs &optional function) + "In SECS seconds call FUNCTION, then function `hydra-keyboard-quit'. +Cancel the previous `hydra-timeout'." + (cancel-timer hydra-timeout-timer) + (setq hydra-timeout-timer (timer-create)) + (timer-set-time hydra-timeout-timer + (timer-relative-time (current-time) secs)) + (timer-set-function + hydra-timeout-timer + `(lambda () + ,(when function + `(funcall ,function)) + (hydra-keyboard-quit))) + (timer-activate hydra-timeout-timer)) + +;;* Macros +;;;###autoload +(defmacro defhydra (name body &optional docstring &rest heads) + "Create a Hydra - a family of functions with prefix NAME. + +NAME should be a symbol, it will be the prefix of all functions +defined here. + +BODY has the format: + + (BODY-MAP BODY-KEY &rest BODY-PLIST) + +DOCSTRING will be displayed in the echo area to identify the +Hydra. When DOCSTRING starts with a newline, special Ruby-style +substitution will be performed by `hydra--format'. + +Functions are created on basis of HEADS, each of which has the +format: + + (KEY CMD &optional HINT &rest PLIST) + +BODY-MAP is a keymap; `global-map' is used quite often. Each +function generated from HEADS will be bound in BODY-MAP to +BODY-KEY + KEY (both are strings passed to `kbd'), and will set +the transient map so that all following heads can be called +though KEY only. BODY-KEY can be an empty string. + +CMD is a callable expression: either an interactive function +name, or an interactive lambda, or a single sexp (it will be +wrapped in an interactive lambda). + +HINT is a short string that identifies its head. It will be +printed beside KEY in the echo erea if `hydra-is-helpful' is not +nil. If you don't even want the KEY to be printed, set HINT +explicitly to nil. + +The heads inherit their PLIST from BODY-PLIST and are allowed to +override some keys. The keys recognized are :exit, :bind, and :column. +:exit can be: + +- nil (default): this head will continue the Hydra state. +- t: this head will stop the Hydra state. + +:bind can be: +- nil: this head will not be bound in BODY-MAP. +- a lambda taking KEY and CMD used to bind a head. + +:column is a string that sets the column for all subsequent heads. + +It is possible to omit both BODY-MAP and BODY-KEY if you don't +want to bind anything. In that case, typically you will bind the +generated NAME/body command. This command is also the return +result of `defhydra'." + (declare (indent defun) (doc-string 3)) + (setq heads (copy-tree heads)) + (cond ((stringp docstring)) + ((and (consp docstring) + (memq (car docstring) '(hydra--table concat format))) + (setq docstring (concat "\n" (eval docstring)))) + (t + (setq heads (cons docstring heads)) + (setq docstring ""))) + (when (keywordp (car body)) + (setq body (cons nil (cons nil body)))) + (setq body (hydra--normalize-body body)) + (condition-case-unless-debug err + (let* ((keymap-name (intern (format "%S/keymap" name))) + (body-name (intern (format "%S/body" name))) + (body-key (cadr body)) + (body-plist (cddr body)) + (base-map (or (eval (plist-get body-plist :base-map)) + hydra-base-map)) + (keymap (copy-keymap base-map)) + (body-map (or (car body) + (plist-get body-plist :bind))) + (body-pre (plist-get body-plist :pre)) + (body-body-pre (plist-get body-plist :body-pre)) + (body-before-exit (or (plist-get body-plist :post) + (plist-get body-plist :before-exit))) + (body-after-exit (plist-get body-plist :after-exit)) + (body-inherit (plist-get body-plist :inherit)) + (body-foreign-keys (hydra--body-foreign-keys body)) + (body-exit (hydra--body-exit body))) + (dolist (base body-inherit) + (setq heads (append heads (copy-sequence (eval base))))) + (dolist (h heads) + (let ((len (length h))) + (cond ((< len 2) + (error "Each head should have at least two items: %S" h)) + ((= len 2) + (setcdr (cdr h) + (list + (hydra-plist-get-default + body-plist :hint hydra-default-hint))) + (setcdr (nthcdr 2 h) (list :exit body-exit))) + (t + (let ((hint (cl-caddr h))) + (unless (or (null hint) + (stringp hint) + (consp hint)) + (let ((inherited-hint + (hydra-plist-get-default + body-plist :hint hydra-default-hint))) + (setcdr (cdr h) (cons + (if (eq 'none inherited-hint) + nil + inherited-hint) + (cddr h)))))) + (let ((hint-and-plist (cddr h))) + (if (null (cdr hint-and-plist)) + (setcdr hint-and-plist (list :exit body-exit)) + (let* ((plist (cl-cdddr h)) + (h-color (plist-get plist :color))) + (if h-color + (progn + (plist-put plist :exit + (cl-case h-color + ((blue teal) t) + (t nil))) + (cl-remf (cl-cdddr h) :color)) + (let ((h-exit (hydra-plist-get-default plist :exit 'default))) + (plist-put plist :exit + (if (eq h-exit 'default) + body-exit + h-exit)))))))))) + (plist-put (cl-cdddr h) :cmd-name (hydra--head-name h name)) + (when (null (cadr h)) (plist-put (cl-cdddr h) :exit t))) + (let ((doc (hydra--doc body-key body-name heads)) + (heads-nodup (hydra--delete-duplicates heads))) + (mapc + (lambda (x) + (define-key keymap (kbd (car x)) + (plist-get (cl-cdddr x) :cmd-name))) + heads) + (hydra--make-funcall body-pre) + (hydra--make-funcall body-body-pre) + (hydra--make-funcall body-before-exit) + (hydra--make-funcall body-after-exit) + (when (memq body-foreign-keys '(run warn)) + (unless (cl-some + (lambda (h) + (hydra--head-property h :exit)) + heads) + (error + "An %S Hydra must have at least one blue head in order to exit" + body-foreign-keys))) + `(progn + (set (defvar ,(intern (format "%S/params" name)) + nil + ,(format "Params of %S." name)) + ',body) + (set (defvar ,(intern (format "%S/docstring" name)) + nil + ,(format "Docstring of %S." name)) + ,docstring) + (set (defvar ,(intern (format "%S/heads" name)) + nil + ,(format "Heads for %S." name)) + ',(mapcar (lambda (h) + (let ((j (copy-sequence h))) + (cl-remf (cl-cdddr j) :cmd-name) + j)) + heads)) + ;; create keymap + (set (defvar ,keymap-name + nil + ,(format "Keymap for %S." name)) + ',keymap) + ;; declare heads + (set + (defvar ,(intern (format "%S/hint" name)) nil + ,(format "Dynamic hint for %S." name)) + ',(hydra--format name body docstring heads)) + ;; create defuns + ,@(mapcar + (lambda (head) + (hydra--make-defun name body doc head keymap-name + body-pre + body-before-exit + body-after-exit)) + heads-nodup) + ;; free up keymap prefix + ,@(unless (or (null body-key) + (null body-map) + (hydra--callablep body-map)) + `((unless (keymapp (lookup-key ,body-map (kbd ,body-key))) + (define-key ,body-map (kbd ,body-key) nil)))) + ;; bind keys + ,@(delq nil + (mapcar + (lambda (head) + (let ((name (hydra--head-property head :cmd-name))) + (when (and (cadr head) + (or body-key body-map)) + (let ((bind (hydra--head-property head :bind body-map)) + (final-key + (if body-key + (vconcat (kbd body-key) (kbd (car head))) + (kbd (car head))))) + (cond ((null bind) nil) + ((hydra--callablep bind) + `(funcall ,bind ,final-key (function ,name))) + ((and (symbolp bind) + (if (boundp bind) + (keymapp (symbol-value bind)) + t)) + `(define-key ,bind ,final-key (quote ,name))) + (t + (error "Invalid :bind property `%S' for head %S" bind head))))))) + heads)) + ,(hydra--make-defun + name body doc '(nil body) + keymap-name + (or body-body-pre body-pre) body-before-exit + '(setq prefix-arg current-prefix-arg))))) + (error + (hydra--complain "Error in defhydra %S: %s" name (cdr err)) + nil))) + +(defmacro defhydra+ (name body &optional docstring &rest heads) + "Redefine an existing hydra by adding new heads. +Arguments are same as of `defhydra'." + (declare (indent defun) (doc-string 3)) + (unless (stringp docstring) + (setq heads + (cons docstring heads)) + (setq docstring nil)) + `(defhydra ,name ,(or body (hydra--prop name "/params")) + ,(or docstring (hydra--prop name "/docstring")) + ,@(cl-delete-duplicates + (append (hydra--prop name "/heads") heads) + :key #'car + :test #'equal))) + +(defun hydra--prop (name prop-name) + (symbol-value (intern (concat (symbol-name name) prop-name)))) + +(defmacro defhydradio (name _body &rest heads) + "Create radios 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)) + `(progn + ,@(apply #'append + (mapcar (lambda (h) + (hydra--radio name h)) + heads)) + (defvar ,(intern (format "%S/names" name)) + ',(mapcar (lambda (h) (intern (format "%S/%S" name (car h)))) + heads)))) + +(defun hydra--radio (parent head) + "Generate a hydradio with PARENT from HEAD." + (let* ((name (car head)) + (full-name (intern (format "%S/%S" parent name))) + (doc (cadr head)) + (val (or (cl-caddr head) [nil t]))) + `((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." + (cond ((null x) + nil) + ((symbolp x) + (list 'quote x)) + (t + 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)) + (cl-incf i))) + (error "Val not in range for %S" sym))) + (set sym + (aref range + (if (>= i l) + 0 + i))))) + +(defvar hydra-pause-ring (make-ring 10) + "Ring for paused hydras.") + +(defun hydra-pause-resume () + "Quit the current hydra and save it to the stack. +If there's no active hydra, pop one from the stack and call its body. +If the stack is empty, call the last hydra's body." + (interactive) + (cond (hydra-curr-map + (ring-insert hydra-pause-ring hydra-curr-body-fn) + (hydra-keyboard-quit)) + ((zerop (ring-length hydra-pause-ring)) + (funcall hydra-curr-body-fn)) + (t + (funcall (ring-remove hydra-pause-ring 0))))) + +;; Local Variables: +;; outline-regexp: ";;\\([;*]+ [^\s\t\n]\\|###autoload\\)\\|(" +;; indent-tabs-mode: nil +;; End: + +(provide 'hydra) + +;;; hydra.el ends here diff --git a/lv.el b/lv.el new file mode 100644 index 0000000..7043abb --- /dev/null +++ b/lv.el @@ -0,0 +1,120 @@ +;;; lv.el --- Other echo area + +;; 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 . + +;;; Commentary: +;; +;; This package provides `lv-message' intended to be used in place of +;; `message' when semi-permanent hints are needed, in order to not +;; interfere with Echo Area. +;; +;; "Я тихо-тихо пiдглядаю, +;; І тiшуся собi, як бачу то, +;; Шо страшить i не пiдпускає, +;; А iншi п’ють тебе, як воду пiсок." +;; -- Андрій Кузьменко, L.V. + +;;; Code: + +(defgroup lv nil + "The other echo area." + :group 'minibuffer + :group 'hydra) + +(defcustom lv-use-separator nil + "Whether to draw a line between the LV window and the Echo Area." + :group 'lv + :type 'boolean) + +(defface lv-separator + '((((class color) (background light)) :background "grey80") + (((class color) (background dark)) :background "grey30")) + "Face used to draw line between the lv window and the echo area. +This is only used if option `lv-use-separator' is non-nil. +Only the background color is significant." + :group 'lv) + +(defvar lv-wnd nil + "Holds the current LV window.") + +(defvar display-line-numbers) + +(defun lv-window () + "Ensure that LV window is live and return it." + (if (window-live-p lv-wnd) + lv-wnd + (let ((ori (selected-window)) + buf) + (prog1 (setq lv-wnd + (select-window + (let ((ignore-window-parameters t)) + (split-window + (frame-root-window) -1 'below)))) + (if (setq buf (get-buffer " *LV*")) + (switch-to-buffer buf) + (switch-to-buffer " *LV*") + (set-window-hscroll lv-wnd 0) + (setq window-size-fixed t) + (setq mode-line-format nil) + (setq cursor-type nil) + (setq display-line-numbers nil) + (set-window-dedicated-p lv-wnd t) + (set-window-parameter lv-wnd 'no-other-window t)) + (select-window ori))))) + +(defvar golden-ratio-mode) + +(defvar lv-force-update nil + "When non-nil, `lv-message' will refresh even for the same string.") + +(defun lv-message (format-string &rest args) + "Set LV window contents to (`format' FORMAT-STRING ARGS)." + (let* ((str (apply #'format format-string args)) + (n-lines (cl-count ?\n str)) + deactivate-mark + golden-ratio-mode) + (with-selected-window (lv-window) + (unless (and (string= (buffer-string) str) + (null lv-force-update)) + (delete-region (point-min) (point-max)) + (insert str) + (when (and (window-system) lv-use-separator) + (unless (looking-back "\n" nil) + (insert "\n")) + (insert + (propertize "__" 'face 'lv-separator 'display '(space :height (1))) + (propertize "\n" 'face 'lv-separator 'line-height t))) + (set (make-local-variable 'window-min-height) n-lines) + (setq truncate-lines (> n-lines 1)) + (let ((window-resize-pixelwise t) + (window-size-fixed nil)) + (fit-window-to-buffer nil nil 1))) + (goto-char (point-min))))) + +(defun lv-delete-window () + "Delete LV window and kill its buffer." + (when (window-live-p lv-wnd) + (let ((buf (window-buffer lv-wnd))) + (delete-window lv-wnd) + (kill-buffer buf)))) + +(provide 'lv) + +;;; lv.el ends here diff --git a/targets/hydra-init.el b/targets/hydra-init.el new file mode 100644 index 0000000..881ceb6 --- /dev/null +++ b/targets/hydra-init.el @@ -0,0 +1,27 @@ +;;; hydra-test.el --- bare hydra init + +;; 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 . + +(add-to-list 'load-path default-directory) +(require 'hydra) +(setq hydra-examples-verbatim t) +(require 'hydra-examples) +(require 'hydra-test) +(mapc #'byte-compile-file '("hydra.el" "hydra-examples.el" "hydra-ox.el" "hydra-test.el" "lv.el")) -- cgit v1.2.3 From c73c74cc09290de6c44e1a8499ff1c611dab2307 Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 10 Jul 2019 12:59:25 -0300 Subject: Remove badge icon and screenshots from README file This patch removes badges icon and screenshots from README files. This icon is intended rather for developers, badge and screenshots are loaded from several external web sites and not included in the original source. Gbp-Pq: Name 0001-clean-documentation.diff --- README.md | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/README.md b/README.md index 35aedca..fb3a67b 100644 --- a/README.md +++ b/README.md @@ -1,14 +1,8 @@ # Hydra -[![Build Status](https://travis-ci.org/abo-abo/hydra.svg?branch=master)](https://travis-ci.org/abo-abo/hydra) -[![MELPA](https://melpa.org/packages/hydra-badge.svg)](https://melpa.org/#/hydra) -[![MELPA Stable](https://stable.melpa.org/packages/hydra-badge.svg)](https://stable.melpa.org/#/hydra) - 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.jpg) - ## Description for Poets Once you summon the Hydra through the prefixed binding (the body + any one head), all heads can be @@ -89,10 +83,6 @@ For any Hydra: ## The impressive-looking one -Here's the result of pressing . in the good-old Buffer menu: - -![hydra-buffer-menu](http://oremacs.com/download/hydra-buffer-menu.png) - The code is large but very simple: ```cl -- cgit v1.2.3 From 2f3dba131c4ab6fd5f332c123ea686b0bad0e9e1 Mon Sep 17 00:00:00 2001 From: Lev Lamberov Date: Wed, 10 Jul 2019 12:59:25 -0300 Subject: Add version number to lv.el This patch adds Package-Version declaration to lv.el as it is done in the stable MELPA repository. Gbp-Pq: Name 0002-lv-version.diff --- lv.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lv.el b/lv.el index 7043abb..c0dcd3d 100644 --- a/lv.el +++ b/lv.el @@ -1,4 +1,5 @@ ;;; lv.el --- Other echo area +;; Package-Version: 0.15.0 ;; Copyright (C) 2015 Free Software Foundation, Inc. -- cgit v1.2.3