pkg 8615f5b048 15/76: Can now pdumg withput warnings from cl-defstruct

[Gerd Moellmann]

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

    Can now pdumg withput warnings from cl-defstruct
---
 lisp/emacs-lisp/bytecomp.el |  1 +
 src/emacs.c                 |  4 +++
 src/pkg.c                   | 20 +++++++++++---
 src/print.c                 | 64 +++++++++++++++++----------------------------
 4 files changed, 46 insertions(+), 43 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 03c45e44a5..f0e72a6e20 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2162,6 +2162,7 @@ See also `emacs-lisp-byte-compile-and-load'."
       ;; Don't inherit lexical-binding from caller (bug#12938).
       (unless (local-variable-p 'lexical-binding)
         (setq-local lexical-binding nil))
+      ;; PKG-FIXME: Maybe set package-prefixes?
       ;; Set the default directory, in case an eval-when-compile uses it.
       (setq default-directory (file-name-directory filename)))
     ;; Check if the file's local variables explicitly specify not to
diff --git a/src/emacs.c b/src/emacs.c
index 772e283c3e..b93a837f4c 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2422,6 +2422,10 @@ Using an Emacs configured with --with-x-toolkit=lucid 
does not have this problem
 #endif
     }
 
+  /* PKG-FIXME: maybe we should make package_system_ready persistent
+     in the dump?  */
+  init_pkg ();
+
 #ifdef HAVE_HAIKU
   init_haiku_select ();
 #endif
diff --git a/src/pkg.c b/src/pkg.c
index 0b98b3801d..0d333a2bc1 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -607,7 +607,14 @@ pkg_emacs_intern (Lisp_Object name, Lisp_Object package)
 {
   eassert (package_system_ready);
   CHECK_STRING (name);
-  return pkg_intern_symbol (name, Vearmuffs_package);
+
+  /* This is presumable an obarray, and we are intending
+     to intern into the default pacakge.  */
+  if (VECTORP (package))
+    package = Vearmuffs_package;
+  package = package_or_default (package);
+
+  return pkg_intern_symbol (name, package);
 }
 
 /* Implements Emacs' old Fintern_soft function.  */
@@ -619,6 +626,11 @@ pkg_emacs_intern_soft (Lisp_Object symbol, Lisp_Object 
package)
 
   const Lisp_Object name = SYMBOLP (symbol) ? SYMBOL_NAME (symbol) : symbol;
   CHECK_STRING (name);
+
+  /* This is presumable an obarray, and we are intending
+     to intern into the default pacakge.  */
+  if (VECTORP (package))
+    package = Vearmuffs_package;
   package = package_or_default (package);
 
   Lisp_Object found = lookup_symbol (name, package);
@@ -1076,11 +1088,12 @@ DEFUN ("unuse-package", Funuse_package, Sunuse_package, 
1, 2, 0,
   return Qt;
 }
 
-DEFUN ("pkg-read", Fpkg_read, Spkg_read, 1, 1, 0,
+DEFUN ("pkg-break", Fpkg_read, Spkg_read, 1, 1, 0,
        doc: /* tbd  */)
   (Lisp_Object stream)
 {
-  return Fread (stream);
+  pkg_break ();
+  return Qnil;
 }
 
 
@@ -1223,4 +1236,5 @@ syms_of_pkg (void)
 void
 init_pkg (void)
 {
+  package_system_ready = true;
 }
diff --git a/src/print.c b/src/print.c
index 2f5d6e57cf..4ddc2c155c 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2159,56 +2159,45 @@ print_stack_push_vector (const char *lbrac, const char 
*rbrac,
     });
 }
 
-/* Return true if symbol name NAME needs quoting.  */
+/* Return true if characer C at character index ICHAR (within a name)
+   needs quoting.  */
 
+/* PKG-FIXME: No longer right.  */
 static bool
-print_quoted_p (Lisp_Object name)
+must_escape_p (int c, int ichar)
 {
-  for (ptrdiff_t ibyte = 0, ichar = 0; ibyte < SBYTES (name);)
-    {
-      /* PKG-FIXME: Are these all characters?  */
-      int c = fetch_string_char_advance (name, &ichar, &ibyte);
-      if (c == '\"' || c == '\\' || c == '\''
-         || (ichar == 0
-             && (c == '+' || c == '-' || c == '.' || c == '?'))
-         || c == ';' || c == '#' || c == '(' || c == ')'
-         || c == ',' || c == '`' || c == '|'
-         || c == '[' || c == ']' || c <= 040
-         || c == NO_BREAK_SPACE)
-       return true;
-    }
+  if (c == '\"' || c == '\\' || c == '\''
+      || (ichar == 0
+         && (c == '+' || c == '-' || c == '.' || c == '?'))
+      || c == ';' || c == '#' || c == '(' || c == ')'
+      || c == ',' || c == '`' || c == '|'
+      || c == '[' || c == ']' || c <= 040
+      || c == NO_BREAK_SPACE)
+    return true;
   return false;
 }
 
-/* Return true if symbol name NAME needs quoting.  */
+/* Print string NAME like a symbol name.  */
 
 static void
-print_symbol_name (Lisp_Object name, Lisp_Object printcharfun)
+print_symbol_name (Lisp_Object name, Lisp_Object printcharfun,
+                  bool escape)
 {
-  /* A symbol's name may look like something else, like a number,
-     character, string, etc.  In that case print it as |...|.  */
-  const bool quote = print_quoted_p (name);
-
-  if (quote)
-    print_c_string ("|", printcharfun);
-
   for (ptrdiff_t ibyte = 0, ichar = 0; ibyte < SBYTES (name);)
     {
       const int c = fetch_string_char_advance (name, &ichar, &ibyte);
       maybe_quit ();
-      if (c == '|')
+      if (escape && must_escape_p (c, ichar))
        printchar ('\\', printcharfun);
       printchar (c, printcharfun);
     }
-
-  if (quote)
-    print_c_string ("|", printcharfun);
 }
 
 /* Print SYMBOL, imcluding package prefixes and whatnot.  */
 
 static void
-print_symbol (Lisp_Object symbol, Lisp_Object printcharfun)
+print_symbol (Lisp_Object symbol, Lisp_Object printcharfun,
+             bool escape)
 {
   const Lisp_Object name = SYMBOL_NAME (symbol);
   const char *p = SSDATA (name);
@@ -2225,21 +2214,16 @@ print_symbol (Lisp_Object symbol, Lisp_Object 
printcharfun)
       return;
     }
 
-  /* Note that Clisp and SBCL print |pkg|::|sym], if package names
-     contain silly characters.  */
   if (EQ (package, Vkeyword_package))
     print_c_string (":", printcharfun);
   else if (!NILP (package) && !EQ (package, Vearmuffs_package))
     {
+      /* Don't print qualification if in current package.  */
       const Lisp_Object found = Ffind_symbol (name, Vearmuffs_package);
-      if (!NILP (found) && EQ (XCAR (found), symbol))
-       {
-         /* Don't print qualification if accessible in current
-            package.  */
-       }
-      else
+      if (NILP (found) || !EQ (XCAR (found), symbol))
        {
-         print_symbol_name (XPACKAGE (package)->name, printcharfun);
+         print_symbol_name (XPACKAGE (package)->name,
+                            printcharfun, escape);
          if (SYMBOL_EXTERNAL_P (symbol))
            print_c_string (":", printcharfun);
          else
@@ -2247,7 +2231,7 @@ print_symbol (Lisp_Object symbol, Lisp_Object 
printcharfun)
        }
     }
 
-  print_symbol_name (name, printcharfun);
+  print_symbol_name (name, printcharfun, escape);
 }
 
 
@@ -2447,7 +2431,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, 
bool escapeflag)
       break;
 
     case Lisp_Symbol:
-      print_symbol (obj, printcharfun);
+      print_symbol (obj, printcharfun, escapeflag);
       break;
 
     case Lisp_Cons: