pkg a5f6912c6d 30/76: Mapatoms differently

[Gerd Moellmann]

branch: pkg
commit a5f6912c6dea84a72ab8a67886942708aa1be927
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    Mapatoms differently
    
    Also, assume that in some cases, (intern ":xy") means that old code
    wants to intern a keyword.
---
 src/lisp.h  |  3 +--
 src/lread.c | 11 ++++++++---
 src/pkg.c   | 21 +++++++++++++++------
 3 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/src/lisp.h b/src/lisp.h
index cea15c2cda..19c266c64e 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 a2bafec291..3dad2650f2 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 2c390d04cd..9019b69829 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);