From c661d622d7109dcddd957524c4dd4457b41c1561 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Tue, 23 Jan 2018 18:50:23 -0500
Subject: [PATCH] Fix round tripping of read->print for symbols with strange
 quotes

Since 2017-07-22 "Signal error for symbol names with strange
quotes (Bug#2967)", symbol names beginning with certain quote
characters require an escaping backslash.  However, the corresponding
change for printing missed, so that (eq (read (prin1-to-string SYM))
SYM) does not give `t' for such symbols.
* src/character.c (confusable_symbol_character_p): New function,
extracted from test `read1'.
* src/lread.c (read1): Use it.
* src/print.c (print_object): Use it to print a backslash for symbols
starting with characters that `read1' requires to be escaped.
* test/src/print-tests.el (print-read-roundtrip): New test.
* etc/NEWS: Clarify the announcement for the earlier reader
change (Bug#30217).
---
 etc/NEWS                | 12 +++++++++---
 src/character.c         | 26 ++++++++++++++++++++++++++
 src/character.h         |  2 ++
 src/lread.c             | 17 +++--------------
 src/print.c             |  3 ++-
 test/src/print-tests.el |  4 ++++
 6 files changed, 46 insertions(+), 18 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index f5859d7a60..c760738105 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1385,9 +1385,15 @@ renamed to 'lread--old-style-backquotes'.  No user code should use
 this variable.
 
 ---
-** To avoid confusion caused by "smart quotes", the reader no longer
-accepts Lisp symbols which begin with the following quotation
-characters: ‘’‛“”‟〞＂＇, unless they are escaped with backslash.
+** To avoid confusion caused by "smart quotes", the reader signals an
+error when reading Lisp symbols which begin with one of the following
+quotation characters: ‘’‛“”‟〞＂＇.  A symbol beginning with such a
+character can be written by escaping the quotation character with a
+backslash.  For example:
+
+    (read "‘smart") => (invalid-read-syntax "strange quote" "‘")
+    (read "\\‘smart") == (intern "‘smart")
+
 
 +++
 ** 'default-file-name-coding-system' now defaults to a coding system
diff --git a/src/character.c b/src/character.c
index fa817a5031..4a934c7801 100644
--- a/src/character.c
+++ b/src/character.c
@@ -1050,6 +1050,32 @@ blankp (int c)
   return XINT (category) == UNICODE_CATEGORY_Zs; /* separator, space */
 }
 
+
+/* Return true for characters that would read as symbol characters,
+   but graphically may be confused with some kind of punctuation.  We
+   require an escaping backslash, when such characters begin a
+   symbol.  */
+bool
+confusable_symbol_character_p (int ch)
+{
+  switch (ch)
+    {
+    case 0x2018: /* LEFT SINGLE QUOTATION MARK */
+    case 0x2019: /* RIGHT SINGLE QUOTATION MARK */
+    case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */
+    case 0x201C: /* LEFT DOUBLE QUOTATION MARK */
+    case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */
+    case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */
+    case 0x301E: /* DOUBLE PRIME QUOTATION MARK */
+    case 0xFF02: /* FULLWIDTH QUOTATION MARK */
+    case 0xFF07: /* FULLWIDTH APOSTROPHE */
+      return true;
+
+    default:
+      return false;
+    }
+}
+
 signed char HEXDIGIT_CONST hexdigit[UCHAR_MAX + 1] =
   {
 #if HEXDIGIT_IS_CONST
diff --git a/src/character.h b/src/character.h
index c716885d46..d9e2d7bfc6 100644
--- a/src/character.h
+++ b/src/character.h
@@ -682,6 +682,8 @@ char_surrogate_p (int c)
 extern bool printablep (int);
 extern bool blankp (int);
 
+extern bool confusable_symbol_character_p (int ch);
+
 /* Return a translation table of id number ID.  */
 #define GET_TRANSLATION_TABLE(id) \
   (XCDR (XVECTOR (Vtranslation_table_vector)->contents[(id)]))
diff --git a/src/lread.c b/src/lread.c
index 45d60647be..82731781f0 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3482,20 +3482,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
         if (!quoted && multibyte)
           {
             int ch = STRING_CHAR ((unsigned char *) read_buffer);
-            switch (ch)
-              {
-              case 0x2018: /* LEFT SINGLE QUOTATION MARK */
-              case 0x2019: /* RIGHT SINGLE QUOTATION MARK */
-              case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */
-              case 0x201C: /* LEFT DOUBLE QUOTATION MARK */
-              case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */
-              case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */
-              case 0x301E: /* DOUBLE PRIME QUOTATION MARK */
-              case 0xFF02: /* FULLWIDTH QUOTATION MARK */
-              case 0xFF07: /* FULLWIDTH APOSTROPHE */
-                xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"),
-                          CALLN (Fstring, make_number (ch)));
-              }
+            if (confusable_symbol_character_p (ch))
+              xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"),
+                        CALLN (Fstring, make_number (ch)));
           }
 	{
 	  Lisp_Object result;
diff --git a/src/print.c b/src/print.c
index 47cb33deeb..b0741531f7 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1971,7 +1971,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		    || c == ';' || c == '#' || c == '(' || c == ')'
 		    || c == ',' || c == '.' || c == '`'
 		    || c == '[' || c == ']' || c == '?' || c <= 040
-		    || confusing)
+                    || confusing
+		    || (i == 1 && confusable_symbol_character_p (c)))
 		  {
 		    printchar ('\\', printcharfun);
 		    confusing = false;
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 46368c69ad..01e65028bc 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -58,5 +58,9 @@
                        (buffer-string))
                      "--------\n"))))
 
+(ert-deftest print-read-roundtrip ()
+  (let ((sym '\’bar))
+    (should (eq (read (prin1-to-string sym)) sym))))
+
 (provide 'print-tests)
 ;;; print-tests.el ends here
-- 
2.11.0