From: Lars Ingebrigtsen Date: Mon, 4 Oct 2021 08:12:11 +0000 (+0200) Subject: Add 'define-keymap' and 'defvar-keymap' X-Git-Tag: emacs-29.0.90~3671^2~681 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=192f9357f25b5b714984e5f60df2eba9dcac4120;p=emacs.git Add 'define-keymap' and 'defvar-keymap' * doc/lispref/keymaps.texi (Changing Key Bindings): Document define-keymap and defvar-keymap. * lisp/subr.el (define-keymap): New function. (define-keymap--define): New function. (defvar-keymap): New macro. * lisp/emacs-lisp/lisp-mode.el (lisp-indent--defvar-keymap): New function. (lisp-indent-function): Use it to indent defvar-keymap. --- diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 4097c86f074..1ca4857450a 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1386,6 +1386,101 @@ changing an entry in @code{ctl-x-map}, and this has the effect of changing the bindings of both @kbd{C-p C-f} and @kbd{C-x C-f} in the default global map. +@defun define-keymap &key options... &rest pairs... +@code{define-key} is the general work horse for defining a key in a +keymap. When writing modes, however, you frequently have to bind a +large number of keys at once, and using @code{define-key} on them all +can be tedious and error-prone. Instead you can use +@code{define-keymap}, which creates a keymaps and binds a number of +keys. Here's a very basic example: + +@lisp +(define-keymap + "n" #'forward-line + "f" #'previous-line) +@end lisp + +This function creates a new sparse keymap, defines the two keystrokes +in @var{pairs}, and returns the new keymap. + +@var{pairs} is a list of alternating key bindings and key definitions, +as accepted by @code{define-key}. In addition the key can be the +special symbol @code{:menu}, in which case the definition should be a +menu definition as accepted by @code{easy-menu-define} (@pxref{Easy +Menu}). Here's a brief example: + +@lisp +(define-keymap :full t + "g" #'eww-reload + :menu '("Eww" + ["Exit" quit-window t] + ["Reload" eww-reload t])) +@end lisp + +A number of keywords can be used before the key/definition pairs to +changes features of the new keymap. If the keyword is missing, the +default value for the feature is @code{nil}. Here's a list of the +available keywords: + +@table @code +@item :full +If non-@code{nil}, create a chartable keymap (as from +@code{make-keymap}) instead of a sparse keymap (as from +@code{make-sparse-keymap} (@pxref{Creating Keymaps}). A sparse keymap +is the default. + +@item :parent +If non-@code{nil}, this should be a keymap to use as the parent +(@pxref{Inheritance and Keymaps}). + +@item :keymap +If non-@code{nil}, this should be a keymap. Instead of creating a new +keymap, this keymap is modified instead. + +@item :suppress +If non-@code{nil}, the keymap will be suppressed with +@code{suppress-keymap} (@pxref{Changing Key Bindings}). If +@code{nodigits}, treat digits like other chars. + +@item :copy +If non-@code{nil}, copy this keymap and use it as the basis +(@pxref{Creating Keymaps}). + +@item :name +If non-@code{nil}, this should be a string to use as the menu for the +keymap if you use it as a menu with @code{x-popup-menu} (@pxref{Pop-Up +Menus}). + +@item :prefix +If non-@code{nil}, this should be a symbol to be used as a prefix +command (@pxref{Prefix Keys}). If this is the case, this symbol is +returned by @code{define-keymap} instead of the map itself. +@end table + +@end defun + +@defmac defvar-keymap name options &rest defs +By far, the most common thing to do with a keymap is to bind it to a +variable. This is what virtually all modes do---a mode called +@code{foo} almost always has a variable called @code{foo-mode-map}. + +This macro defines @var{name} as a variable, and passes @var{options} +and @var{defs} to @code{define-keymap}, and uses the result as the +default value for the variable. + +@var{options} is like the keywords in @code{define-keymap}, but adds a +@code{:doc} keyword that says what the doc string for the @var{name} +variable should be. + +Here's an example: + +@lisp +(defvar-keymap eww-textarea-map (:parent text-mode-map) + "\r" #'forward-line + [?\t] #'shr-next-link) +@end lisp +@end defmac + The function @code{substitute-key-definition} scans a keymap for keys that have a certain binding and rebinds them with a different binding. Another feature which is cleaner and can often produce the diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 57196dfec49..a465d189b7a 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1162,6 +1162,18 @@ STATE is the `parse-partial-sexp' state for current position." (goto-char (scan-lists (point) -1 0)) (point))))))))))) +(defun lisp-indent--defvar-keymap (state) + "Return the indent position in the options part of a `defvar-keymap' form." + (save-excursion + (let ((parens (ppss-open-parens state))) + (and (equal (nth 1 parens) (ppss-innermost-start state)) + (progn + (goto-char (nth 0 parens)) + (looking-at-p "(defvar-keymap")) + (progn + (goto-char (ppss-innermost-start state)) + (1+ (current-column))))))) + (defun lisp-indent-function (indent-point state) "This function is the normal value of the variable `lisp-indent-function'. The function `calculate-lisp-indent' calls this to determine @@ -1195,10 +1207,12 @@ Lisp function does not specify a special indentation." (if (and (elt state 2) (not (looking-at "\\sw\\|\\s_"))) ;; car of form doesn't seem to be a symbol - (if (lisp--local-defform-body-p state) - ;; We nevertheless check whether we are in flet-like form - ;; as we presume local function names could be non-symbols. - (lisp-indent-defform state indent-point) + (cond + ((lisp--local-defform-body-p state) + ;; We nevertheless check whether we are in flet-like form + ;; as we presume local function names could be non-symbols. + (lisp-indent-defform state indent-point)) + (t (if (not (> (save-excursion (forward-line 1) (point)) calculate-lisp-indent-last-sexp)) (progn (goto-char calculate-lisp-indent-last-sexp) @@ -1210,25 +1224,28 @@ Lisp function does not specify a special indentation." ;; thing on that line has to be complete sexp since we are ;; inside the innermost containing sexp. (backward-prefix-chars) - (current-column)) - (let ((function (buffer-substring (point) - (progn (forward-sexp 1) (point)))) - method) - (setq method (or (function-get (intern-soft function) - 'lisp-indent-function) - (get (intern-soft function) 'lisp-indent-hook))) - (cond ((or (eq method 'defun) - (and (null method) - (> (length function) 3) - (string-match "\\`def" function)) - ;; Check whether we are in flet-like form. - (lisp--local-defform-body-p state)) - (lisp-indent-defform state indent-point)) - ((integerp method) - (lisp-indent-specform method state - indent-point normal-indent)) - (method - (funcall method indent-point state))))))) + (current-column))) + ;; Indent `defvar-keymap' arguments. + (or (lisp-indent--defvar-keymap state) + ;; Other forms. + (let ((function (buffer-substring (point) + (progn (forward-sexp 1) (point)))) + method) + (setq method (or (function-get (intern-soft function) + 'lisp-indent-function) + (get (intern-soft function) 'lisp-indent-hook))) + (cond ((or (eq method 'defun) + (and (null method) + (> (length function) 3) + (string-match "\\`def" function)) + ;; Check whether we are in flet-like form. + (lisp--local-defform-body-p state)) + (lisp-indent-defform state indent-point)) + ((integerp method) + (lisp-indent-specform method state + indent-point normal-indent)) + (method + (funcall method indent-point state)))))))) (defcustom lisp-body-indent 2 "Number of columns to indent the second line of a `(def...)' form." diff --git a/lisp/subr.el b/lisp/subr.el index 1d2980802e0..18b0851b1d8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6458,4 +6458,119 @@ not a list, return a one-element list containing OBJECT." object (list object))) +(defun define-keymap (&rest definitions) + "Create a new keymap and define KEY/DEFEFINITION pairs as key sequences. +The new keymap is returned. + +Options can be given as keywords before the KEY/DEFEFINITION +pairs. Available keywords are: + +:full If non-nil, create a chartable alist (see `make-keymap'). + If nil (i.e., the default), create a sparse keymap (see + `make-sparse-keymap'). + +:suppress If non-nil, the keymap will be suppressed (see `suppress-keymap'). + If `nodigits', treat digits like other chars. + +:parent If non-nil, this should be a keymap to use as the parent + (see `set-keymap-parent'). + +:keymap If non-nil, instead of creating a new keymap, the given keymap + will be destructively modified instead. + +:copy If non-nil, copy this keymap and use it as the basis + (see `copy-keymap'). + +:name If non-nil, this should be a string to use as the menu for + the keymap in case you use it as a menu with `x-popup-menu'. + +:prefix If non-nil, this should be a symbol to be used as a prefix + command (see `define-prefix-command'). If this is the case, + this symbol is returned instead of the map itself. + +KEY/DEFINITION pairs are as KEY and DEF in `define-key'. KEY can +also be the special symbol `:menu', in which case DEFINITION +should be a MENU form as accepted by `easy-menu-define'. + +\n(fn [&key FULL PARENT SUPPRESS NAME PREFIX KEYMAP COPY] [KEY DEFINITION] ...)" + ;; Handle keywords. + (let ((options nil)) + (while (and definitions + (keywordp (car definitions))) + (let ((keyword (pop definitions))) + (unless definitions + (error "Missing keyword value for %s" keyword)) + (push keyword options) + (push (pop definitions) options))) + (define-keymap--define (nreverse options) definitions))) + +(defun define-keymap--define (options definitions) + (let (full suppress parent name prefix copy keymap) + (while options + (let ((keyword (pop options)) + (value (pop options))) + (pcase keyword + (:full (setq full value)) + (:keymap (setq keymap value)) + (:parent (setq parent value)) + (:copy (setq copy value)) + (:suppress (setq suppress value)) + (:name (setq name value)) + (:prefix (setq prefix value))))) + + (when (and prefix + (or full parent suppress keymap)) + (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords")) + + (when (and full copy) + (error "Invalid combination: :full/:copy")) + + (when (and keymap (or full copy)) + (error "Invalid combination: :keymap with :full/:copy")) + + (let ((keymap (cond + (keymap keymap) + (prefix (define-prefix-command prefix nil name)) + (copy (copy-keymap copy)) + (full (make-keymap name)) + (t (make-sparse-keymap name))))) + (when suppress + (suppress-keymap keymap (eq suppress 'nodigits))) + (when parent + (set-keymap-parent keymap parent)) + + ;; Do the bindings. + (while definitions + (let ((key (pop definitions))) + (unless definitions + (error "Uneven number of key/definition pairs")) + (let ((def (pop definitions))) + (if (eq key :menu) + (easy-menu-define nil keymap "" def) + (define-key keymap key def))))) + keymap))) + +(defmacro defvar-keymap (name options &rest defs) + "Define NAME as a variable with a keymap definition. +See `define-keymap' for an explanation of OPTIONS. In addition, +the :doc keyword can be used in OPTIONS to add a doc string to NAME. + +DEFS is passed to `define-keymap' and should be a plist of +key/definition pairs." + (let ((opts nil) + doc) + (while options + (let ((keyword (pop options))) + (unless options + (error "Uneven number of options")) + (if (eq keyword :doc) + (setq doc (pop options)) + (push keyword opts) + (push (pop options) opts)))) + (unless (zerop (% (length defs) 2)) + (error "Uneven number of key definitions: %s" defs)) + `(defvar ,name + (define-keymap--define (list ,@(nreverse opts)) (list ,@defs)) + ,@(and doc (list doc))))) + ;;; subr.el ends here diff --git a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts index 69d2598bb14..70642e230cb 100644 --- a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts +++ b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts @@ -48,3 +48,11 @@ Name: defun-space (print (quote (thingy great stuff)))) =-=-= + +Name: defvar-keymap + +=-= +(defvar-keymap eww-link-keymap (:copy shr-map + :foo bar) + "\r" #'eww-follow-link) +=-=-=