master 192f935 1/3: Add 'define-keymap' and 'defvar-keymap'

[Lars Ingebrigtsen]

branch: master
commit 192f9357f25b5b714984e5f60df2eba9dcac4120
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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.
---
 doc/lispref/keymaps.texi                           |  95 +++++++++++++++++
 lisp/emacs-lisp/lisp-mode.el                       |  63 ++++++-----
 lisp/subr.el                                       | 115 +++++++++++++++++++++
 .../elisp-mode-resources/elisp-indents.erts        |   8 ++
 4 files changed, 258 insertions(+), 23 deletions(-)

diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 4097c86..1ca4857 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 57196df..a465d18 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 1d298080..18b0851 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 69d2598..70642e2 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)
+=-=-=