[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master bfeccce 22/22: Merge commit '4bf7f1c9e46fb819c673e55d8a189
|
From: |
Oleh Krehel |
|
Subject: |
[elpa] master bfeccce 22/22: Merge commit '4bf7f1c9e46fb819c673e55d8a1891774e139f98' from hydra |
|
Date: |
Fri, 16 Oct 2015 10:07:01 +0000 |
branch: master
commit bfecccebb4715c66c6f440151c0fc4f361da00a8
Merge: 2eb4c54 4bf7f1c
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
Merge commit '4bf7f1c9e46fb819c673e55d8a1891774e139f98' from hydra
---
packages/hydra/Makefile | 4 +-
packages/hydra/hydra-examples.el | 1 +
packages/hydra/hydra-test.el | 236 ++++++++++++++++++-----
packages/hydra/hydra.el | 298 +++++++++++++++++++---------
packages/hydra/lv.el | 5 +-
packages/hydra/{ => targets}/hydra-init.el | 0
6 files changed, 399 insertions(+), 145 deletions(-)
diff --git a/packages/hydra/Makefile b/packages/hydra/Makefile
index dd3a762..13fd618 100644
--- a/packages/hydra/Makefile
+++ b/packages/hydra/Makefile
@@ -12,11 +12,11 @@ test:
$(emacs) -batch $(LOAD) -f ert-run-tests-batch-and-exit
run:
- $(emacs) -q $(LOAD) -l hydra-init.el
+ $(emacs) -q $(LOAD) -l targets/hydra-init.el
make clean
compile:
- $(emacs) -batch $(LOAD) -l hydra-init.el
+ $(emacs) -batch $(LOAD) -l targets/hydra-init.el
clean:
rm -f *.elc
diff --git a/packages/hydra/hydra-examples.el b/packages/hydra/hydra-examples.el
index c202997..1468f3f 100644
--- a/packages/hydra/hydra-examples.el
+++ b/packages/hydra/hydra-examples.el
@@ -225,6 +225,7 @@ _~_: modified ^ ^ ^ ^ ^^
;;** 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 "")
diff --git a/packages/hydra/hydra-test.el b/packages/hydra/hydra-test.el
index ab41e82..0750b1c 100644
--- a/packages/hydra/hydra-test.el
+++ b/packages/hydra/hydra-test.el
@@ -116,16 +116,18 @@ Call the head: `first-error'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore t))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
(condition-case err
- (progn
- (setq this-command
- (quote first-error))
- (call-interactively
- (function first-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))))
+ (progn
+ (setq this-command
+ (quote first-error))
+ (call-interactively
+ (function first-error)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -152,16 +154,18 @@ Call the head: `next-error'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore t))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
(condition-case err
- (progn
- (setq this-command
- (quote next-error))
- (call-interactively
- (function next-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))))
+ (progn
+ (setq this-command
+ (quote next-error))
+ (call-interactively
+ (function next-error)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -188,16 +192,18 @@ Call the head: `previous-error'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore t))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
(condition-case err
- (progn
- (setq this-command
- (quote previous-error))
- (call-interactively
- (function previous-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))))
+ (progn
+ (setq this-command
+ (quote previous-error))
+ (call-interactively
+ (function previous-error)))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -217,14 +223,12 @@ Call the head: `previous-error'."
(define-key global-map (kbd "M-g")
nil))
(define-key global-map [134217831 104]
- (function
- hydra-error/first-error))
+ (quote hydra-error/first-error))
(define-key global-map [134217831 106]
- (function
- hydra-error/next-error))
+ (quote hydra-error/next-error))
(define-key global-map [134217831 107]
- (function
- hydra-error/previous-error))
+ (quote
+ hydra-error/previous-error))
(defun hydra-error/body nil
"Create a hydra with a \"M-g\" body and the heads:
@@ -237,7 +241,9 @@ The body can be accessed via `hydra-error/body'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore nil))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-error/body)))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -337,6 +343,8 @@ 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))
@@ -357,6 +365,8 @@ 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))
@@ -376,6 +386,8 @@ 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))
@@ -394,7 +406,9 @@ The body can be accessed via `hydra-toggle/body'.
Call the head: `nil'."
(interactive)
(hydra-default-pre)
- (hydra-keyboard-quit))
+ (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:
@@ -407,7 +421,9 @@ The body can be accessed via `hydra-toggle/body'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore nil))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-toggle/body)))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -502,7 +518,9 @@ Call the head: `next-line'."
(hydra-default-pre)
(set-cursor-color "#e52b50")
(let ((hydra--ignore t))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-vi/body)))
(condition-case err
(progn
(setq this-command
@@ -537,7 +555,9 @@ Call the head: `previous-line'."
(hydra-default-pre)
(set-cursor-color "#e52b50")
(let ((hydra--ignore t))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-vi/body)))
(condition-case err
(progn
(setq this-command
@@ -571,7 +591,9 @@ Call the head: `nil'."
(interactive)
(hydra-default-pre)
(set-cursor-color "#e52b50")
- (hydra-keyboard-quit))
+ (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:
@@ -584,7 +606,9 @@ The body can be accessed via `hydra-vi/body'."
(hydra-default-pre)
(set-cursor-color "#e52b50")
(let ((hydra--ignore nil))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-vi/body)))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -677,7 +701,9 @@ Call the head: `(text-scale-set 0)'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore t))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
(condition-case err
(call-interactively
(function
@@ -712,6 +738,8 @@ Call the head: `(text-scale-set 0)'."
(interactive)
(hydra-default-pre)
(hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body))
(call-interactively
(function
(lambda nil
@@ -728,7 +756,9 @@ The body can be accessed via `hydra-zoom/body'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore nil))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -822,7 +852,9 @@ Call the head: `(text-scale-set 0)'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore t))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
(condition-case err
(call-interactively
(function
@@ -857,6 +889,8 @@ Call the head: `(text-scale-set 0)'."
(interactive)
(hydra-default-pre)
(hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body))
(call-interactively
(function
(lambda nil
@@ -873,7 +907,9 @@ The body can be accessed via `hydra-zoom/body'."
(interactive)
(hydra-default-pre)
(let ((hydra--ignore nil))
- (hydra-keyboard-quit))
+ (hydra-keyboard-quit)
+ (setq hydra-curr-body-fn
+ (quote hydra-zoom/body)))
(when hydra-is-helpful
(if hydra-lv
(lv-message
@@ -1010,7 +1046,7 @@ _f_ auto-fill-mode: %`auto-fill-function
'(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"))))
+" "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[{q}]:
quit."))))
(ert-deftest hydra-format-2 ()
(should (equal
@@ -1022,7 +1058,7 @@ _f_ auto-fill-mode: %`auto-fill-function
"\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]"))))
+ '(concat (format " bar %s\n" foo) "{a}, [q]."))))
(ert-deftest hydra-format-3 ()
(should (equal
@@ -1059,6 +1095,47 @@ _f_ auto-fill-mode: %`auto-fill-function
#("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-with-sexp-1 ()
(should (equal
(let ((hydra-fontify-head-function
@@ -1072,7 +1149,7 @@ _f_ auto-fill-mode: %`auto-fill-function
(progn
(message "checking")
(buffer-narrowed-p)))
- "[[q]]: cancel"))))
+ "[[q]]: cancel."))))
(ert-deftest hydra-format-with-sexp-2 ()
(should (equal
@@ -1087,7 +1164,7 @@ _f_ auto-fill-mode: %`auto-fill-function
(progn
(message "checking")
(buffer-narrowed-p)))
- "[[q]]: cancel"))))
+ "[[q]]: cancel."))))
(ert-deftest hydra-compat-colors-2 ()
(should
@@ -1273,6 +1350,69 @@ _w_ Worf: % -8`hydra-tng/worf^^
_h_ Set phasers to
(kbd "C-c g 1 RET q")))
"|foo\nbar")))
+(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)))))
+
(provide 'hydra-test)
;;; hydra-test.el ends here
diff --git a/packages/hydra/hydra.el b/packages/hydra/hydra.el
index f50cbf8..37a0871 100644
--- a/packages/hydra/hydra.el
+++ b/packages/hydra/hydra.el
@@ -5,7 +5,7 @@
;; Author: Oleh Krehel <address@hidden>
;; Maintainer: Oleh Krehel <address@hidden>
;; URL: https://github.com/abo-abo/hydra
-;; Version: 0.13.2
+;; Version: 0.13.3
;; Keywords: bindings
;; Package-Requires: ((cl-lib "0.5"))
@@ -88,9 +88,12 @@
(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 even if the
- head wasn't designated for exiting.")
+ "If a Hydra head sets this to t, exit the Hydra.
+This will be done even if the head wasn't designated for exiting.")
(defun hydra-set-transient-map (keymap on-exit &optional foreign-keys)
"Set KEYMAP to the highest priority.
@@ -113,21 +116,23 @@ warn: keep KEYMAP and issue a warning instead of running
the command."
(defun hydra--clearfun ()
"Disable the current Hydra unless `this-command' is a head."
- (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)))
+ (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'")
+ "When non-nil, don't call `hydra-curr-on-exit'.")
(defvar hydra--input-method-function nil
"Store overridden `input-method-function' here.")
@@ -136,16 +141,16 @@ warn: keep KEYMAP and issue a warning instead of running
the command."
"Disable the current Hydra."
(setq hydra-deactivate nil)
(remove-hook 'pre-command-hook 'hydra--clearfun)
+ (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
- (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)))
(when hydra-curr-on-exit
(let ((on-exit hydra-curr-on-exit))
(setq hydra-curr-on-exit nil)
@@ -172,6 +177,7 @@ warn: keep KEYMAP and issue a warning instead of running
the command."
(set symbol tail))))))
(defun hydra-amaranth-warn ()
+ "Issue a warning that the current input was ignored."
(interactive)
(message "An amaranth Hydra can only exit through a blue head"))
@@ -204,28 +210,31 @@ When nil, you can specify your own at each location like
this: _ 5a_.")
"0.13.1")
(defface hydra-face-red
- '((t (:foreground "#FF0000" :bold t)))
+ '((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
- '((t (:foreground "#0000FF" :bold t)))
+ '((((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)))
+ '((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)))
+ '((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)))
+ '((t (:foreground "#367588" :bold t)))
"Teal body has blue heads and warns on intercepting non-heads.
Exitable only through a blue head.")
@@ -241,6 +250,25 @@ Exitable only through a blue head.")
(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)))
@@ -335,11 +363,14 @@ When ARG is non-nil, use that instead."
"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."
- (if (or (symbolp x) (functionp x))
- x
- `(lambda ()
- (interactive)
- ,x)))
+ (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.
@@ -393,8 +424,8 @@ Return DEFAULT if PROP is not in H."
"Timer for the hint.")
(defvar hydra--work-around-dedicated t
- "When non-nil, assume there's no bug in `pop-to-buffer'
- selecting a dedicated window.")
+ "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'."
@@ -402,13 +433,25 @@ Return DEFAULT if PROP is not in H."
(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 "")))
+ (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"
+ (format (format "%%%ds: %%%ds" key-width (- -1 doc-width))
+ key doc))
+
(defun hydra--hint (body heads)
"Generate a hint for the echo area.
BODY, and HEADS are parameters to `defhydra'."
@@ -424,15 +467,41 @@ BODY, and HEADS are parameters to `defhydra'."
(cons (cadr h)
(cons pstr (cl-caddr h)))
alist)))))
- (mapconcat
- (lambda (x)
- (format
- (if (> (length (cdr x)) 0)
- (concat "[%s]: " (cdr x))
- "%s")
- (car x)))
- (nreverse (mapcar #'cdr alist))
- ", ")))
+
+ (let ((keys (nreverse (mapcar #'cdr alist)))
+ (n-cols (plist-get (cddr body) :columns)))
+ (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 (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
+ (cdr y)
+ max-doc-len))) x ""))
+ (hydra--matrix keys n-cols n-rows))
+ "\n")))
+
+
+ (concat
+ (mapconcat
+ (lambda (x)
+ (format
+ (if (> (length (cdr x)) 0)
+ (concat hydra-head-format (cdr x))
+ "%s")
+ (car x)))
+ keys
+ ", ")
+ (if keys "." ""))))))
(defvar hydra-fontify-head-function nil
"Possible replacement for `hydra-fontify-head-default'.")
@@ -454,14 +523,18 @@ HEAD's binding is returned as a string with a colored
face."
(when (and (null (cadr head))
(not head-exit))
(hydra--complain "nil cmd can only be blue"))
- (propertize (car 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))))))
+ (propertize (if (string= (car head) "%")
+ "%%"
+ (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.
@@ -476,22 +549,35 @@ HEAD's binding is returned as a string wrapped with [] or
{}."
(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))
+
(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 (replace-regexp-in-string "\\^" "" docstring))
+ (setq docstring (hydra--strip-align-markers docstring))
+ (setq docstring (replace-regexp-in-string "___" "_β_" docstring))
(let ((rest (hydra--hint body heads))
(start 0)
varlist
offset)
(while (setq start
(string-match
- "\\(?:%\\(
?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\(
?-?[0-9]*?\\)\\([-[:alnum:] ~.,;:/|?<>={}*+#]+?\\)_\\)"
+ "\\(?:%\\(
?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\(
?-?[0-9]*?\\)\\(\\[\\|]\\|[-[:alnum:] ~.,;:/|?<>address@hidden&]+?\\)_\\)"
docstring start))
(cond ((eq ?_ (aref (match-string 0 docstring) 0))
(let* ((key (match-string 4 docstring))
+ (key (if (equal key "β") "_" key))
(head (assoc key heads)))
(if head
(progn
@@ -526,7 +612,11 @@ The expressions can be auto-expanded according to NAME."
(if (eq ?\n (aref docstring 0))
`(concat (format ,(substring docstring 1) ,@(nreverse varlist))
,rest)
- `(format ,(concat docstring ": " rest ".")))))
+ `(format ,(replace-regexp-in-string
+ " +$" ""
+ (concat docstring ": "
+ (replace-regexp-in-string
+ "\\(%\\)" "\\1\\1" rest)))))))
(defun hydra--complain (format-string &rest args)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."
@@ -570,7 +660,7 @@ 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 ((name (hydra--head-name head name))
+ (let ((cmd-name (hydra--head-name head name))
(cmd (when (car head)
(hydra--make-callable
(cadr head))))
@@ -581,45 +671,47 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
(body-foreign-keys (hydra--body-foreign-keys body))
(body-timeout (plist-get body :timeout))
(body-idle (plist-get body :idle)))
- `(defun ,name ()
+ `(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)))
+ (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))
- ,(when cmd
- `(condition-case err
- ,(hydra--call-interactively cmd (cadr head))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv
- (sit-for 0.8)))))
- ,(if (and body-idle (eq (cadr head) 'body))
- `(hydra-idle-message ,body-idle ,hint)
- `(when hydra-is-helpful
- (if hydra-lv
- (lv-message (eval ,hint))
- (message (eval ,hint)))))
- (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))))))))
+ (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 "%S" err)
+ (unless hydra-lv
+ (sit-for 0.8)))))
+ ,(if (and body-idle (eq (cadr head) 'body))
+ `(hydra-idle-message ,body-idle ,hint)
+ `(when hydra-is-helpful
+ (if hydra-lv
+ (lv-message (eval ,hint))
+ (message (eval ,hint)))))
+ (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))))))))
(defmacro hydra--make-funcall (sym)
"Transform SYM into a `funcall' to call it."
@@ -629,9 +721,13 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
(defun hydra--head-name (h name)
"Return the symbol for head H of hydra with NAME."
(let ((str (format "%S/%s" name
- (if (symbolp (cadr h))
- (cadr h)
- (concat "lambda-" (car h))))))
+ (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")))
@@ -773,7 +869,7 @@ Cancel the previous `hydra-timeout'."
hydra-timeout-timer
`(lambda ()
,(when function
- `(funcall ,function))
+ `(funcall ,function))
(hydra-keyboard-quit)))
(timer-activate hydra-timeout-timer))
@@ -941,8 +1037,8 @@ result of `defhydra'."
,@(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))))
+ `((unless (keymapp (lookup-key ,body-map (kbd ,body-key)))
+ (define-key ,body-map (kbd ,body-key) nil))))
;; bind keys
,@(delq nil
(mapcar
@@ -962,7 +1058,7 @@ result of `defhydra'."
(if (boundp bind)
(keymapp (symbol-value bind))
t))
- `(define-key ,bind ,final-key (function
,name)))
+ `(define-key ,bind ,final-key (quote
,name)))
(t
(error "Invalid :bind property `%S' for
head %S" bind head)))))))
heads))
@@ -1036,6 +1132,22 @@ DOC defaults to TOGGLE-NAME split and capitalized."
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
diff --git a/packages/hydra/lv.el b/packages/hydra/lv.el
index e4425a2..8d6192f 100644
--- a/packages/hydra/lv.el
+++ b/packages/hydra/lv.el
@@ -62,8 +62,9 @@ Only the background color is significant."
buf)
(prog1 (setq lv-wnd
(select-window
- (split-window
- (frame-root-window) -1 'below)))
+ (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*")
diff --git a/packages/hydra/hydra-init.el b/packages/hydra/targets/hydra-init.el
similarity index 100%
rename from packages/hydra/hydra-init.el
rename to packages/hydra/targets/hydra-init.el
- [elpa] master 1e9276a 12/22: Remove trailing whitespace from :columns docstring, (continued)
- [elpa] master 1e9276a 12/22: Remove trailing whitespace from :columns docstring, Oleh Krehel, 2015/10/16
- [elpa] master 852ae26 14/22: Use quote instead of function to prevent compiler warnings, Oleh Krehel, 2015/10/16
- [elpa] master ea36afc 19/22: Allow "_", "!", and "&" as keys in docstrings, Oleh Krehel, 2015/10/16
- [elpa] master f58d356 17/22: Allow #'command syntax for heads, just to have it, Oleh Krehel, 2015/10/16
- [elpa] master 27b7f40 15/22: Make find-function work with defhydra, Oleh Krehel, 2015/10/16
- [elpa] master 3fb3168 18/22: hydra.el (hydra--format): Allow "@" key in the docs, Oleh Krehel, 2015/10/16
- [elpa] master 336602f 11/22: Add :columns option for hydra body, Oleh Krehel, 2015/10/16
- [elpa] master 4bf7f1c 21/22: Bump version, Oleh Krehel, 2015/10/16
- [elpa] master c5327e1 16/22: Declare dired-mark to silence byte-compiler, Oleh Krehel, 2015/10/16
- [elpa] master 39eed63 20/22: hydra.el (hydra-disable): Deactivate key-chord advice more, Oleh Krehel, 2015/10/16
- [elpa] master bfeccce 22/22: Merge commit '4bf7f1c9e46fb819c673e55d8a1891774e139f98' from hydra,
Oleh Krehel <=