bug#44529: [PATCH] Convert apropos-internal from C to Lisp

[Stefan Kangas <stefan@marxist.se>]

[-- Attachment #1: Type: text/plain, Size: 301 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> If we autoload it, it will work just as well without having to move it
>> outside of its most natural habitat.
>
> I don't want it to become autoloaded, it could break something.  Why
> risk that?

The attached patch moves it to subr.el instead, as requested.

[-- Attachment #2: 0001-Convert-apropos-internal-from-C-to-Lisp.patch --]
[-- Type: text/x-diff, Size: 5784 bytes --]

From 07ab0d3dcd51be36fcee24b8b7fbe66040ee3d62 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Sun, 8 Nov 2020 21:04:44 +0100
Subject: [PATCH] Convert apropos-internal from C to Lisp

This runs insignificantly faster in C, and is already fast enough on
reasonably modern hardware.  We might as well lift it to Lisp.
This benchmark can be used to verify:

  (benchmark-run 10 (apropos-command "test"))
  => (0.12032415399999999 2 0.014772391999999995) ; C
  => (0.13513192100000002 2 0.017216643000000004) ; Lisp

* lisp/subr.el (apropos-internal): New defun, converted from C.
* src/keymap.c (Fapropos_internal): Remove defun.
(apropos_accum): Remove function.
(apropos_predicate, apropos_accumulate): Remove variables.
(syms_of_keymap): Remove defsubr for Fapropos_internal, and
definitions of the above variables.
* test/src/keymap-tests.el (keymap-apropos-internal)
(keymap-apropos-internal/predicate): Move tests from here...
* test/lisp/subr-tests.el (apropos-apropos-internal)
(apropos-apropos-internal/predicate): ...to here.
---
 lisp/subr.el             | 16 ++++++++++++++++
 src/keymap.c             | 39 ---------------------------------------
 test/lisp/subr-tests.el  | 13 +++++++++++++
 test/src/keymap-tests.el | 10 ----------
 4 files changed, 29 insertions(+), 49 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 6e9f66fe97..de0c49f756 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5786,6 +5786,22 @@ with-mutex
 	   (progn ,@body)
 	 (mutex-unlock ,sym)))))
 
+\f
+;;; Apropos.
+
+(defun apropos-internal (regexp &optional predicate)
+  "Show all symbols whose names contain match for REGEXP.
+If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
+for each symbol and a symbol is mentioned only if that returns non-nil.
+Return list of symbols found."
+  (let (found)
+    (mapatoms (lambda (symbol)
+                (when (and (string-match regexp (symbol-name symbol))
+                           (or (not predicate)
+                               (funcall predicate symbol)))
+                  (push symbol found))))
+    (sort found #'string-lessp)))
+
 \f
 ;;; Misc.
 
diff --git a/src/keymap.c b/src/keymap.c
index 181dcdad3a..c75460f9c3 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3223,49 +3223,11 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
     }
 }
 \f
-/* Apropos - finding all symbols whose names match a regexp.		*/
-static Lisp_Object apropos_predicate;
-static Lisp_Object apropos_accumulate;
-
-static void
-apropos_accum (Lisp_Object symbol, Lisp_Object string)
-{
-  register Lisp_Object tem;
-
-  tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
-  if (!NILP (tem) && !NILP (apropos_predicate))
-    tem = call1 (apropos_predicate, symbol);
-  if (!NILP (tem))
-    apropos_accumulate = Fcons (symbol, apropos_accumulate);
-}
-
-DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
-       doc: /* Show all symbols whose names contain match for REGEXP.
-If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
-for each symbol and a symbol is mentioned only if that returns non-nil.
-Return list of symbols found.  */)
-  (Lisp_Object regexp, Lisp_Object predicate)
-{
-  Lisp_Object tem;
-  CHECK_STRING (regexp);
-  apropos_predicate = predicate;
-  apropos_accumulate = Qnil;
-  map_obarray (Vobarray, apropos_accum, regexp);
-  tem = Fsort (apropos_accumulate, Qstring_lessp);
-  apropos_accumulate = Qnil;
-  apropos_predicate = Qnil;
-  return tem;
-}
-\f
 void
 syms_of_keymap (void)
 {
   DEFSYM (Qkeymap, "keymap");
   DEFSYM (Qdescribe_map_tree, "describe-map-tree");
-  staticpro (&apropos_predicate);
-  staticpro (&apropos_accumulate);
-  apropos_predicate = Qnil;
-  apropos_accumulate = Qnil;
 
   DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize");
 
@@ -3409,7 +3371,6 @@ syms_of_keymap (void)
   defsubr (&Stext_char_description);
   defsubr (&Swhere_is_internal);
   defsubr (&Sdescribe_buffer_bindings);
-  defsubr (&Sapropos_internal);
 }
 
 void
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 035c064d75..0f883ef6a7 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -484,5 +484,18 @@ string-replace
 
   (should-error (string-replace "" "x" "abc")))
 
+\f
+;;; Apropos.
+
+(ert-deftest apropos-apropos-internal ()
+  (should (equal (apropos-internal "^next-line$") '(next-line)))
+  (should (>= (length (apropos-internal "^help")) 100))
+  (should-not (apropos-internal "^test-a-missing-symbol-foo-bar-zot$")))
+
+(ert-deftest apropos-apropos-internal/predicate ()
+  (should (equal (apropos-internal "^next-line$" #'commandp) '(next-line)))
+  (should (>= (length (apropos-internal "^help" #'commandp)) 15))
+  (should-not (apropos-internal "^next-line$" #'keymapp)))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 610234c5a1..900ade7f48 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -200,16 +200,6 @@ keymap-where-is-internal/preferred-modifier-is-a-string
             (where-is-internal 'execute-extended-command global-map t))
           [#x8000078])))
 
-(ert-deftest keymap-apropos-internal ()
-  (should (equal (apropos-internal "^next-line$") '(next-line)))
-  (should (>= (length (apropos-internal "^help")) 100))
-  (should-not (apropos-internal "^test-a-missing-symbol-foo-bar-zut$")))
-
-(ert-deftest keymap-apropos-internal/predicate ()
-  (should (equal (apropos-internal "^next-line$" #'commandp) '(next-line)))
-  (should (>= (length (apropos-internal "^help" #'commandp)) 15))
-  (should-not (apropos-internal "^next-line$" #'keymapp)))
-
 (provide 'keymap-tests)
 
 ;;; keymap-tests.el ends here
-- 
2.29.2