From: Gerd Möllmann Date: Sun, 16 Oct 2022 07:25:01 +0000 (+0200) Subject: Mapatoms differently X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a5f6912c6dea84a72ab8a67886942708aa1be927;p=emacs.git Mapatoms differently Also, assume that in some cases, (intern ":xy") means that old code wants to intern a keyword. --- diff --git a/src/lisp.h b/src/lisp.h index cea15c2cda0..19c266c64ed 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2278,14 +2278,13 @@ extern Lisp_Object pkg_intern_symbol (Lisp_Object sym, Lisp_Object package); extern Lisp_Object pkg_emacs_intern (Lisp_Object name, Lisp_Object package); extern Lisp_Object pkg_emacs_intern_soft (Lisp_Object name, Lisp_Object package); extern Lisp_Object pkg_emacs_unintern (Lisp_Object name, Lisp_Object package); +extern Lisp_Object pkg_emacs_mapatoms (Lisp_Object fn, Lisp_Object package); extern Lisp_Object pkg_intern_non_keyword (Lisp_Object name); extern Lisp_Object pkg_intern_non_keyword_c_string (const char *p, ptrdiff_t len); extern Lisp_Object pkg_lookup_non_keyword_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes); extern Lisp_Object pkg_intern_maybe_keyword (Lisp_Object name); extern void pkg_break (void); extern void pkg_define_builtin_symbols (void); -extern void pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package); -extern void pkg_map_symbols (Lisp_Object function); extern void pkg_map_symbols_c_fn (void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg); extern Lisp_Object Vpackage_registry; diff --git a/src/lread.c b/src/lread.c index a2bafec2917..3dad2650f28 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4785,7 +4785,13 @@ A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. */) (Lisp_Object string, Lisp_Object package) { - eassert (SREF (string, 0) != ':'); + if (SREF (string, 0) == ':' && NILP (package)) + { + /* PKG-FIXME: We are assuming that this is intended to be a + keyword like it was before. */ + string = Fsubstring (string, make_fixnum (1), Qnil); + package = Vkeyword_package; + } return pkg_emacs_intern (string, package); } @@ -4818,8 +4824,7 @@ DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0, OBARRAY defaults to the value of `obarray'. */) (Lisp_Object function, Lisp_Object obarray) { - pkg_map_package_symbols (function, obarray); - return Qnil; + return pkg_emacs_mapatoms (function, obarray); } void diff --git a/src/pkg.c b/src/pkg.c index 2c390d04cd9..9019b698291 100644 --- a/src/pkg.c +++ b/src/pkg.c @@ -747,7 +747,7 @@ pkg_keywordp (Lisp_Object obj) return EQ (SYMBOL_PACKAGE (obj), Vkeyword_package); } -void +static void pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package) { package = check_package (package); @@ -758,7 +758,7 @@ pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package) /* Map FUNCTION over all symbols in PACKAGE. */ -void +static void pkg_map_symbols (Lisp_Object function) { FOR_EACH_KEY_VALUE (it_package, Vpackage_registry) @@ -773,6 +773,16 @@ pkg_map_symbols_c_fn (void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) fn (it_symbol.value, arg); } +Lisp_Object +pkg_emacs_mapatoms (Lisp_Object function, Lisp_Object package) +{ + if (NILP (package)) + pkg_map_symbols (function); + else + pkg_map_package_symbols (function, package); + return Qnil; +} + /*********************************************************************** Lisp functions @@ -1177,19 +1187,18 @@ init_pkg_once (void) DEFSYM (Qpackagep, "packagep"); staticpro (&Vpackage_registry); - /* PKG-FIXME: Not sure about the purecopy (last arg). */ Vpackage_registry = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); - Vemacs_package = make_package (build_pure_c_string ("emacs")); + Vemacs_package = make_package (build_string ("emacs")); staticpro (&Vemacs_package); - Vkeyword_package = make_package (build_pure_c_string ("keyword")); + Vkeyword_package = make_package (build_string ("keyword")); register_package (Vemacs_package); staticpro (&Vkeyword_package); - XPACKAGE (Vkeyword_package)->nicknames = Fcons (build_pure_c_string (""), Qnil); + XPACKAGE (Vkeyword_package)->nicknames = Fcons (build_string (""), Qnil); register_package (Vkeyword_package); staticpro (&Vearmuffs_package);