define-repeat-map.el/define-repeat-map.el

134 lines
4.7 KiB
EmacsLisp

;;; define-repeat-map.el --- Easy-define repeat-maps -*- lexical-binding: t -*-
;; Copyright (C) 2021 Case Duckworth
;; Author: Case Duckworth <acdw@acdw.net>
;; Keywords: convenience
;; URL:
;;; License:
;; Everyone is permitted to do whatever with this software, without
;; limitation. This software comes without any warranty whatsoever,
;; but with two pieces of advice:
;; - Don't hurt yourself.
;; - Make good choices.
;;; Commentary:
;; Emacs 28 comes built-in with repeat.el (which see), which allows users to
;; define their own maps to repeat common commands easily. This package
;; attempts to make the definition of those maps a one-sexp affair, through the
;; macro `define-repeat-map'. See its docstring for details.
;;; Code:
(defun define-repeat-map--make-alias (cmd map)
"Internal. Make an alias for CMD in repeat-map MAP."
(intern (concat (symbol-name cmd) "|"
(symbol-name map))))
(defun define-repeat-map--map-commands (map fn args)
"Internal. Map FN over ARGS, whch are commands in MAP."
(let (res)
(dolist (arg args)
(unless (stringp arg)
(push (funcall fn arg) res)))
(reverse res)))
(defun define-repeat-map--define-keys (map fn args)
"Internal. Map `define-key' over ARGS, transorming them with FN."
(unless (zerop (mod (length args) 2))
(error "Wrong number of args"))
(let (res)
(while args
(let ((key (pop args))
(cmd (funcall fn (pop args))))
(push `(define-key ,map (kbd ,key) #',cmd)
res)))
(reverse res)))
;;;###autoload
(defmacro define-repeat-map (name &rest args)
"Define a repeat-map, NAME-repeat-map, and bind keys to it.
Each ARG is a list of lists containing keybind definitions of
the form (KEY DEFINITION) KEY is anything `kbd' can recognize,
and DEFINITION is passed directly to `define-key'.
Optionally, the car of an arglist can contain the following
symbols, which changes the behavior of the key definitions in the
rest of the list:
:enter - Provided commands can enter the repeat-map, but aren't
bound in the map. They need to be bound elsewhere, however.
:exit - Keys are bound in the repeat-map, but can't enter the
map. Their invocation exits the repeat-map.
:continue - Keys are bound in the repeat-map, but can't enter the
map. However, their invocations keep the repeat-map active."
(declare (indent 1))
(let ((define-repeat-map--result)
(map (intern (concat (symbol-name name) "-repeat-map"))))
;; Create the keymap
(push `(defvar ,map (make-sparse-keymap)
"Defined by `define-repeat-map'.")
define-repeat-map--result)
;; Iterate through ARGS
(dolist (arg args)
(pcase (car arg)
(:enter
;; Add the map to the commands' repeat-map property.
(push `(progn
,@(define-repeat-map--map-commands
`,map
(lambda (cmd) `(put ',cmd 'repeat-map ',map))
(cdr arg)))
define-repeat-map--result))
(:exit
;; Bind the commands in the map.
(push `(progn
,@(define-repeat-map--define-keys
`,map #'identity (cdr arg)))
define-repeat-map--result))
(:continue
;; Make an alias for each command, and process that alias like the
;; default, below.
(push `(progn
,@(define-repeat-map--define-keys
`,map
(lambda (cmd) (define-repeat-map--make-alias cmd map))
(cdr arg))
,@(define-repeat-map--map-commands
`,map
(lambda (cmd)
(let ((alias (define-repeat-map--make-alias cmd map)))
`(progn
(defalias ',alias ',cmd
"Defined by `define-repeat-map'.")
(put ',alias
'repeat-map ',map))))
(cdr arg)))
define-repeat-map--result))
(_
;; Default: bind the commands in the map, and add the map to the
;; commands' repeat-map property.
(push `(progn
,@(define-repeat-map--define-keys `,map #'identity arg)
,@(define-repeat-map--map-commands
`,map
(lambda (cmd) `(put ',cmd 'repeat-map ',map))
arg))
define-repeat-map--result))))
`(add-hook 'repeat-mode-hook
(lambda nil
,@(reverse define-repeat-map--result)))))
(provide 'define-repeat-map)
;;; define-repeat-map.el ends here