master 7ddfe1cab2: Move define-keymap and defvar-keymap to keymap.el

[Stefan Kangas]

branch: master
commit 7ddfe1cab2156db4cb1da1968e6d6dabb533ff33
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    Move define-keymap and defvar-keymap to keymap.el
    
    These functions deal with the "new" keymap binding interface, so they
    belong in keymap.el rather than in subr.el.
    * lisp/subr.el (define-keymap--compile, define-keymap)
    (defvar-keymap): Move from here ...
    * lisp/keymap.el (define-keymap--compile, define-keymap)
    (defvar-keymap): ... to here.
---
 lisp/keymap.el | 133 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/subr.el   | 130 -------------------------------------------------------
 2 files changed, 133 insertions(+), 130 deletions(-)

diff --git a/lisp/keymap.el b/lisp/keymap.el
index a60efe18e1..6feb91a60b 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -452,6 +452,139 @@ If MESSAGE (and interactively), message the result."
       (message "%s is bound to %s globally" keys def))
     def))
 
+
+;;; define-keymap and defvar-keymap
+
+(defun define-keymap--compile (form &rest args)
+  ;; This compiler macro is only there for compile-time
+  ;; error-checking; it does not change the call in any way.
+  (while (and args
+              (keywordp (car args))
+              (not (eq (car args) :menu)))
+    (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix))
+      (byte-compile-warn "Invalid keyword: %s" (car args)))
+    (setq args (cdr args))
+    (when (null args)
+      (byte-compile-warn "Uneven number of keywords in %S" form))
+    (setq args (cdr args)))
+  ;; Bindings.
+  (while args
+    (let ((key (pop args)))
+      (when (and (stringp key) (not (key-valid-p key)))
+        (byte-compile-warn "Invalid `kbd' syntax: %S" key)))
+    (when (null args)
+      (byte-compile-warn "Uneven number of key bindings in %S" form))
+    (setq args (cdr args)))
+  form)
+
+(defun define-keymap (&rest definitions)
+  "Create a new keymap and define KEY/DEFINITION pairs as key bindings.
+The new keymap is returned.
+
+Options can be given as keywords before the KEY/DEFINITION
+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.
+
+: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 `keymap-set'.  KEY can
+also be the special symbol `:menu', in which case DEFINITION
+should be a MENU form as accepted by `easy-menu-define'.
+
+\(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)"
+  (declare (indent defun)
+           (compiler-macro define-keymap--compile))
+  (let (full suppress parent name prefix keymap)
+    ;; Handle keywords.
+    (while (and definitions
+                (keywordp (car definitions))
+                (not (eq (car definitions) :menu)))
+      (let ((keyword (pop definitions)))
+        (unless definitions
+          (error "Missing keyword value for %s" keyword))
+        (let ((value (pop definitions)))
+          (pcase keyword
+            (:full (setq full value))
+            (:keymap (setq keymap value))
+            (:parent (setq parent value))
+            (:suppress (setq suppress value))
+            (:name (setq name value))
+            (:prefix (setq prefix value))
+            (_ (error "Invalid keyword: %s" keyword))))))
+
+    (when (and prefix
+               (or full parent suppress keymap))
+      (error "A prefix keymap can't be defined with 
:full/:parent/:suppress/:keymap keywords"))
+
+    (when (and keymap full)
+      (error "Invalid combination: :keymap with :full"))
+
+    (let ((keymap (cond
+                   (keymap keymap)
+                   (prefix (define-prefix-command prefix nil name))
+                   (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)
+              (keymap-set keymap key def)))))
+      keymap)))
+
+(defmacro defvar-keymap (variable-name &rest defs)
+  "Define VARIABLE-NAME as a variable with a keymap definition.
+See `define-keymap' for an explanation of the keywords and KEY/DEFINITION.
+
+In addition to the keywords accepted by `define-keymap', this
+macro also accepts a `:doc' keyword, which (if present) is used
+as the variable documentation string.
+
+\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY 
DEFINITION]...)"
+  (declare (indent 1))
+  (let ((opts nil)
+        doc)
+    (while (and defs
+                (keywordp (car defs))
+                (not (eq (car defs) :menu)))
+      (let ((keyword (pop defs)))
+        (unless defs
+          (error "Uneven number of keywords"))
+        (if (eq keyword :doc)
+            (setq doc (pop defs))
+          (push keyword opts)
+          (push (pop defs) opts))))
+    (unless (zerop (% (length defs) 2))
+      (error "Uneven number of key/definition pairs: %s" defs))
+    `(defvar ,variable-name
+       (define-keymap ,@(nreverse opts) ,@defs)
+       ,@(and doc (list doc)))))
+
 (provide 'keymap)
 
 ;;; keymap.el ends here
diff --git a/lisp/subr.el b/lisp/subr.el
index 11105c4aa6..7906324f80 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6526,136 +6526,6 @@ not a list, return a one-element list containing 
OBJECT."
       object
     (list object)))
 
-(defun define-keymap--compile (form &rest args)
-  ;; This compiler macro is only there for compile-time
-  ;; error-checking; it does not change the call in any way.
-  (while (and args
-              (keywordp (car args))
-              (not (eq (car args) :menu)))
-    (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix))
-      (byte-compile-warn "Invalid keyword: %s" (car args)))
-    (setq args (cdr args))
-    (when (null args)
-      (byte-compile-warn "Uneven number of keywords in %S" form))
-    (setq args (cdr args)))
-  ;; Bindings.
-  (while args
-    (let ((key (pop args)))
-      (when (and (stringp key) (not (key-valid-p key)))
-        (byte-compile-warn "Invalid `kbd' syntax: %S" key)))
-    (when (null args)
-      (byte-compile-warn "Uneven number of key bindings in %S" form))
-    (setq args (cdr args)))
-  form)
-
-(defun define-keymap (&rest definitions)
-  "Create a new keymap and define KEY/DEFINITION pairs as key bindings.
-The new keymap is returned.
-
-Options can be given as keywords before the KEY/DEFINITION
-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.
-
-: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 `keymap-set'.  KEY can
-also be the special symbol `:menu', in which case DEFINITION
-should be a MENU form as accepted by `easy-menu-define'.
-
-\(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)"
-  (declare (indent defun)
-           (compiler-macro define-keymap--compile))
-  (let (full suppress parent name prefix keymap)
-    ;; Handle keywords.
-    (while (and definitions
-                (keywordp (car definitions))
-                (not (eq (car definitions) :menu)))
-      (let ((keyword (pop definitions)))
-        (unless definitions
-          (error "Missing keyword value for %s" keyword))
-        (let ((value (pop definitions)))
-          (pcase keyword
-            (:full (setq full value))
-            (:keymap (setq keymap value))
-            (:parent (setq parent value))
-            (:suppress (setq suppress value))
-            (:name (setq name value))
-            (:prefix (setq prefix value))
-            (_ (error "Invalid keyword: %s" keyword))))))
-
-    (when (and prefix
-               (or full parent suppress keymap))
-      (error "A prefix keymap can't be defined with 
:full/:parent/:suppress/:keymap keywords"))
-
-    (when (and keymap full)
-      (error "Invalid combination: :keymap with :full"))
-
-    (let ((keymap (cond
-                   (keymap keymap)
-                   (prefix (define-prefix-command prefix nil name))
-                   (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)
-              (keymap-set keymap key def)))))
-      keymap)))
-
-(defmacro defvar-keymap (variable-name &rest defs)
-  "Define VARIABLE-NAME as a variable with a keymap definition.
-See `define-keymap' for an explanation of the keywords and KEY/DEFINITION.
-
-In addition to the keywords accepted by `define-keymap', this
-macro also accepts a `:doc' keyword, which (if present) is used
-as the variable documentation string.
-
-\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY 
DEFINITION]...)"
-  (declare (indent 1))
-  (let ((opts nil)
-        doc)
-    (while (and defs
-                (keywordp (car defs))
-                (not (eq (car defs) :menu)))
-      (let ((keyword (pop defs)))
-        (unless defs
-          (error "Uneven number of keywords"))
-        (if (eq keyword :doc)
-            (setq doc (pop defs))
-          (push keyword opts)
-          (push (pop defs) opts))))
-    (unless (zerop (% (length defs) 2))
-      (error "Uneven number of key/definition pairs: %s" defs))
-    `(defvar ,variable-name
-       (define-keymap ,@(nreverse opts) ,@defs)
-       ,@(and doc (list doc)))))
-
 (defmacro with-delayed-message (args &rest body)
   "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds.
 The MESSAGE form will be evaluated immediately, but the resulting