;;; Code:
(require 'ert)
+(require 'hydra)
+ (message "Emacs version: %s" emacs-version)
(ert-deftest hydra-red-error ()
(should
("k" previous-error "prev")
("SPC" hydra-repeat "rep" :bind nil)))
'(progn
- (defun hydra-error/first-error nil "Create a hydra with a \"M-g\" body and the heads:
+ (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))))
+ (defun hydra-error/first-error nil
+ "Create a hydra with a \"M-g\" body and the heads:
\"h\": `first-error',
\"j\": `next-error',
The body can be accessed via `hydra-error/body'.
Call the head: `first-error'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function first-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-error/next-error nil "Create a hydra with a \"M-g\" body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit))
+ (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))))
+ (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',
The body can be accessed via `hydra-error/body'.
Call the head: `next-error'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function next-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-error/previous-error nil "Create a hydra with a \"M-g\" body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit))
+ (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))))
+ (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',
The body can be accessed via `hydra-error/body'.
Call the head: `previous-error'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function previous-error)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))))
- (unless (keymapp (lookup-key global-map (kbd "M-g")))
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit))
+ (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))))
+ (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]
- (function hydra-error/first-error))
+ (function
+ hydra-error/first-error))
(define-key global-map [134217831 106]
- (function hydra-error/next-error))
+ (function
+ hydra-error/next-error))
(define-key global-map [134217831 107]
- (function hydra-error/previous-error))
- (defun hydra-error/hint nil
- (if hydra-lv (lv-message (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))))
- (message (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/body nil "Create a hydra with a \"M-g\" body and the heads:
+ (function
+ hydra-error/previous-error))
+ (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/body nil
+ "Create a hydra with a \"M-g\" body and the heads:
\"h\": `first-error',
\"j\": `next-error',
\"SPC\": `hydra-repeat'
The body can be accessed via `hydra-error/body'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-error/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (32 . hydra-repeat)
- (107 . hydra-error/previous-error)
- (106 . hydra-error/next-error)
- (104 . hydra-error/first-error)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-error/hint))
+ (message
+ (eval hydra-error/hint))))
+ (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
("a" abbrev-mode "abbrev")
("q" nil "cancel")))
'(progn
- (defun hydra-toggle/toggle-truncate-lines-and-exit nil "Create a hydra with no body and the heads:
+ (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))))
+ (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',
The body can be accessed via `hydra-toggle/body'.
Call the head: `toggle-truncate-lines'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function toggle-truncate-lines))))
- (defun hydra-toggle/auto-fill-mode-and-exit nil "Create a hydra with no body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (progn
+ (setq this-command
+ (quote toggle-truncate-lines))
+ (call-interactively
+ (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',
The body can be accessed via `hydra-toggle/body'.
Call the head: `auto-fill-mode'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function auto-fill-mode))))
- (defun hydra-toggle/abbrev-mode-and-exit nil "Create a hydra with no body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (progn
+ (setq this-command
+ (quote auto-fill-mode))
+ (call-interactively
+ (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',
The body can be accessed via `hydra-toggle/body'.
Call the head: `abbrev-mode'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function abbrev-mode))))
- (defun hydra-toggle/nil nil "Create a hydra with no body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit)
+ (progn
+ (setq this-command
+ (quote abbrev-mode))
+ (call-interactively
+ (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',
The body can be accessed via `hydra-toggle/body'.
Call the head: `nil'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)))
- (defun hydra-toggle/hint nil
- (if hydra-lv (lv-message (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))))
- (message (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/body nil "Create a hydra with no body and the heads:
+ (interactive)
+ (hydra-default-pre)
+ (hydra-keyboard-quit))
+ (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/body nil
+ "Create a hydra with no body and the heads:
\"t\": `toggle-truncate-lines',
\"f\": `auto-fill-mode',
\"q\": `nil'
The body can be accessed via `hydra-toggle/body'."
- (interactive)
- (hydra-default-pre)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-toggle/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (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)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
+ (interactive)
+ (hydra-default-pre)
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-toggle/hint))
+ (message
+ (eval hydra-toggle/hint))))
+ (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
("k" previous-line)
("q" nil "quit")))
'(progn
- (defun hydra-vi/hydra-keyboard-quit-and-exit nil "Create a hydra with no body and the heads:
+ (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))))
+ (defun hydra-vi/next-line nil
+ "Create a hydra with no body and the heads:
- \"\a\": `hydra-keyboard-quit',
- \"j\": `next-line',
- \"k\": `previous-line',
- \"q\": `nil'
-
- The body can be accessed via `hydra-vi/body'.
-
- Call the head: `hydra-keyboard-quit'."
- (interactive)
- (hydra-default-pre)
- (set-cursor-color "#e52b50")
- (hydra-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function hydra-keyboard-quit))
- (set-cursor-color "#ffffff")))
- (defun hydra-vi/next-line nil "Create a hydra with no body and the heads:
-
- \"\a\": `hydra-keyboard-quit',
\"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")
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function next-line)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-vi/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can only exit through a blue head")
- (hydra-set-transient-map hydra-curr-map t)
- (when hydra-is-helpful (unless hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (7 . hydra-vi/hydra-keyboard-quit-and-exit)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-vi/previous-line nil "Create a hydra with no body and the heads:
-
- \"\a\": `hydra-keyboard-quit',
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit))
+ (condition-case err
+ (progn
+ (setq this-command
+ (quote next-line))
+ (call-interactively
+ (function next-line)))
+ ((quit error)
+ (message "%S" 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-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")
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function previous-line)))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-vi/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can only exit through a blue head")
- (hydra-set-transient-map hydra-curr-map t)
- (when hydra-is-helpful (unless hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (7 . hydra-vi/hydra-keyboard-quit-and-exit)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))))
- (defun hydra-vi/nil nil "Create a hydra with no body and the heads:
-
- \"\a\": `hydra-keyboard-quit',
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (let ((hydra--ignore t))
+ (hydra-keyboard-quit))
+ (condition-case err
+ (progn
+ (setq this-command
+ (quote previous-line))
+ (call-interactively
+ (function previous-line)))
+ ((quit error)
+ (message "%S" 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-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-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (set-cursor-color "#ffffff")))
- (defun hydra-vi/hint nil
- (if hydra-lv (lv-message (format #("vi: j, k, [q]: quit." 4 5 (face hydra-face-amaranth)
- 7 8 (face hydra-face-amaranth)
- 11 12 (face hydra-face-blue))))
- (message (format #("vi: j, k, [q]: quit." 4 5 (face hydra-face-amaranth)
- 7 8 (face hydra-face-amaranth)
- 11 12 (face hydra-face-blue))))))
- (defun hydra-vi/body nil "Create a hydra with no body and the heads:
-
- \"\a\": `hydra-keyboard-quit',
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (hydra-keyboard-quit))
+ (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/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")
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-vi/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (t lambda nil (interactive)
- (message "An amaranth Hydra can only exit through a blue head")
- (hydra-set-transient-map hydra-curr-map t)
- (when hydra-is-helpful (unless hydra-lv (sit-for 0.8))
- (hydra-vi/hint)))
- (113 . hydra-vi/nil)
- (107 . hydra-vi/previous-line)
- (106 . hydra-vi/next-line)
- (7 . hydra-vi/hydra-keyboard-quit-and-exit)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
+ (interactive)
+ (hydra-default-pre)
+ (set-cursor-color "#e52b50")
+ (let ((hydra--ignore nil))
+ (hydra-keyboard-quit))
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message
+ (eval hydra-vi/hint))
+ (message (eval hydra-vi/hint))))
+ (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))))
+ (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))
+ (condition-case err
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0))))
+ ((quit error)
+ (message "%S" 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-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)
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0)))))
+ (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/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))
+ (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))))))
+
+ (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))))
+ (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))
+ (condition-case err
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0))))
+ ((quit error)
+ (message "%S" 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-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)
+ (call-interactively
+ (function
+ (lambda nil
+ (interactive)
+ (text-scale-set 0)))))
+ (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/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))
+ (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))))))
(ert-deftest defhydradio ()
(should (equal
'(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
'bar
nil
"\n bar %s`foo\n"
- '(("a" (quote t) "" :cmd-name bar/lambda-a)
- ("q" nil "" :cmd-name bar/nil))))
+ '(("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 ()
(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"))))
+ '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
'(concat (format "%s narrow-or-widen-dwim %Sasdf\n"
"{n}"
(progn
(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"))))
+ '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
'(concat (format "%s narrow-or-widen-dwim %sasdf\n"
"{n}"
(progn
(buffer-narrowed-p)))
"[[q]]: cancel"))))
- (ert-deftest hydra-compat-colors-1 ()
- (should (equal (hydra--head-color
- '("e" (message "Exiting now") "blue")
- '(nil nil :color blue))
- 'blue))
- (should (equal (hydra--head-color
- '("c" (message "Continuing") "red" :color red)
- '(nil nil :color blue))
- 'red))
- (should (equal (hydra--head-color
- '("e" (message "Exiting now") "blue")
- '(nil nil :exit t))
- 'blue))
- (should (equal (hydra--head-color
- '("j" next-line "" :exit t)
- '(nil nil))
- 'blue))
- (should (equal (hydra--head-color
- '("c" (message "Continuing") "red" :exit nil)
- '(nil nil :exit t))
- 'red))
- (equal (hydra--head-color
- '("a" abbrev-mode nil)
- '(nil nil :color teal))
- 'teal)
- (equal (hydra--head-color
- '("a" abbrev-mode :exit nil)
- '(nil nil :color teal))
- 'amaranth))
-
(ert-deftest hydra-compat-colors-2 ()
(should
(equal
("e" fun-e)
("f" fun-f))))))
- (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
- (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)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function (lambda nil (interactive)
- (text-scale-set 0)))))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))))
- (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-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function (lambda nil (interactive)
- (text-scale-set 0))))))
- (defun hydra-zoom/hint nil
- (if hydra-lv (lv-message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
- 9 10 (face hydra-face-blue))))
- (message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
- 9 10 (face hydra-face-blue))))))
- (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)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))
- (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
- (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)
- (hydra-disable)
- (catch (quote hydra-disable)
- (condition-case err (prog1 t (call-interactively (function (lambda nil (interactive)
- (text-scale-set 0)))))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv (sit-for 0.8))
- nil))
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))))
- (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-disable)
- (hydra-cleanup)
- (catch (quote hydra-disable)
- (call-interactively (function (lambda nil (interactive)
- (text-scale-set 0))))))
- (defun hydra-zoom/hint nil
- (if hydra-lv (lv-message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
- 9 10 (face hydra-face-blue))))
- (message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
- 9 10 (face hydra-face-blue))))))
- (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)
- (hydra-disable)
- (catch (quote hydra-disable)
- (when hydra-is-helpful (hydra-zoom/hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map
- (quote (keymap (7 . hydra-keyboard-quit)
- (114 . hydra-zoom/lambda-r)
- (switch-frame . hydra--handle-switch-frame)
- (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))))
- t (lambda nil (hydra-cleanup))))
- (setq prefix-arg current-prefix-arg)))))))
-
(ert-deftest hydra--pad ()
(should (equal (hydra--pad '(a b c) 3)
'(a b c)))
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))
+
+ (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)
+ ,@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")))
+
(provide 'hydra-test)
;;; hydra-test.el ends here
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/hydra
- ;; Version: 0.12.1
+ ;; Version: 0.13.0
;; Keywords: bindings
;; Package-Requires: ((cl-lib "0.5"))
(require 'cl-lib)
(require 'lv)
- (defalias 'hydra-set-transient-map
- (if (fboundp 'set-transient-map)
- 'set-transient-map
- (lambda (map _keep-pred &optional on-exit)
- (with-no-warnings
- (set-temporary-overlay-map map (hydra--pred on-exit))))))
-
- (defun hydra--pred (on-exit)
- "Generate a predicate on whether to continue the Hydra state.
- Call ON-EXIT for clean-up.
- This is a compatibility code for Emacs older than 24.4."
- `(lambda ()
- (if (lookup-key hydra-curr-map (this-command-keys-vector))
- t
- (hydra-cleanup)
- ,(when on-exit
- `(funcall ,(hydra--make-callable on-exit)))
- nil)))
+ (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.")
+
+ (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."
+ (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."
+ (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'")
+
+ (defun hydra-disable ()
+ "Disable the current Hydra."
+ (remove-hook 'pre-command-hook 'hydra--clearfun)
+ (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--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)
+ (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 ()
+ (interactive)
+ (message "An amaranth Hydra can only exit through a blue head"))
;;* Customize
(defgroup hydra nil
:type 'boolean
:group 'hydra)
- (defcustom hydra-keyboard-quit "\a"
- "This binding will quit an amaranth Hydra.
- It's the only other way to quit it besides though a blue head.
- It's possible to set this to nil.")
-
(defcustom hydra-lv t
"When non-nil, `lv-message' (not `message') will be used to display hints."
:type 'boolean)
(defface hydra-face-red
'((t (:foreground "#FF0000" :bold t)))
- "Red Hydra heads will persist indefinitely."
+ "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)))
- "Blue Hydra heads will vanquish the Hydra.")
+ "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.
- Vanquishable only through a blue head.")
+ Exitable only through a blue head.")
(defface hydra-face-pink
'((t (:foreground "#FF6EB4" :bold t)))
- "Pink body has red heads and on intercepting non-heads calls them without quitting.
- Vanquishable only through a blue head.")
+ "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 an warns on intercepting non-heads.
- Vanquishable only through a blue head.")
+ Exitable only through a blue head.")
;;* Fontification
(defun hydra-add-font-lock ()
(define-key map [kp-8] 'hydra--digit-argument)
(define-key map [kp-9] 'hydra--digit-argument)
(define-key map [kp-subtract] 'hydra--negative-argument)
- (define-key map [switch-frame] 'hydra--handle-switch-frame)
map)
"Keymap that all Hydras inherit. See `universal-argument-map'.")
- (defvar hydra-curr-map
- (make-sparse-keymap)
- "Keymap of the current Hydra called.")
-
- (defun hydra--handle-switch-frame (evt)
- "Quit hydra and call old switch-frame event handler for EVT."
- (interactive "e")
- (hydra-keyboard-quit)
- (funcall (lookup-key (current-global-map) [switch-frame]) evt))
-
(defun hydra--universal-argument (arg)
"Forward to (`universal-argument' ARG)."
(interactive "P")
(list (* 4 (car arg)))
(if (eq arg '-)
(list -4)
- '(4))))
- (hydra-set-transient-map hydra-curr-map t))
+ '(4)))))
(defun hydra--digit-argument (arg)
"Forward to (`digit-argument' ARG)."
(interactive "P")
- (let ((universal-argument-map hydra-curr-map))
- (digit-argument arg)))
+ (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")
- (let ((universal-argument-map hydra-curr-map))
- (negative-argument arg)))
+ (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'.")
(funcall hydra-repeat--command))
;;* Misc internals
- (defvar hydra-last nil
- "The result of the last `hydra-set-transient-map' call.")
-
(defun hydra--callablep (x)
"Test if X is callable."
(or (functionp x)
Return DEFAULT if PROP is not in H."
(hydra-plist-get-default (cl-cdddr h) prop default))
- (defun hydra--aggregate-color (head-color body-color)
- "Return the resulting head color for HEAD-COLOR and BODY-COLOR."
- (cond ((eq head-color 'red)
- (cl-case body-color
- (red 'red)
- (blue 'red)
- (amaranth 'amaranth)
- (pink 'pink)
- (cyan 'amaranth)))
- ((eq head-color 'blue)
- (cl-case body-color
- (red 'blue)
- (blue 'blue)
- (amaranth 'teal)
- (pink 'blue)
- (cyan 'teal)))
- (t
- (error "Can't aggregate head %S to body %S"
- head-color body-color))))
-
- (defun hydra--head-color (h body)
- "Return the color of a Hydra head H with BODY."
- (let* ((exit (hydra--head-property h :exit 'default))
- (color (hydra--head-property h :color))
- (foreign-keys (hydra--body-foreign-keys body))
- (head-color
- (cond ((eq exit 'default)
- (cl-case color
- (blue 'blue)
- (red 'red)
- (t
- (unless (null color)
- (error "Use only :blue or :red for heads: %S" h)))))
- ((null exit)
- (if color
- (error "Don't mix :color and :exit - they are aliases: %S" h)
- (cl-case foreign-keys
- (run 'pink)
- (warn 'amaranth)
- (t 'red))))
- ((eq exit t)
- (if color
- (error "Don't mix :color and :exit - they are aliases: %S" h)
- 'blue))
- (t
- (error "Unknown :exit %S" exit)))))
- (cond ((null (cadr h))
- (when head-color
- (hydra--complain
- "Doubly specified blue head - nil cmd is already blue: %S" h))
- 'blue)
- ((null head-color)
- (hydra--body-color body))
- ((null foreign-keys)
- head-color)
- ((eq foreign-keys 'run)
- (if (eq head-color 'red)
- 'pink
- 'blue))
- ((eq foreign-keys 'warn)
- (if (memq head-color '(red amaranth))
- 'amaranth
- 'teal))
- (t
- (error "Unexpected %S %S" h body)))))
-
(defun hydra--body-foreign-keys (body)
"Return what BODY does with a non-head binding."
(or
((amaranth teal) 'warn)
(pink 'run)))))
- (defun hydra--body-color (body)
- "Return the color of BODY.
- BODY is the second argument to `defhydra'"
- (let ((color (plist-get (cddr body) :color))
- (exit (plist-get (cddr body) :exit))
- (foreign-keys (plist-get (cddr body) :foreign-keys)))
- (cond ((eq foreign-keys 'warn)
- (if exit 'teal 'amaranth))
- ((eq foreign-keys 'run) 'pink)
- (exit 'blue)
- (color color)
- (t 'red))))
-
- (defun hydra--face (h body)
- "Return the face for a Hydra head H with BODY."
- (cl-case (hydra--head-color h body)
- (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" h))))
+ (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)))))
(defvar hydra--input-method-function nil
"Store overridden `input-method-function' here.")
(setq hydra--input-method-function input-method-function)
(setq input-method-function nil))))
- (defun hydra-cleanup ()
- "Clean up after a Hydra."
- (when hydra--input-method-function
- (setq input-method-function hydra--input-method-function)
- (setq hydra--input-method-function nil))
- (when (window-live-p lv-wnd)
- (let ((buf (window-buffer lv-wnd)))
- (delete-window lv-wnd)
- (kill-buffer buf))))
-
- (defvar hydra-timer (timer-create)
+ (defvar hydra-timeout-timer (timer-create)
"Timer for `hydra-timeout'.")
+ (defvar hydra-message-timer (timer-create)
+ "Timer for the hint.")
+
(defun hydra-keyboard-quit ()
"Quitting function similar to `keyboard-quit'."
(interactive)
(hydra-disable)
- (hydra-cleanup)
- (cancel-timer hydra-timer)
- (unless hydra-lv
+ (cancel-timer hydra-timeout-timer)
+ (cancel-timer hydra-message-timer)
+ (if hydra-lv
+ (when (window-live-p lv-wnd)
+ (let ((buf (window-buffer lv-wnd)))
+ (delete-window lv-wnd)
+ (kill-buffer buf)))
(message ""))
nil)
- (defun hydra-disable ()
- "Disable the current Hydra."
- (cond
- ;; Emacs 25
- ((functionp hydra-last)
- (funcall hydra-last))
-
- ;; Emacs 24.3 or older
- ((< emacs-minor-version 4)
- (setq emulation-mode-map-alists
- (cl-remove-if
- (lambda (x)
- (and (consp x)
- (consp (car x))
- (equal (cdar x) hydra-curr-map)))
- emulation-mode-map-alists)))
-
- ;; Emacs 24.4.1
- (t
- (setq overriding-terminal-local-map nil))))
-
- (defun hydra--unalias-var (str prefix)
- "Return the symbol named STR if it's bound as a variable.
- Otherwise, add PREFIX to the symbol name."
- (let ((sym (intern-soft str)))
- (if (boundp sym)
- sym
- (intern (concat prefix "/" str)))))
-
(defun hydra--hint (body heads)
"Generate a hint for the echo area.
BODY, and HEADS are parameters to `defhydra'."
(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."
- (propertize (car head) 'face (hydra--face head body)))
+ (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 (eq head-color 'blue)))
+ (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))))))
(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 {}."
- (let ((color (hydra--head-color head body)))
- (format
- (if (eq color 'blue)
- "[%s]"
- "{%s}") (car head))))
+ (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."
offset)
(while (setq start
(string-match
- "\\(?:%\\( ?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\( ?-?[0-9]*\\)\\([a-z-A-Z~.,;:0-9/|?<>={}]+\\)_\\)"
+ "\\(?:%\\( ?-?[0-9]*s?\\)\\(`[a-z-A-Z/0-9]+\\|(\\)\\)\\|\\(?:_\\( ?-?[0-9]*\\)\\([[:alnum:]-~.,;:/|?<>={}*+#]+\\)_\\)"
docstring start))
(cond ((eq ?_ (aref (match-string 0 docstring) 0))
(let* ((key (match-string 4 docstring))
,rest)
`(format ,(concat docstring ": " rest ".")))))
- (defun hydra--message (name body docstring heads)
- "Generate code to display the hint in the preferred echo area.
- Set `hydra-lv' to choose the echo area.
- NAME, BODY, DOCSTRING, and HEADS are parameters of `defhydra'."
- (let ((format-expr (hydra--format name body docstring heads)))
- `(if hydra-lv
- (lv-message ,format-expr)
- (message ,format-expr))))
-
(defun hydra--complain (format-string &rest args)
"Forward to (`message' FORMAT-STRING ARGS) unless `hydra-verbose' is nil."
(when hydra-verbose
heads ",\n")
(format "The body can be accessed via `%S'." body-name)))
+ (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)
+ (call-interactively #',cmd))
+ `(call-interactively #',cmd)))
+
(defun hydra--make-defun (name body doc head
- keymap body-pre body-post &optional other-post)
+ 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 and BODY-POST are pre-processed in `defhydra'.
- OTHER-POST is an optional extension to the :post key of BODY."
+ 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 body))
(cmd (when (car head)
(hydra--make-callable
(cadr head))))
- (color (when (car head)
- (hydra--head-color head body)))
(doc (if (car head)
(format "%s\n\nCall the head: `%S'." doc (cadr head))
doc))
(hint (intern (format "%S/hint" name)))
- (body-color (hydra--body-color body))
- (body-timeout (plist-get body :timeout)))
+ (body-foreign-keys (hydra--body-foreign-keys body))
+ (body-timeout (plist-get body :timeout))
+ (body-idle (plist-get body :idle)))
`(defun ,name ()
,doc
(interactive)
(hydra-default-pre)
,@(when body-pre (list body-pre))
- (hydra-disable)
- ,@(when (memq color '(blue teal)) '((hydra-cleanup)))
- (catch 'hydra-disable
- ,@(delq nil
- (if (memq color '(blue teal))
- `(,(when cmd `(call-interactively #',cmd))
- ,body-post)
- `(,(when cmd
- `(condition-case err
- (prog1 t
- (call-interactively #',cmd))
- ((quit error)
- (message "%S" err)
- (unless hydra-lv
- (sit-for 0.8))
- nil)))
- (when hydra-is-helpful
- (,hint))
- (setq hydra-last
- (hydra-set-transient-map
- (setq hydra-curr-map ',keymap)
- t
- ,(if (and
- (not (memq body-color
- '(amaranth pink teal)))
- body-post)
- `(lambda () (hydra-cleanup) ,body-post)
- `(lambda () (hydra-cleanup)))))
- ,(or other-post
- (when body-timeout
- (list 'hydra-timeout
- body-timeout
- (when body-post
- (hydra--make-callable body-post))))))))))))
-
- (defun hydra-pink-fallback ()
- "On intercepting a non-head, try to run it."
- (let ((keys (this-command-keys))
- kb)
- (when (equal keys [backspace])
- (setq keys "\7f"))
- (setq kb (key-binding keys))
- (if kb
- (if (commandp kb)
- (condition-case err
- (call-interactively kb)
- ((quit error)
- (message "%S" err)
- (unless hydra-lv
- (sit-for 0.8))))
- (message "Pink Hydra can't currently handle prefixes, continuing"))
- (message "Pink Hydra could not resolve: %S" keys))))
-
- (defun hydra--modify-keymap (keymap def)
- "In KEYMAP, add DEF to each sub-keymap."
- (cl-labels
- ((recur (map)
- (if (atom map)
- map
- (if (eq (car map) 'keymap)
- (cons 'keymap
- (cons
- def
- (recur (cdr map))))
- (cons
- (recur (car map))
- (recur (cdr map)))))))
- (recur keymap)))
+ ,@(if (hydra--head-property head :exit)
+ `((hydra-keyboard-quit)
+ ,@(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))
+ ,(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' that calls it."
+ "Transform SYM into a `funcall' to call it."
`(when (and ,sym (symbolp ,sym))
(setq ,sym `(funcall #',,sym))))
- (defun hydra--handle-nonhead (keymap name body heads)
- "Setup KEYMAP for intercepting non-head bindings.
- NAME, BODY and HEADS are parameters to `defhydra'."
- (let ((body-color (hydra--body-color body))
- (body-post (plist-get (cddr body) :post)))
- (if body-post
- (hydra--make-funcall body-post)
- (when hydra-keyboard-quit
- (define-key keymap hydra-keyboard-quit #'hydra-keyboard-quit)))
- (when (memq body-color '(amaranth pink teal))
- (if (cl-some (lambda (h)
- (memq (hydra--head-color h body) '(blue teal)))
- heads)
- (progn
- (setcdr
- keymap
- (cdr
- (hydra--modify-keymap
- keymap
- (cons t
- `(lambda ()
- (interactive)
- ,(cond
- ((memq body-color '(amaranth teal))
- '(message "An amaranth Hydra can only exit through a blue head"))
- (t
- '(hydra-pink-fallback)))
- (hydra-set-transient-map hydra-curr-map t)
- (when hydra-is-helpful
- (unless hydra-lv
- (sit-for 0.8))
- (,(intern (format "%S/hint" name))))))))))
- (unless (eq body-color 'teal)
- (error
- "An %S Hydra must have at least one blue head in order to exit"
- body-color))))))
-
(defun hydra--head-name (h name body)
"Return the symbol for head H of hydra with NAME and BODY."
(let ((str (format "%S/%s" name
(if (symbolp (cadr h))
(cadr h)
(concat "lambda-" (car h))))))
- (when (and (memq (hydra--head-color h body) '(blue teal))
+ (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 . red) . hydra-repeat)))
+ (let ((ali '(((hydra-repeat . nil) . hydra-repeat)))
res entry)
(dolist (h heads)
(if (setq entry (assoc (cons (cadr h)
- (hydra--head-color h '(nil nil)))
+ (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-color h '(nil nil)))
+ (hydra--head-property h :exit))
(plist-get (cl-cdddr h) :cmd-name))
ali)
(push h res)))
(dolist (n names)
(set n (aref (get n 'range) 0))))
+ (defun hydra-idle-message (secs hint)
+ "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 ()
+ (when hydra-is-helpful
+ (if hydra-lv
+ (lv-message (eval hint))
+ (message (eval hint))))
+ (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-timer)
- (setq hydra-timer (timer-create))
- (timer-set-time hydra-timer
+ (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-timer
+ hydra-timeout-timer
`(lambda ()
,(when function
`(funcall ,function))
(hydra-keyboard-quit)))
- (timer-activate hydra-timer))
+ (timer-activate hydra-timeout-timer))
;;* Macros
;;;###autoload
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.
+ 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
(setq docstring "hydra")))
(when (keywordp (car body))
(setq body (cons nil (cons nil body))))
- (let* ((keymap (copy-keymap hydra-base-map))
- (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-post (plist-get body-plist :post)))
- (hydra--make-funcall body-post)
- (when body-post
- (setq heads (cons (list hydra-keyboard-quit #'hydra-keyboard-quit nil :exit t)
- heads)))
- (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 "")))
- (setcdr (nthcdr 2 h)
- (list :cmd-name (hydra--head-name h name body))))
- (t
- (let ((hint (cl-caddr h)))
- (unless (or (null hint)
- (stringp hint))
- (setcdr (cdr h) (cons
- (hydra-plist-get-default body-plist :hint "")
- (cddr h))))
- (setcdr (cddr h)
- `(:cmd-name
- ,(hydra--head-name h name body)
- ,@(cl-cdddr h))))))))
- (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--handle-nonhead keymap name body heads)
- `(progn
- ;; create defuns
- ,@(mapcar
- (lambda (head)
- (hydra--make-defun name body doc head keymap
- body-pre body-post))
- 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)
- (not (eq (cadr head) 'hydra-keyboard-quit))
- (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 (function ,name)))
- (t
- (error "Invalid :bind property `%S' for head %S" bind head)))))))
- heads))
- (defun ,(intern (format "%S/hint" name)) ()
- ,(hydra--message name body docstring heads))
- ,(hydra--make-defun
- name body doc '(nil body)
- keymap
- (or body-body-pre body-pre) body-post
- '(setq prefix-arg current-prefix-arg))))))
+ (condition-case 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 "")))
+ (setcdr (nthcdr 2 h) (list :exit body-exit)))
+ (t
+ (let ((hint (cl-caddr h)))
+ (unless (or (null hint)
+ (stringp hint))
+ (setcdr (cdr h) (cons
+ (hydra-plist-get-default body-plist :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 body))
+ (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))
+ ;; 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 (function ,name)))
+ (t
+ (error "Invalid :bind property `%S' for head %S" bind head)))))))
+ heads))
+ (set
+ (defvar ,(intern (format "%S/hint" name)) nil
+ ,(format "Dynamic hint for %S." name))
+ ',(hydra--format name body docstring 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
+ (if debug-on-error
+ (signal (car err) (cdr err))
+ (message "Error in defhydra %S: %s" name (cdr err)))
+ nil)))
(defmacro defhydradio (name _body &rest heads)
"Create radios with prefix NAME.