pkg 06cfa629a5 05/76: Print symbols differently

[Gerd Moellmann]

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

    Print symbols differently
---
 src/print.c | 176 ++++++++++++++++++++++++++++++++----------------------------
 1 file changed, 93 insertions(+), 83 deletions(-)

diff --git a/src/print.c b/src/print.c
index 063aef28f4..2f5d6e57cf 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2159,6 +2159,98 @@ print_stack_push_vector (const char *lbrac, const char 
*rbrac,
     });
 }
 
+/* Return true if symbol name NAME needs quoting.  */
+
+static bool
+print_quoted_p (Lisp_Object name)
+{
+  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;
+    }
+  return false;
+}
+
+/* Return true if symbol name NAME needs quoting.  */
+
+static void
+print_symbol_name (Lisp_Object name, Lisp_Object printcharfun)
+{
+  /* 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 == '|')
+       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)
+{
+  const Lisp_Object name = SYMBOL_NAME (symbol);
+  const char *p = SSDATA (name);
+  const Lisp_Object package = SYMBOL_PACKAGE (symbol);
+
+  /* print-gensym true means print #: for uninterned symbols.
+     PKG_FIXME: This looks like #: for an uninterned symbol with empty
+     name?  */
+  if (!NILP (Vprint_gensym) && NILP (package))
+    print_c_string ("#:", printcharfun);
+  else if (*p == 0)
+    {
+      print_c_string ("##", 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))
+    {
+      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
+       {
+         print_symbol_name (XPACKAGE (package)->name, printcharfun);
+         if (SYMBOL_EXTERNAL_P (symbol))
+           print_c_string (":", printcharfun);
+         else
+           print_c_string ("::", printcharfun);
+       }
+    }
+
+  print_symbol_name (name, printcharfun);
+}
+
+
 static void
 print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 {
@@ -2355,89 +2447,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, 
bool escapeflag)
       break;
 
     case Lisp_Symbol:
-      {
-       Lisp_Object name = SYMBOL_NAME (obj);
-       ptrdiff_t size_byte = SBYTES (name);
-
-       char *p = SSDATA (name);
-       bool signedp = *p == '-' || *p == '+';
-       ptrdiff_t len;
-       bool confusing =
-         /* Set CONFUSING if NAME looks like a number, calling
-            string_to_number for non-obvious cases.  */
-         ((c_isdigit (p[signedp]) || p[signedp] == '.')
-          && !NILP (string_to_number (p, 10, &len))
-          && len == size_byte)
-         /* We don't escape "." or "?" (unless they're the first
-            character in the symbol name).  */
-         || *p == '?'
-         || *p == '.';
-
-       if (! NILP (Vprint_gensym)
-           && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj))
-         print_c_string ("#:", printcharfun);
-       else if (size_byte == 0)
-         {
-           print_c_string ("##", printcharfun);
-           break;
-         }
-
-       /* Package prefix, maybe.  */
-       const Lisp_Object package = SYMBOL_PACKAGE (obj);
-       if (NILP (package) || EQ (package, Vearmuffs_package))
-         {
-           /* Nothing to do for uninterned symbols, or symbols in
-              their home package.  */
-         }
-       else if (EQ (package, Vkeyword_package))
-         {
-           /* FIXME: If symbol names of keywords didn't include the
-              colon, we'd have to print it here.  */
-           // print_c_string (":", printcharfun);
-         }
-       else
-         {
-           const Lisp_Object found
-             = Ffind_symbol (SYMBOL_NAME (obj), Vearmuffs_package);
-           if (!NILP (found) && EQ (XCAR (found), obj))
-             {
-               /* Don't print qualification if accessible in current
-                  package.  */
-             }
-           else
-             {
-               print_object (XPACKAGE (package)->name, printcharfun, false);
-               if (SYMBOL_EXTERNAL_P (obj))
-                 print_c_string (":", printcharfun);
-               else
-                 print_c_string ("::", printcharfun);
-             }
-         }
-
-       ptrdiff_t i = 0;
-       for (ptrdiff_t i_byte = 0; i_byte < size_byte; )
-         {
-           /* Here, we must convert each multi-byte form to the
-              corresponding character code before handing it to PRINTCHAR.  */
-           int c = fetch_string_char_advance (name, &i, &i_byte);
-           maybe_quit ();
-
-           if (escapeflag)
-             {
-               if (c == '\"' || c == '\\' || c == '\''
-                   || c == ';' || c == '#' || c == '(' || c == ')'
-                   || c == ',' || c == '`'
-                   || c == '[' || c == ']' || c <= 040
-                   || c == NO_BREAK_SPACE
-                   || confusing)
-                 {
-                   printchar ('\\', printcharfun);
-                   confusing = false;
-                 }
-             }
-           printchar (c, printcharfun);
-         }
-      }
+      print_symbol (obj, printcharfun);
       break;
 
     case Lisp_Cons: