From 8615f5b048e35b496f19498ddb0618211acfcc67 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Gerd=20M=C3=B6llmann?= Date: Thu, 13 Oct 2022 15:18:50 +0200 Subject: [PATCH] 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 03c45e44a56..f0e72a6e206 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 772e283c3e2..b93a837f4c6 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 0b98b3801db..0d333a2bc17 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 2f5d6e57cf5..4ddc2c155c7 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: -- 2.39.2