[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 32b8352 36/36: Merge commit '943636fe4a35298d9d234222bc452
|
From: |
Oleh Krehel |
|
Subject: |
[elpa] master 32b8352 36/36: Merge commit '943636fe4a35298d9d234222bc4520dec9ef2305' from hydra |
|
Date: |
Sat, 22 Jul 2017 11:22:26 -0400 (EDT) |
branch: master
commit 32b8352c57238a370661f9bac9bb2e933163848d
Merge: 231ac7f 943636f
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
Merge commit '943636fe4a35298d9d234222bc4520dec9ef2305' from hydra
---
packages/hydra/hydra-examples.el | 49 +++++-
packages/hydra/hydra-ox.el | 8 +-
packages/hydra/hydra-test.el | 362 +++++++++++++++++++++++++++------------
packages/hydra/hydra.el | 322 +++++++++++++++++++++++++++++-----
packages/hydra/lv.el | 4 +-
5 files changed, 584 insertions(+), 161 deletions(-)
diff --git a/packages/hydra/hydra-examples.el b/packages/hydra/hydra-examples.el
index 9264feb..70f75b0 100644
--- a/packages/hydra/hydra-examples.el
+++ b/packages/hydra/hydra-examples.el
@@ -138,7 +138,8 @@
("e" move-end-of-line "end")
("d" delete-region "del" :color blue)
("y" kill-ring-save "yank" :color blue)
- ("q" nil "quit"))))
+ ("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
@@ -290,6 +291,48 @@ _h_ _l_ _o_k _y_ank
;; 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)
@@ -336,4 +379,8 @@ _h_ _l_ _o_k _y_ank
(goto-char mk))))
(provide 'hydra-examples)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
;;; hydra-examples.el ends here
diff --git a/packages/hydra/hydra-ox.el b/packages/hydra/hydra-ox.el
index e8d48e3..a992efc 100644
--- a/packages/hydra/hydra-ox.el
+++ b/packages/hydra/hydra-ox.el
@@ -27,7 +27,13 @@
(require 'hydra)
(require 'org)
-(require 'hydra) ;`defhydradio' is not autoloaded!
+(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.")
diff --git a/packages/hydra/hydra-test.el b/packages/hydra/hydra-test.el
index a988a25..4618d6b 100644
--- a/packages/hydra/hydra-test.el
+++ b/packages/hydra/hydra-test.el
@@ -121,20 +121,18 @@ Call the head: `first-error'."
(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))))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-error/hint))
- (message
- (eval hydra-error/hint))))
+ (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
@@ -159,20 +157,18 @@ Call the head: `next-error'."
(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))))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-error/hint))
- (message
- (eval hydra-error/hint))))
+ (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
@@ -197,20 +193,18 @@ Call the head: `previous-error'."
(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))))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-error/hint))
- (message
- (eval hydra-error/hint))))
+ (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
@@ -224,12 +218,12 @@ Call the head: `previous-error'."
(define-key global-map (kbd "M-g")
nil))
(define-key global-map [134217831 104]
- (quote hydra-error/first-error))
+ (quote hydra-error/first-error))
(define-key global-map [134217831 106]
- (quote hydra-error/next-error))
+ (quote hydra-error/next-error))
(define-key global-map [134217831 107]
- (quote
- 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:
@@ -245,12 +239,9 @@ The body can be accessed via `hydra-error/body'."
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-error/body)))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-error/hint))
- (message
- (eval hydra-error/hint))))
+ (hydra-show-hint
+ hydra-error/hint
+ (quote hydra-error))
(hydra-set-transient-map
hydra-error/keymap
(lambda nil
@@ -349,7 +340,7 @@ Call the head: `toggle-truncate-lines'."
(progn
(setq this-command
(quote toggle-truncate-lines))
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function
toggle-truncate-lines))))
(defun hydra-toggle/auto-fill-mode-and-exit nil
@@ -371,7 +362,7 @@ Call the head: `auto-fill-mode'."
(progn
(setq this-command
(quote auto-fill-mode))
- (call-interactively
+ (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:
@@ -392,7 +383,7 @@ Call the head: `abbrev-mode'."
(progn
(setq this-command
(quote abbrev-mode))
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function abbrev-mode))))
(defun hydra-toggle/nil nil
"Create a hydra with no body and the heads:
@@ -425,12 +416,9 @@ The body can be accessed via `hydra-toggle/body'."
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-toggle/body)))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-toggle/hint))
- (message
- (eval hydra-toggle/hint))))
+ (hydra-show-hint
+ hydra-toggle/hint
+ (quote hydra-toggle))
(hydra-set-transient-map
hydra-toggle/keymap
(lambda nil
@@ -526,16 +514,15 @@ Call the head: `next-line'."
(progn
(setq this-command
(quote next-line))
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function next-line)))
((quit error)
- (message "%S" err)
+ (message
+ (error-message-string err))
(unless hydra-lv (sit-for 0.8))))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-vi/hint))
- (message (eval hydra-vi/hint))))
+ (hydra-show-hint
+ hydra-vi/hint
+ (quote hydra-vi))
(hydra-set-transient-map
hydra-vi/keymap
(lambda nil
@@ -563,16 +550,15 @@ Call the head: `previous-line'."
(progn
(setq this-command
(quote previous-line))
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function previous-line)))
((quit error)
- (message "%S" err)
+ (message
+ (error-message-string err))
(unless hydra-lv (sit-for 0.8))))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-vi/hint))
- (message (eval hydra-vi/hint))))
+ (hydra-show-hint
+ hydra-vi/hint
+ (quote hydra-vi))
(hydra-set-transient-map
hydra-vi/keymap
(lambda nil
@@ -610,11 +596,9 @@ The body can be accessed via `hydra-vi/body'."
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-vi/body)))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-vi/hint))
- (message (eval hydra-vi/hint))))
+ (hydra-show-hint
+ hydra-vi/hint
+ (quote hydra-vi))
(hydra-set-transient-map
hydra-vi/keymap
(lambda nil
@@ -706,20 +690,18 @@ Call the head: `(text-scale-set 0)'."
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
(condition-case err
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function
(lambda nil
(interactive)
(text-scale-set 0))))
((quit error)
- (message "%S" err)
+ (message
+ (error-message-string err))
(unless hydra-lv (sit-for 0.8))))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-zoom/hint))
- (message
- (eval hydra-zoom/hint))))
+ (hydra-show-hint
+ hydra-zoom/hint
+ (quote hydra-zoom))
(hydra-set-transient-map
hydra-zoom/keymap
(lambda nil
@@ -741,7 +723,7 @@ Call the head: `(text-scale-set 0)'."
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body))
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function
(lambda nil
(interactive)
@@ -760,12 +742,9 @@ The body can be accessed via `hydra-zoom/body'."
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-zoom/hint))
- (message
- (eval hydra-zoom/hint))))
+ (hydra-show-hint
+ hydra-zoom/hint
+ (quote hydra-zoom))
(hydra-set-transient-map
hydra-zoom/keymap
(lambda nil
@@ -857,20 +836,18 @@ Call the head: `(text-scale-set 0)'."
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
(condition-case err
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function
(lambda nil
(interactive)
(text-scale-set 0))))
((quit error)
- (message "%S" err)
+ (message
+ (error-message-string err))
(unless hydra-lv (sit-for 0.8))))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-zoom/hint))
- (message
- (eval hydra-zoom/hint))))
+ (hydra-show-hint
+ hydra-zoom/hint
+ (quote hydra-zoom))
(hydra-set-transient-map
hydra-zoom/keymap
(lambda nil
@@ -892,7 +869,7 @@ Call the head: `(text-scale-set 0)'."
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body))
- (call-interactively
+ (hydra--call-interactively-remap-maybe
(function
(lambda nil
(interactive)
@@ -911,12 +888,9 @@ The body can be accessed via `hydra-zoom/body'."
(hydra-keyboard-quit)
(setq hydra-curr-body-fn
(quote hydra-zoom/body)))
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message
- (eval hydra-zoom/hint))
- (message
- (eval hydra-zoom/hint))))
+ (hydra-show-hint
+ hydra-zoom/hint
+ (quote hydra-zoom))
(hydra-set-transient-map
hydra-zoom/keymap
(lambda nil
@@ -1137,6 +1111,27 @@ _f_ auto-fill-mode: %`auto-fill-function
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
@@ -1295,6 +1290,19 @@ _w_ Worf: % -8`hydra-tng/worf^^
_h_ Set phasers to
("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
@@ -1351,6 +1359,21 @@ _w_ Worf: % -8`hydra-tng/worf^^
_h_ Set phasers to
(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
@@ -1414,6 +1437,125 @@ t: info-to"
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/packages/hydra/hydra.el b/packages/hydra/hydra.el
index 8c6ce7f..c837e0f 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.5
+;; Version: 0.14.0
;; Keywords: bindings
;; Package-Requires: ((cl-lib "0.5"))
@@ -69,15 +69,20 @@
;; you can nest Hydras if you wish, with `hydra-toggle/body' possibly
;; becoming a blue head of another Hydra.
;;
-;; Initially, Hydra shipped with a simplified `hydra-create' macro, to
-;; which you could hook up the examples from hydra-examples.el. It's
-;; better to take the examples simply as templates and use `defhydra'
-;; instead of `hydra-create', since it's more flexible.
+;; 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.")
@@ -95,6 +100,9 @@
"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.
@@ -180,7 +188,7 @@ warn: keep KEYMAP and issue a warning instead of running
the command."
(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"))
+ (message hydra-amaranth-warn-message))
;;* Customize
(defgroup hydra nil
@@ -193,6 +201,12 @@ warn: keep KEYMAP and issue a warning instead of running
the command."
: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)
@@ -203,7 +217,19 @@ warn: keep KEYMAP and issue a warning instead of running
the command."
(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_.")
+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
@@ -389,6 +415,14 @@ one of the properties on the list."
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
@@ -450,17 +484,19 @@ Return DEFAULT if PROP is not in H."
(defun hydra-key-doc-function-default (key key-width doc doc-width)
"Doc"
- (format (format "%%%ds: %%%ds" key-width (- -1 doc-width))
- key 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 (body heads)
+(defun hydra--hint-heads-wocol (body heads)
"Generate a hint for the echo area.
-BODY, and HEADS are parameters to `defhydra'."
+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))
@@ -516,6 +552,17 @@ BODY, and HEADS are parameters to `defhydra'."
(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'.")
@@ -536,18 +583,17 @@ 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 (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)))))))
+ (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.
@@ -573,6 +619,21 @@ HEAD's binding is returned as a string wrapped with [] or
{}."
(setq str (replace-match "" nil nil str))))
str))
+(defvar hydra-docstring-keys-translate-alist
+ '(("↑" . "<up>")
+ ("↓" . "<down>")
+ ("→" . "<right>")
+ ("←" . "<left>")
+ ("⌫" . "DEL")
+ ("⌦" . "<deletechar>")
+ ("⏎" . "RET")))
+
+(defconst hydra-width-spec-regex " ?-?[0-9]*?"
+ "Regex for the width spec in keys and %` quoted sexps.")
+
+(defvar hydra-key-regex "\\[\\|]\\|[-[:alnum:]
~.,;:/|?<>address@hidden&^↑↓←→⌫⌦⏎'`()\"$]+?"
+ "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\".
@@ -580,27 +641,57 @@ _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 (hydra--hint body heads))
+ (let ((rest (if (eq (plist-get (cddr body) :hint) 'none)
+ ""
+ (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:] ~.,;:/|?<>address@hidden&^]+?\\)_\\)"
+ (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))
+ (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
- (push (hydra-fontify-head head body) varlist)
+ (push (nth 2 head) varlist)
(setq docstring
(replace-match
(or
- hydra-key-format-spec
+ 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
@@ -656,6 +747,16 @@ HEADS is a list of heads."
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."
@@ -663,8 +764,8 @@ Set `this-command' to NAME."
(not (memq name '(nil body))))
`(progn
(setq this-command ',name)
- (call-interactively #',cmd))
- `(call-interactively #',cmd)))
+ (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
@@ -711,15 +812,12 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
`(condition-case err
,(hydra--call-interactively cmd (cadr head))
((quit error)
- (message "%S" err)
+ (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)
- `(when hydra-is-helpful
- (if hydra-lv
- (lv-message (eval ,hint))
- (message (eval ,hint)))))
+ `(hydra-idle-message ,body-idle ,hint ',name)
+ `(hydra-show-hint ,hint ',name))
(hydra-set-transient-map
,keymap
(lambda () (hydra-keyboard-quit) ,body-before-exit)
@@ -729,6 +827,40 @@ BODY-AFTER-EXIT is added to the end of the wrapper."
,(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))
@@ -858,7 +990,99 @@ NAMES should be defined by `defhydradio' or similar."
(dolist (n names)
(set n (aref (get n 'range) 0))))
-(defun hydra-idle-message (secs hint)
+;; 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))
@@ -867,10 +1091,7 @@ NAMES should be defined by `defhydradio' or similar."
(timer-set-function
hydra-message-timer
(lambda ()
- (when hydra-is-helpful
- (if hydra-lv
- (lv-message (eval hint))
- (message (eval hint))))
+ (hydra-show-hint hint name)
(cancel-timer hydra-message-timer)))
(timer-activate hydra-message-timer))
@@ -941,6 +1162,7 @@ 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)))
@@ -975,16 +1197,22 @@ result of `defhydra'."
((= len 2)
(setcdr (cdr h)
(list
- (hydra-plist-get-default body-plist :hint "")))
+ (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)
- (stringp (eval hint)))
- (setcdr (cdr h) (cons
- (hydra-plist-get-default body-plist
:hint "")
- (cddr h)))))
+ (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))
diff --git a/packages/hydra/lv.el b/packages/hydra/lv.el
index 23d2c30..87f7e5e 100644
--- a/packages/hydra/lv.el
+++ b/packages/hydra/lv.el
@@ -65,9 +65,9 @@ Only the background color is significant."
(let ((ignore-window-parameters t))
(split-window
(frame-root-window) -1 'below))))
- (if (setq buf (get-buffer "*LV*"))
+ (if (setq buf (get-buffer " *LV*"))
(switch-to-buffer buf)
- (switch-to-buffer "*LV*")
+ (switch-to-buffer " *LV*")
(set-window-hscroll lv-wnd 0)
(setq window-size-fixed t)
(setq mode-line-format nil)
- [elpa] master 585db09 17/36: hydra-examples.el: Add example of setting verbosity, (continued)
- [elpa] master 585db09 17/36: hydra-examples.el: Add example of setting verbosity, Oleh Krehel, 2017/07/22
- [elpa] master 6d5bdf7 11/36: Introduce (:hint none), Oleh Krehel, 2017/07/22
- [elpa] master 76d51ec 23/36: Fix compile warnings, Oleh Krehel, 2017/07/22
- [elpa] master dd5f703 27/36: hydra.el: Use error-message-string, not message, Oleh Krehel, 2017/07/22
- [elpa] master d2aaf86 20/36: Fix e.g. _f_(foo) in format string, Oleh Krehel, 2017/07/22
- [elpa] master a72d68a 28/36: hydra.el (hydra-fontify-head-default): Fix head keys as "%f", Oleh Krehel, 2017/07/22
- [elpa] master 3527b32 24/36: Fix byte compiler warnings, Oleh Krehel, 2017/07/22
- [elpa] master 943636f 35/36: hydra.el: Bump version, Oleh Krehel, 2017/07/22
- [elpa] master 3db82e5 29/36: Implement named columns, Oleh Krehel, 2017/07/22
- [elpa] master 95008ea 30/36: hydra.el: Add automatic lookup for remaped cmd, Oleh Krehel, 2017/07/22
- [elpa] master 32b8352 36/36: Merge commit '943636fe4a35298d9d234222bc4520dec9ef2305' from hydra,
Oleh Krehel <=
- [elpa] master 91f8e7c 22/36: hydra.el: Bump version, Oleh Krehel, 2017/07/22
- [elpa] master a85a617 03/36: Allow to use e.g. "↑" in place of "<up>" in the docstring, Oleh Krehel, 2017/07/22
- [elpa] master 9c2589f 19/36: Update the package description, Oleh Krehel, 2017/07/22
- [elpa] master 63de503 21/36: hydra.el (hydra-key-regex): Add "$", Oleh Krehel, 2017/07/22
- [elpa] master 81d88e4 15/36: hydra.el (hydra-show-hint): Extract from defhydra, Oleh Krehel, 2017/07/22
- [elpa] master 1d378c6 16/36: Allow to set hydra verbosity, Oleh Krehel, 2017/07/22
- [elpa] master 2ebf862 25/36: Move Amaranth warning message to a defvar, Oleh Krehel, 2017/07/22
- [elpa] master a07b92a 26/36: lv.el (lv-window): Rename to " *LV*", Oleh Krehel, 2017/07/22
- [elpa] master 36fb5e0 32/36: hydra.el (defhydra): Use copy-tree on heads, Oleh Krehel, 2017/07/22
- [elpa] master 02f2907 33/36: hydra.el (hydra--sort-heads): change ordering method of columns, Oleh Krehel, 2017/07/22