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: https://tildegit.org/acdw/define-repeat-map.el/
;;; 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 (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' in MAP 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 keys)
"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 KEYS
(dolist (arg keys)
(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