mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-28 07:45:00 +00:00
Convert apropos-internal from C to Lisp (Bug#44529)
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.
This commit is contained in:
parent
34a73666d9
commit
7c3d3b8335
16
lisp/subr.el
16
lisp/subr.el
@ -5845,6 +5845,22 @@ This is the simplest safe way to acquire and release a mutex."
|
||||
(progn ,@body)
|
||||
(mutex-unlock ,sym)))))
|
||||
|
||||
|
||||
;;; 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)))
|
||||
|
||||
|
||||
;;; Misc.
|
||||
|
||||
|
39
src/keymap.c
39
src/keymap.c
@ -3243,49 +3243,11 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
|
||||
}
|
||||
}
|
||||
|
||||
/* 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;
|
||||
}
|
||||
|
||||
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");
|
||||
|
||||
@ -3429,7 +3391,6 @@ be preferred. */);
|
||||
defsubr (&Stext_char_description);
|
||||
defsubr (&Swhere_is_internal);
|
||||
defsubr (&Sdescribe_buffer_bindings);
|
||||
defsubr (&Sapropos_internal);
|
||||
}
|
||||
|
||||
void
|
||||
|
@ -597,6 +597,18 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
|
||||
(undo-boundary)
|
||||
(undo)
|
||||
(should (equal (buffer-string) ""))))
|
||||
|
||||
;;; 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
|
||||
|
@ -248,19 +248,6 @@ g .. h foo
|
||||
0 .. 3 foo
|
||||
")))))
|
||||
|
||||
|
||||
;;;; apropos-internal
|
||||
|
||||
(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
|
||||
|
Loading…
Reference in New Issue
Block a user