;; The undo keybindings `C-x u` and `C-_` enter the polyp.
(defpolyp polyp-undo
"_u_ndo _r_edo"
("u" undo-fu-only-undo "C-x u" "C-_")
("r" undo-fu-only-redo))I wanted to learn how Hydra and transient keymaps works, so I made a small version of it called Polyp.
Obviously it is more restricted than the grown up Hydra. I reuse the lv-message mechanism of Hydra to show the hints.
There is a single macro defpolyp, where you specify the name, a possible hint and a list of bindings.
Bindings specify a key, the function name and the type of the binding.
Bindings can either :hide or show the Polyp. For bindings which show the Polyp,
the global keybindings can be specified. The macro defines a function name which enters the Polyp.
Furthermore defpolyp generates a function name/function for each binding.
NOTE: While I have been an Emacs user for quite some time, I wouldn't consider myself well-versed in Elisp. Please feel free to point out mistakes or provide any kind of other feedback!
I am mostly using Hydra (or Polyp) for small modal keybindings, like the polyp-undo shown above.
(defpolyp polyp-buffer
"_←_ buffer _→_"
("<prior>" previous-buffer "C-<next>")
("<next>" next-buffer "C-<prior>"))No hint is shown for polyp-move.
(defpolyp polyp-move
nil ;; No hint!
("n" next-line "C-n")
("p" previous-line "C-p")
("f" forward-char "C-f")
("b" backward-char "C-b")
("N" (forward-line 5) "C-S-n")
("P" (forward-line -5) "C-S-p")
("F" (forward-char 5) "C-S-f")
("B" (backward-char 5) "C-S-b")
("v" scroll-up-command "C-v")
("V" scroll-down-command "C-S-v")
("l" recenter-top-bottom "C-l")
("a" move-beginning-of-line)
("e" move-end-of-line))The window management Polyp polyp-win is entered with C-x w.
(bind-key "C-x w"
(defpolyp polyp-win
"_0123_ _↔↕_:move _C-↔↕_:resize _M-↔↕_:swap"
("0" delete-window)
("1" delete-other-windows)
("2" split-window-below)
("3" split-window-right)
("<left>" windmove-left)
("<down>" windmove-down)
("<up>" windmove-up)
("<right>" windmove-right)
("C-<up>" shrink-window)
("C-<down>" enlarge-window)
("C-<left>" shrink-window-horizontally)
("C-<right>" enlarge-window-horizontally)
("M-<up>" buffer-swap-up)
("M-<down>" buffer-swap-down)
("M-<left>" buffer-swap-left)
("M-<right>" buffer-swap-right)))The vim-like polyp-nav stays alive even if foreign keys are pressed.
An explicit quit head is provided.
(defvar polyp-nav-cursor-color (cdr (assoc 'cursor-color (frame-parameters))))
(bind-key "C-z"
(defpolyp polyp-nav
"_hjkl_ _m_ark _a_nfang _e_nd *d*el *y*ank *q*uit"
:pre (set-cursor-color "green")
:post (set-cursor-color polyp-nav-cursor-color)
:foreign 'ignore
("h" backward-char)
("j" next-line)
("k" previous-line)
("l" forward-char)
("H" (backward-char 5))
("J" (forward-line 5))
("K" (forward-line -5))
("L" (forward-char 5))
("m" set-mark-command)
("a" move-beginning-of-line)
("e" move-end-of-line)
("d" delete-region :hide) ;; Note the :hide!
("y" kill-ring-save :hide)
("q" ignore :hide)))There is support for pre- and post-actions.
(defpolyp polyp-line
"_g_oto _m_ark"
:pre (linum-mode 1)
:post (linum-mode -1)
("g" goto-line "M-g g")
("m" set-mark-command))(defun polyp--set-transient-map (map pred exit)
(let* ((clearfun (make-symbol "polyp--clear-transient-map"))
(pushfun (lambda ()
(add-hook 'pre-command-hook clearfun)
(internal-push-keymap map 'overriding-terminal-local-map)))
(popfun (lambda ()
(internal-pop-keymap map 'overriding-terminal-local-map)
(remove-hook 'pre-command-hook clearfun)))
(actfun (lambda (f)
(funcall popfun)
(if f (unwind-protect (call-interactively f) (funcall pushfun))
(funcall exit)))))
(fset clearfun (lambda ()
(unless (funcall pred)
(funcall popfun)
(funcall exit))))
(funcall pushfun)
actfun))
(defmacro defpolyp (name hint &rest opts)
(let ((opt-map (plist-get opts :map))
(opt-foreign (plist-get opts :foreign))
(opt-pre (plist-get opts :pre))
(opt-post (plist-get opts :post))
(km (intern (format "%s/map" name)))
(act (intern (format "%s/active" name)))
(show nil)
(hide nil)
(rest nil))
;; Apply colors to the hint if there is one.
(when hint
(save-match-data
(while (string-match "\\([_*=]\\)\\([^_*=]+\\)\\1" hint)
(let ((face (pcase-exhaustive (match-string 1 hint)
("_" 'font-lock-function-name-face)
("*" 'font-lock-constant-face)
("=" 'font-lock-warning-face))))
(setq hint (replace-match (propertize (match-string 2 hint) 'face face) t nil hint)))))
(setq show `(lv-message ,hint)
hide '(lv-delete-window)))
(add-face-text-property 0 (length hint) `(:height ,(face-attribute 'mode-line :height)) nil hint)
;; Filter options
(let ((tmp opts))
(while tmp
(if (memq (car tmp) '(:map :pre :post :foreign))
(setq tmp (cddr tmp))
(setq rest (cons (car tmp) rest))
(setq tmp (cdr tmp))))
(setq rest (nreverse rest)))
`(progn
(defvar ,km (copy-keymap universal-argument-map)
,(format "Transient keymap of polyp `%s'." name))
(define-key ,km [switch-frame] nil)
(defvar ,act nil
,(format "Non-nil if polyp `%s' is active." name))
;; The main function of the polyp
(defun ,name ()
,(format "Enter polyp `%s'." name)
(interactive)
(unless ,act
,opt-pre
,show
(setq ,act (polyp--set-transient-map ,km
;; Predicate function of persistent, transient maps.
(lambda ()
(cond
;; Always honor handle-switch-frame/keyboard-quit and exit.
((memq this-command '(handle-switch-frame keyboard-quit)) nil)
;; Key found - keep the transient map alive.
((eq this-command (lookup-key ,km (this-single-command-keys))) t)
;; Foreign key
(t ,@(pcase-exhaustive opt-foreign
(`'run '(t))
(`'ignore '((setq this-command 'ignore) t))
('nil '(nil))))))
;; Exit function of the transient map - hide the polyp.
(lambda ()
(when ,act
(setq ,act nil)
,hide
,opt-post))))))
;; Generate code for the bindings
,@(mapcar
(lambda (bind)
(pcase-exhaustive bind
;; Binding which hides the polyp
(`(,key ,fun :hide)
`(define-key ,km ,(kbd key)
(defun ,(intern (format "%s/%s" name fun)) ()
,(format "Hide polyp `%s' and call `%s'." name fun)
(interactive)
(when ,act (funcall ,act nil))
,(if (symbolp fun)
`(call-interactively ',fun)
fun))))
;; Binding which shows the polyp
(`(,key ,fun . ,keys)
(let* ((id (intern (format "%s/%s" name fun))))
`(progn
;; Generate show function
(defun ,id ()
,(format "Show polyp `%s' and call `%s'." name fun)
(interactive)
(,name)
(funcall ,act ,(if (symbolp fun)
`',fun
`(lambda () (interactive) ,fun))))
;; Add the key to the transient keymap
(define-key ,km ,(kbd key) ',id)
;; Add global bindings to both the global the transient keymap
,@(mapcar (lambda (g) `(progn
(define-key ,km ,(kbd g) ',id)
(bind-key ,g ',id ,opt-map)))
keys))))))
rest)
',name)))