Extend ‘format’ to translate curved quotes

This is a followup to the recent doc string change, and deals with
diagnostics and the like.  This patch is more conservative than
the doc string change, in that the behavior of ‘format’ changes
only if its first arg contains curved quotes and the user prefers
straight or grave quotes.  (Come to think of it, perhaps we should
be similarly conservative with doc strings too, but that can wait.)
The upside of this conservatism is that existing usage is almost
surely unaffected.  The downside is that we'll eventually have to
change Emacs's format strings to use curved quotes in places where
the user might want curved quotes, but that's a simple and
mechanical translation that I'm willing to do later.  (Bug#21222)
* doc/lispref/help.texi (Keys in Documentation):
Move description of text-quoting-style from here ...
* doc/lispref/strings.texi (Formatting Strings):
... to here, and describe new behavior of ‘format’.
* etc/NEWS: Describe new behavior.
* lisp/calc/calc-help.el (calc-describe-thing):
* lisp/emacs-lisp/derived.el (derived-mode-make-docstring):
* lisp/info.el (Info-find-index-name):
Use ‘concat’ rather than ‘format’ to avoid misinterpretation
of recently-added curved quotes.
* src/doc.c (uLSQM0, uLSQM1, uLSQM2, uRSQM0, uRSQM1, uRSQM2):
Move from here ...
* src/lisp.h: ... to here.
* src/doc.c (text_quoting_style): New function.
(Fsubstitute_command_keys): Use it.
* src/editfns.c (Fformat): Implement new behavior.
* src/lisp.h (enum text_quoting_style): New enum.

3 files changed, 162 insertions, 111 deletions

diff --git a/src/doc.c b/src/doc.c
index cb52266ef58..9f0ddbc5260 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -684,19 +684,32 @@ the same file name is found in the `doc-directory'.  */)
   return unbind_to (count, Qnil);
 }
 
-/* Declare named constants for U+2018 LEFT SINGLE QUOTATION MARK and
-   U+2019 RIGHT SINGLE QUOTATION MARK, which have UTF-8 encodings
-   "\xE2\x80\x98" and "\xE2\x80\x99", respectively.  */
-enum
-  {
-    uLSQM0 = 0xE2, uLSQM1 = 0x80, uLSQM2 = 0x98,
-    uRSQM0 = 0xE2, uRSQM1 = 0x80, uRSQM2 = 0x99,
-  };
+/* Curved quotation marks.  */
 static unsigned char const LSQM[] = { uLSQM0, uLSQM1, uLSQM2 };
 static unsigned char const RSQM[] = { uRSQM0, uRSQM1, uRSQM2 };
 #define uLSQM "\xE2\x80\x98"
 #define uRSQM "\xE2\x80\x99"
 
+/* Return the current effective text quoting style.  */
+enum text_quoting_style
+text_quoting_style (void)
+{
+  if (EQ (Vtext_quoting_style, Qgrave))
+    return GRAVE_QUOTING_STYLE;
+  else if (EQ (Vtext_quoting_style, Qstraight))
+    return STRAIGHT_QUOTING_STYLE;
+  else if (NILP (Vtext_quoting_style)
+           && DISP_TABLE_P (Vstandard_display_table))
+    {
+      Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
+                                         LEFT_SINGLE_QUOTATION_MARK);
+      if (VECTORP (dv) && ASIZE (dv) == 1
+          && EQ (AREF (dv, 0), make_number ('`')))
+        return GRAVE_QUOTING_STYLE;
+    }
+  return CURVE_QUOTING_STYLE;
+}
+
 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
        Ssubstitute_command_keys, 1, 1, 0,
        doc: /* Substitute key descriptions for command names in STRING.
@@ -751,20 +764,7 @@ Otherwise, return a new string.  */)
   name = Qnil;
   GCPRO4 (string, tem, keymap, name);
 
-  enum { unicode, grave_accent, apostrophe } quote_translation = unicode;
-  if (EQ (Vtext_quoting_style, Qgrave))
-    quote_translation = grave_accent;
-  else if (EQ (Vtext_quoting_style, Qstraight))
-    quote_translation = apostrophe;
-  else if (NILP (Vtext_quoting_style)
-           && DISP_TABLE_P (Vstandard_display_table))
-    {
-      Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
-                                         LEFT_SINGLE_QUOTATION_MARK);
-      if (VECTORP (dv) && ASIZE (dv) == 1
-          && EQ (AREF (dv, 0), make_number ('`')))
-        quote_translation = grave_accent;
-    }
+  enum text_quoting_style quoting_style = text_quoting_style ();
 
   multibyte = STRING_MULTIBYTE (string);
   nchars = 0;
@@ -966,7 +966,7 @@ Otherwise, return a new string.  */)
             strp = SDATA (string) + idx;
           }
         }
-      else if (strp[0] == '`' && quote_translation == unicode)
+      else if (strp[0] == '`' && quoting_style == CURVE_QUOTING_STYLE)
         {
           in_quote = true;
           start = LSQM;
@@ -976,7 +976,7 @@ Otherwise, return a new string.  */)
           idx = strp - SDATA (string) + 1;
           goto subst;
         }
-      else if (strp[0] == '`' && quote_translation == apostrophe)
+      else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
         {
           *bufp++ = '\'';
           strp++;
@@ -991,9 +991,9 @@ Otherwise, return a new string.  */)
         }
       else if (strp[0] == uLSQM0 && strp[1] == uLSQM1
                && (strp[2] == uLSQM2 || strp[2] == uRSQM2)
-               && quote_translation != unicode)
+               && quoting_style != CURVE_QUOTING_STYLE)
         {
-          *bufp++ = (strp[2] == uLSQM2 && quote_translation == grave_accent
+          *bufp++ = (strp[2] == uLSQM2 && quoting_style == GRAVE_QUOTING_STYLE
                      ? '`' : '\'');
           strp += 3;
           nchars++;
diff --git a/src/editfns.c b/src/editfns.c
index 9ff39f9bf19..ed57d8aee09 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3800,8 +3800,9 @@ DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
 The first argument is a format control string.
 The other arguments are substituted into it to make the result, a string.
 
-The format control string may contain %-sequences meaning to substitute
-the next available argument:
+The format control string may contain ordinary characters,
+%-sequences meaning to substitute the next available argument,
+and curved single quotation marks meaning to substitute quotes.
 
 %s means print a string argument.  Actually, prints any object, with `princ'.
 %d means print as number in decimal (%o octal, %x hex).
@@ -3846,6 +3847,12 @@ precision specifier says how many decimal places to show; if zero, the
 decimal point itself is omitted.  For %s and %S, the precision
 specifier truncates the string to the given width.
 
+\\=‘ and \\=’ means print left and right quotes as per
+‘text-quoting-style’.
+
+Return the first argument if it contains no format directives.
+Otherwise, return a new string.
+
 usage: (format STRING &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -3858,6 +3865,7 @@ usage: (format STRING &rest OBJECTS)  */)
   ptrdiff_t buf_save_value_index IF_LINT (= 0);
   char *format, *end, *format_start;
   ptrdiff_t formatlen, nchars;
+  bool changed = false;
   /* True if the format is multibyte.  */
   bool multibyte_format = 0;
   /* True if the output should be a multibyte string,
@@ -3921,6 +3929,8 @@ usage: (format STRING &rest OBJECTS)  */)
     if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
       multibyte = 1;
 
+  enum text_quoting_style quoting_style = text_quoting_style ();
+
   /* If we start out planning a unibyte result,
      then discover it has to be multibyte, we jump back to retry.  */
  retry:
@@ -4005,6 +4015,7 @@ usage: (format STRING &rest OBJECTS)  */)
           if (format == end)
             error ("Format string ends in middle of format specifier");
 
+          changed = true;
           memset (&discarded[format0 - format_start], 1, format - format0);
           conversion = *format;
           if (conversion == '%')
@@ -4426,6 +4437,20 @@ usage: (format STRING &rest OBJECTS)  */)
 
               convbytes = format - src;
               memset (&discarded[src + 1 - format_start], 2, convbytes - 1);
+
+              if (quoting_style != CURVE_QUOTING_STYLE && convbytes == 3
+                  && (unsigned char) src[0] == uLSQM0
+                  && (unsigned char) src[1] == uLSQM1
+                  && ((unsigned char) src[2] == uLSQM2
+                      || (unsigned char) src[2] == uRSQM2))
+                {
+                  convbytes = 1;
+                  str[0] = (((unsigned char) src[2] == uLSQM2
+                             && quoting_style == GRAVE_QUOTING_STYLE)
+                            ? '`' : '\'');
+                  src = (char *) str;
+                  changed = true;
+                }
             }
           else
             {
@@ -4437,6 +4462,7 @@ usage: (format STRING &rest OBJECTS)  */)
                   int c = BYTE8_TO_CHAR (uc);
                   convbytes = CHAR_STRING (c, str);
                   src = (char *) str;
+                  changed = true;
                 }
             }
 
@@ -4484,113 +4510,119 @@ usage: (format STRING &rest OBJECTS)  */)
   if (bufsize < p - buf)
     emacs_abort ();
 
-  if (maybe_combine_byte)
-    nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
-  val = make_specified_string (buf, nchars, p - buf, multibyte);
-
-  /* If the format string has text properties, or any of the string
-     arguments has text properties, set up text properties of the
-     result string.  */
-
-  if (string_intervals (args[0]) || arg_intervals)
+  if (!changed)
+    val = args[0];
+  else
     {
-      Lisp_Object len, new_len, props;
-      struct gcpro gcpro1;
+      if (maybe_combine_byte)
+        nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
+      val = make_specified_string (buf, nchars, p - buf, multibyte);
 
-      /* Add text properties from the format string.  */
-      len = make_number (SCHARS (args[0]));
-      props = text_property_list (args[0], make_number (0), len, Qnil);
-      GCPRO1 (props);
+      /* If the format string has text properties, or any of the string
+         arguments has text properties, set up text properties of the
+         result string.  */
 
-      if (CONSP (props))
+      if (string_intervals (args[0]) || arg_intervals)
         {
-          ptrdiff_t bytepos = 0, position = 0, translated = 0;
-          ptrdiff_t argn = 1;
-          Lisp_Object list;
-
-          /* Adjust the bounds of each text property
-             to the proper start and end in the output string.  */
-
-          /* Put the positions in PROPS in increasing order, so that
-             we can do (effectively) one scan through the position
-             space of the format string.  */
-          props = Fnreverse (props);
-
-          /* BYTEPOS is the byte position in the format string,
-             POSITION is the untranslated char position in it,
-             TRANSLATED is the translated char position in BUF,
-             and ARGN is the number of the next arg we will come to.  */
-          for (list = props; CONSP (list); list = XCDR (list))
+          Lisp_Object len, new_len, props;
+          struct gcpro gcpro1;
+
+          /* Add text properties from the format string.  */
+          len = make_number (SCHARS (args[0]));
+          props = text_property_list (args[0], make_number (0), len, Qnil);
+          GCPRO1 (props);
+
+          if (CONSP (props))
             {
-              Lisp_Object item;
-              ptrdiff_t pos;
+              ptrdiff_t bytepos = 0, position = 0, translated = 0;
+              ptrdiff_t argn = 1;
+              Lisp_Object list;
+
+              /* Adjust the bounds of each text property
+                 to the proper start and end in the output string.  */
+
+              /* Put the positions in PROPS in increasing order, so that
+                 we can do (effectively) one scan through the position
+                 space of the format string.  */
+              props = Fnreverse (props);
+
+              /* BYTEPOS is the byte position in the format string,
+                 POSITION is the untranslated char position in it,
+                 TRANSLATED is the translated char position in BUF,
+                 and ARGN is the number of the next arg we will come to.  */
+              for (list = props; CONSP (list); list = XCDR (list))
+                {
+                  Lisp_Object item;
+                  ptrdiff_t pos;
 
-              item = XCAR (list);
+                  item = XCAR (list);
 
-              /* First adjust the property start position.  */
-              pos = XINT (XCAR (item));
+                  /* First adjust the property start position.  */
+                  pos = XINT (XCAR (item));
 
-              /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
-                 up to this position.  */
-              for (; position < pos; bytepos++)
-                {
-                  if (! discarded[bytepos])
-                    position++, translated++;
-                  else if (discarded[bytepos] == 1)
+                  /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
+                     up to this position.  */
+                  for (; position < pos; bytepos++)
                     {
-                      position++;
-                      if (translated == info[argn].start)
+                      if (! discarded[bytepos])
+                        position++, translated++;
+                      else if (discarded[bytepos] == 1)
                         {
-                          translated += info[argn].end - info[argn].start;
-                          argn++;
+                          position++;
+                          if (translated == info[argn].start)
+                            {
+                              translated += info[argn].end - info[argn].start;
+                              argn++;
+                            }
                         }
                     }
-                }
 
-              XSETCAR (item, make_number (translated));
+                  XSETCAR (item, make_number (translated));
 
-              /* Likewise adjust the property end position.  */
-              pos = XINT (XCAR (XCDR (item)));
+                  /* Likewise adjust the property end position.  */
+                  pos = XINT (XCAR (XCDR (item)));
 
-              for (; position < pos; bytepos++)
-                {
-                  if (! discarded[bytepos])
-                    position++, translated++;
-                  else if (discarded[bytepos] == 1)
+                  for (; position < pos; bytepos++)
                     {
-                      position++;
-                      if (translated == info[argn].start)
+                      if (! discarded[bytepos])
+                        position++, translated++;
+                      else if (discarded[bytepos] == 1)
                         {
-                          translated += info[argn].end - info[argn].start;
-                          argn++;
+                          position++;
+                          if (translated == info[argn].start)
+                            {
+                              translated += info[argn].end - info[argn].start;
+                              argn++;
+                            }
                         }
                     }
+
+                  XSETCAR (XCDR (item), make_number (translated));
                 }
 
-              XSETCAR (XCDR (item), make_number (translated));
+              add_text_properties_from_list (val, props, make_number (0));
             }
 
-          add_text_properties_from_list (val, props, make_number (0));
-        }
-
-      /* Add text properties from arguments.  */
-      if (arg_intervals)
-        for (n = 1; n < nargs; ++n)
-          if (info[n].intervals)
-            {
-              len = make_number (SCHARS (args[n]));
-              new_len = make_number (info[n].end - info[n].start);
-              props = text_property_list (args[n], make_number (0), len, Qnil);
-              props = extend_property_ranges (props, new_len);
-              /* If successive arguments have properties, be sure that
-                 the value of `composition' property be the copy.  */
-              if (n > 1 && info[n - 1].end)
-                make_composition_value_copy (props);
-              add_text_properties_from_list (val, props,
-                                             make_number (info[n].start));
-            }
+          /* Add text properties from arguments.  */
+          if (arg_intervals)
+            for (n = 1; n < nargs; ++n)
+              if (info[n].intervals)
+                {
+                  len = make_number (SCHARS (args[n]));
+                  new_len = make_number (info[n].end - info[n].start);
+                  props = text_property_list (args[n], make_number (0),
+                                              len, Qnil);
+                  props = extend_property_ranges (props, new_len);
+                  /* If successive arguments have properties, be sure that
+                     the value of `composition' property be the copy.  */
+                  if (n > 1 && info[n - 1].end)
+                    make_composition_value_copy (props);
+                  add_text_properties_from_list (val, props,
+                                                 make_number (info[n].start));
+                }
 
-      UNGCPRO;
+          UNGCPRO;
+        }
     }
 
   /* If we allocated BUF or INFO with malloc, free it too.  */
diff --git a/src/lisp.h b/src/lisp.h
index 2545203a674..d3dcaecd2bb 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4300,6 +4300,25 @@ extern void set_initial_environment (void);
 extern void syms_of_callproc (void);
 
 /* Defined in doc.c.  */
+enum
+  {
+    /* Named constants for the UTF-8 encodings of U+2018 LEFT SINGLE
+       QUOTATION MARK and U+2019 RIGHT SINGLE QUOTATION MARK.  */
+    uLSQM0 = 0xE2, uLSQM1 = 0x80, uLSQM2 = 0x98,
+    uRSQM0 = 0xE2, uRSQM1 = 0x80, uRSQM2 = 0x99
+  };
+enum text_quoting_style
+  {
+    /* Use curved single quotes ‘like this’.  */
+    CURVE_QUOTING_STYLE,
+
+    /* Use grave accent and apostrophe  `like this'.  */
+    GRAVE_QUOTING_STYLE,
+
+    /* Use apostrophes 'like this'.  */
+    STRAIGHT_QUOTING_STYLE
+  };
+extern enum text_quoting_style text_quoting_style (void);
 extern Lisp_Object read_doc_string (Lisp_Object);
 extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
 extern void syms_of_doc (void);