From b3cdb8a3d3aba0ea537ecabd2900a3682e7c0660 Mon Sep 17 00:00:00 2001
From: Gerd Möllmann
Date: Wed, 12 Oct 2022 13:53:07 +0200
Subject: Intern keywords differently

Instead of something like (intern (format ":%s" ...)) do
(intern (format "%s" :keyword).  Likewise in C.
---
 src/image.c |  2 +-
 src/lisp.h  |  2 ++
 src/lread.c | 35 ++++++++++++++++++++++++++---------
 src/pkg.c   | 13 +++++++++++++
 4 files changed, 42 insertions(+), 10 deletions(-)

(limited to 'src')

diff --git a/src/image.c b/src/image.c
index 1e323ba66a0..f6209149313 100644
--- a/src/image.c
+++ b/src/image.c
@@ -10072,7 +10072,7 @@ imagemagick_filename_hint (Lisp_Object spec, char hint_buffer[MaxTextExtent])
   if (! CONSP (val))
     return NULL;
 
-  format = image_spec_value (spec, intern (":format"), NULL);
+  format = image_spec_value (spec, QCformat, NULL);
   val = Fcar_safe (Fcdr_safe (Fassq (format, val)));
   if (! STRINGP (val))
     return NULL;
diff --git a/src/lisp.h b/src/lisp.h
index 68a7233abd0..c5ce309306f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2268,6 +2268,8 @@ 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 bool pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol);
 extern void pkg_early_intern_symbol (Lisp_Object symbol);
+extern Lisp_Object pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes);
+extern void pkg_break (void);
 
 extern bool package_system_ready;
 
diff --git a/src/lread.c b/src/lread.c
index 4260850399f..edd50efd16b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4138,7 +4138,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	/* If of the form ||, everything except '|' is considered quoted.
 	   the bars doesn't belong to the symbol name.  */
 	bool in_vertical_bar = false;
-	if (c == '|')
+	if (!read_emacs_syntax && c == '|')
 	  {
 	    in_vertical_bar = true;
 	    c = READCHAR;
@@ -4160,19 +4160,22 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	  {
 	    if (c == ':' && !last_was_backslash && !in_vertical_bar)
 	      {
-		/* #:xyz should not contain a colon.  */
-		if (uninterned_symbol)
-		  invalid_syntax ("colon in uninterned symbol", readcharfun);
-
 		/* Remember where the first : is.  */
 		if (colon == NULL)
 		  colon = p;
 		++ncolons;
 
-		/* Up to two colons are allowed if they are
-		   consecutive.  PKG-FIXME check consecutive :.  */
-		if (ncolons > 2)
-		  invalid_syntax ("too many colons", readcharfun);
+		if (!read_emacs_syntax)
+		  {
+		    /* #:xyz should not contain a colon.  */
+		    if (uninterned_symbol)
+		      invalid_syntax ("colon in uninterned symbol", readcharfun);
+
+		    /* Up to two colons are allowed if they are
+		       consecutive.  PKG-FIXME check consecutive :.  */
+		    if (ncolons > 2)
+		      invalid_syntax ("too many colons", readcharfun);
+		  }
 	      }
 
 	    /* Handle backslash.  The first backslash is not part of
@@ -4219,6 +4222,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	       symbol.  */
 	    if (in_vertical_bar)
 	      {
+		eassert (!read_emacs_syntax);
 		if (c < 0)
 		  end_of_file_error ();
 		if (c == '|')
@@ -4826,6 +4830,8 @@ A second optional argument specifies the obarray to use;
 it defaults to the value of `obarray'.  */)
   (Lisp_Object string, Lisp_Object package)
 {
+  /* PKG-FIXME: Remove this eassert.  */
+  eassert (SREF (string, 0) != ':' || !package_system_ready);
   return pkg_emacs_intern (string, package);
 }
 
@@ -4862,6 +4868,10 @@ usage: (unintern NAME OBARRAY)  */)
 Lisp_Object
 oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
 {
+  const Lisp_Object found = pkg_lookup_c_string (ptr, size, size_byte);
+  if (!EQ (found, Qunbound))
+    return found;
+
   size_t hash;
   size_t obsize;
   register Lisp_Object tail;
@@ -4897,6 +4907,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
 void
 map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
 {
+  eassert (package_system_ready);
   ptrdiff_t i;
   register Lisp_Object tail;
   CHECK_VECTOR (obarray);
@@ -4917,6 +4928,7 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob
 static void
 mapatoms_1 (Lisp_Object sym, Lisp_Object function)
 {
+  eassert (package_system_ready);
   call1 (function, sym);
 }
 
@@ -4925,6 +4937,7 @@ DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
 OBARRAY defaults to the value of `obarray'.  */)
   (Lisp_Object function, Lisp_Object obarray)
 {
+  eassert (package_system_ready);
   if (NILP (obarray)) obarray = Vobarray;
   obarray = check_obarray (obarray);
 
@@ -5575,6 +5588,10 @@ that are loaded before your customizations are read!  */);
                doc: /* Non-nil means not to load a .eln file when a .elc was requested.  */);
   load_no_native = false;
 
+  DEFVAR_BOOL ("read-emacs-syntax", read_emacs_syntax,
+               doc: /* Non-nil means don't treat ':' or '|' specially in symbols.  */);
+  read_emacs_syntax = true;
+
   /* Vsource_directory was initialized in init_lread.  */
 
   DEFSYM (Qcurrent_load_list, "current-load-list");
diff --git a/src/pkg.c b/src/pkg.c
index 03533dceacd..5a021ac39de 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -555,6 +555,15 @@ pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol)
   return true;
 }
 
+Lisp_Object
+pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes)
+{
+  if (!package_system_ready)
+    return Qunbound;
+  const Lisp_Object name = make_string_from_bytes (ptr, nchars, nbytes);
+  return lookup_symbol (name, Vearmuffs_package);
+}
+
 void
 pkg_early_intern_symbol (Lisp_Object symbol)
 {
@@ -582,6 +591,10 @@ pkg_unintern_symbol (Lisp_Object symbol, Lisp_Object package)
   return Qnil;
 }
 
+void pkg_break (void)
+{
+}
+
 
 /***********************************************************************
 			Old Emacs intern stuff
-- 
cgit v1.2.1