master 5ac7b48: Lift define-prefix-command to Lisp

[Stefan Kangas]

branch: master
commit 5ac7b480757d8731fe2bda0452e48f0cd0356aa4
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    Lift define-prefix-command to Lisp
    
    * lisp/subr.el (define-prefix-command): New defun.
    * src/keymap.c (Fdefine_prefix_command): Remove DEFUN.
    (syms_of_keymap): Remove defsubr for Fdefine_prefix_command.
    * test/lisp/subr-tests.el (subr-test-define-prefix-command): New
    test.
---
 lisp/subr.el            | 16 ++++++++++++++++
 src/keymap.c            | 23 -----------------------
 test/lisp/subr-tests.el | 11 +++++++++++
 3 files changed, 27 insertions(+), 23 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 11aabfe..b92744c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -995,6 +995,22 @@ a menu, so this function is not useful for non-menu 
keymaps."
            (setq inserted t)))
       (setq tail (cdr tail)))))
 
+(defun define-prefix-command (command &optional mapvar name)
+  "Define COMMAND as a prefix command.  COMMAND should be a symbol.
+A new sparse keymap is stored as COMMAND's function definition and its
+value.
+This prepares COMMAND for use as a prefix key's binding.
+If a second optional argument MAPVAR is given, it should be a symbol.
+The map is then stored as MAPVAR's value instead of as COMMAND's
+value; but COMMAND is still defined as a function.
+The third optional argument NAME, if given, supplies a menu name
+string for the map.  This is required to use the keymap as a menu.
+This function returns COMMAND."
+  (let ((map (make-sparse-keymap name)))
+    (fset command map)
+    (set (or mapvar command) map)
+    command))
+
 (defun map-keymap-sorted (function keymap)
   "Implement `map-keymap' with sorting.
 Don't call this function; it is for internal use only."
diff --git a/src/keymap.c b/src/keymap.c
index 3d19938..1197f6f 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1712,28 +1712,6 @@ bindings; see the description of `lookup-key' for more 
details about this.  */)
   return Flist (j, maps);
 }
 
-DEFUN ("define-prefix-command", Fdefine_prefix_command, 
Sdefine_prefix_command, 1, 3, 0,
-       doc: /* Define COMMAND as a prefix command.  COMMAND should be a symbol.
-A new sparse keymap is stored as COMMAND's function definition and its
-value.
-This prepares COMMAND for use as a prefix key's binding.
-If a second optional argument MAPVAR is given, it should be a symbol.
-The map is then stored as MAPVAR's value instead of as COMMAND's
-value; but COMMAND is still defined as a function.
-The third optional argument NAME, if given, supplies a menu name
-string for the map.  This is required to use the keymap as a menu.
-This function returns COMMAND.  */)
-  (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
-{
-  Lisp_Object map = Fmake_sparse_keymap (name);
-  Ffset (command, map);
-  if (!NILP (mapvar))
-    Fset (mapvar, map);
-  else
-    Fset (command, map);
-  return command;
-}
-
 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
        doc: /* Select KEYMAP as the global keymap.  */)
   (Lisp_Object keymap)
@@ -3280,7 +3258,6 @@ be preferred.  */);
   defsubr (&Sminor_mode_key_binding);
   defsubr (&Sdefine_key);
   defsubr (&Slookup_key);
-  defsubr (&Sdefine_prefix_command);
   defsubr (&Suse_global_map);
   defsubr (&Suse_local_map);
   defsubr (&Scurrent_local_map);
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 54f6eb4..83031c4 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -70,6 +70,17 @@
   (should (equal (kbd "RET") "\C-m"))
   (should (equal (kbd "C-x a") "\C-xa")))
 
+(ert-deftest subr-test-define-prefix-command ()
+  (define-prefix-command 'foo-prefix-map)
+  (should (keymapp foo-prefix-map))
+  (should (fboundp #'foo-prefix-map))
+  ;; With optional argument.
+  (define-prefix-command 'bar-prefix 'bar-prefix-map)
+  (should (keymapp bar-prefix-map))
+  (should (fboundp #'bar-prefix))
+  ;; Returns the symbol.
+  (should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
+
 
 ;;;; Mode hooks.