bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#21222: [PROPOSED PATCH] Extend ‘format’ to translate curved quotes


From: Paul Eggert
Subject: bug#21222: [PROPOSED PATCH] Extend ‘format’ to translate curved quotes
Date: Sat, 8 Aug 2015 21:41:34 -0700

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 curved quotes, but that's a simple and
mechanical translation that I'm willing to do later.
* 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.
---
 doc/lispref/help.texi      |  12 +--
 doc/lispref/strings.texi   |  73 +++++++++++-----
 etc/NEWS                   |  25 ++++--
 lisp/calc/calc-help.el     |   2 +-
 lisp/emacs-lisp/derived.el |   5 +-
 lisp/info.el               |   6 +-
 src/doc.c                  |  57 +++++++------
 src/editfns.c              | 202 ++++++++++++++++++++++++++-------------------
 src/lisp.h                 |  19 +++++
 9 files changed, 244 insertions(+), 157 deletions(-)

diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index ca8ae3f..ab1696e 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -347,19 +347,11 @@ and @samp{\=\=} puts @samp{\=} into the output.
 @strong{Please note:} Each @samp{\} must be doubled when written in a
 string in Emacs Lisp.
 
-@defvar text-quoting-style
 @cindex curved quotes
 @cindex curly quotes
-The value of this variable specifies the style
+The value of the @code{text-quoting-style} variable specifies the style
 @code{substitute-command-keys} uses when generating left and right
-quotes.  If the variable's value is @code{curve}, the style is
-@t{‘like this’} with curved single quotes.  If the value is
-@code{straight}, the style is @t{'like this'} with straight
-apostrophes.  If the value is @code{grave}, the style is @t{`like
-this'} with grave accent and apostrophe.  The default value @code{nil}
-acts like @code{curve} if curved single quotes are displayable, and
-like @code{grave} otherwise.
-@end defvar
+quotes.  @xref{Formatting Strings}, for more information.
 
 @defun substitute-command-keys string
 This function scans @var{string} for the above special sequences and
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index c2f0607..3093338 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -805,22 +805,27 @@ formatting feature described here; they differ from 
@code{format} only
 in how they use the result of formatting.
 
 @defun format string &rest objects
-This function returns a new string that is made by copying
+This function returns a string that is equivalent to copying
 @var{string} and then replacing any format specification
 in the copy with encodings of the corresponding @var{objects}.  The
 arguments @var{objects} are the computed values to be formatted.
 
 The characters in @var{string}, other than the format specifications,
 are copied directly into the output, including their text properties,
-if any.
+if any.  If the output equals @var{string}, this function may return
+@var{string} itself rather than a new copy.
 @end defun
 
 @cindex @samp{%} in format
 @cindex format specification
+@cindex curved quotes
+@cindex curly quotes
   A format specification is a sequence of characters beginning with a
-@samp{%}.  Thus, if there is a @samp{%d} in @var{string}, the
-@code{format} function replaces it with the printed representation of
-one of the values to be formatted (one of the arguments @var{objects}).
+@samp{%} or is a curved single quotation mark.  Except for @samp{%%}
+and quotation marks, each format specification says how to represent
+one of the arguments @var{objects}.  For example, if there
+is a @samp{%d} in @var{string}, the @code{format} function replaces it
+with the decimal representation of the integer to be formatted.
 For example:
 
 @example
@@ -830,11 +835,12 @@ For example:
 @end group
 @end example
 
-  Since @code{format} interprets @samp{%} characters as format
+  Since @code{format} interprets @samp{%}, @samp{‘} and @samp{’}
+characters as format
 specifications, you should @emph{never} pass an arbitrary string as
 the first argument.  This is particularly true when the string is
 generated by some Lisp code.  Unless the string is @emph{known} to
-never include any @samp{%} characters, pass @code{"%s"}, described
+never include any of the three special characters, pass @code{"%s"}, described
 below, as the first argument, and the string as the second, like this:
 
 @example
@@ -908,20 +914,30 @@ is shorter.
 Replace the specification with a single @samp{%}.  This format
 specification is unusual in that it does not use a value.  For example,
 @code{(format "%% %d" 30)} returns @code{"% 30"}.
+
+@item ‘
+@itemx ’
+@cindex curved quotes
+@cindex curly quotes
+Replace the specification with a left or right quote, respectively.
+Although typically a curved single quotation mark stands for itself,
+other quoting styles are available as per the variable
+@samp{text-quoting-style} described below.
 @end table
 
-  Any other format character results in an @samp{Invalid format
+  Any other format character after @samp{%} results in an @samp{Invalid format
 operation} error.
 
-  Here are several examples:
+  Here are several examples, which assume the typical quoting style
+where curved single quotes stand for themselves:
 
 @example
 @group
-(format "The name of this buffer is %s." (buffer-name))
-     @result{} "The name of this buffer is strings.texi."
+(format "The name of this buffer is ‘%s’." (buffer-name))
+     @result{} "The name of this buffer is ‘strings.texi’."
 
-(format "The buffer object prints as %s." (current-buffer))
-     @result{} "The buffer object prints as strings.texi."
+(format "The buffer object prints as ‘%s’." (current-buffer))
+     @result{} "The buffer object prints as ‘strings.texi’."
 
 (format "The octal value of %d is %o,
          and the hex value is %x." 18 18 18)
@@ -932,7 +948,7 @@ operation} error.
 
 @cindex field width
 @cindex padding
-  A specification can have a @dfn{width}, which is a decimal number
+  A @samp{%} specification can have a @dfn{width}, which is a decimal number
 between the @samp{%} and the specification character.  If the printed
 representation of the object contains fewer characters than this
 width, @code{format} extends it with padding.  The width specifier is
@@ -948,7 +964,7 @@ the width specifier normally consists of spaces inserted on 
the left:
 If the width is too small, @code{format} does not truncate the
 object's printed representation.  Thus, you can use a width to specify
 a minimum spacing between columns with no risk of losing information.
-In the following three examples, @samp{%7s} specifies a minimum width
+In the following two examples, @samp{%7s} specifies a minimum width
 of 7.  In the first case, the string inserted in place of @samp{%7s}
 has only 3 letters, and needs 4 blank spaces as padding.  In the
 second case, the string @code{"specification"} is 13 letters wide but
@@ -956,12 +972,12 @@ is not truncated.
 
 @example
 @group
-(format "The word '%7s' has %d letters in it."
+(format "The word ‘%7s’ has %d letters in it."
         "foo" (length "foo"))
-     @result{} "The word '    foo' has 3 letters in it."
-(format "The word '%7s' has %d letters in it."
+     @result{} "The word ‘    foo’ has 3 letters in it."
+(format "The word ‘%7s’ has %d letters in it."
         "specification" (length "specification"))
-     @result{} "The word 'specification' has 13 letters in it."
+     @result{} "The word ‘specification’ has 13 letters in it."
 @end group
 @end example
 
@@ -1003,14 +1019,14 @@ ignored.
 (format "%-6d is padded on the right" 123)
      @result{} "123    is padded on the right"
 
-(format "The word '%-7s' actually has %d letters in it."
+(format "The word ‘%-7s’ actually has %d letters in it."
         "foo" (length "foo"))
-     @result{} "The word 'foo    ' actually has 3 letters in it."
+     @result{} "The word ‘foo    ’ actually has 3 letters in it."
 @end group
 @end example
 
 @cindex precision in format specifications
-  All the specification characters allow an optional @dfn{precision}
+  The @samp{%} specification characters allow an optional @dfn{precision}
 before the character (after the width, if present).  The precision is
 a decimal-point @samp{.} followed by a digit-string.  For the
 floating-point specifications (@samp{%e}, @samp{%f}, @samp{%g}), the
@@ -1021,6 +1037,19 @@ shows only the first three characters of the 
representation for
 @var{object}.  Precision has no effect for other specification
 characters.
 
+@defvar text-quoting-style
+@cindex curved quotes
+@cindex curly quotes
+This variable specifies the style @code{format} uses when generating
+left and right quotes.  If the value is @code{curve}, the style is
+@t{‘like this’} with curved single quotes.  If the value is
+@code{straight}, the style is @t{'like this'} with straight
+apostrophes.  If the value is @code{grave}, the style is @t{`like
+this'} with grave accent and apostrophe.  The default value @code{nil}
+acts like @code{curve} if curved single quotes are displayable, and
+like @code{grave} otherwise.
+@end defvar
+
 @node Case Conversion
 @section Case Conversion in Lisp
 @cindex upper case
diff --git a/etc/NEWS b/etc/NEWS
index 0a33a6e..9723dec 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -892,16 +892,25 @@ denied" instead of "permission denied".  The old behavior 
was problematic
 in languages like German where downcasing rules depend on grammar.
 
 +++
+** ‘format’ now replaces curved single quotes.
+That is, it replaces strings' curved single quotes (also known as
+curly quotes) as per the value of the new custom variable
+‘text-quoting-style’: ‘curve’ means replace curved quotes with
+themselves ‘like this’, ‘straight’ means use straight apostrophes
+'like this', ‘grave’ means use grave accent and apostrophe `like
+this', and nil (default) means use curved quotes if displayable and
+grave accent and apostrophe otherwise.  Because it now may be used
+in many contexts where it's a no-op, ‘format’ is no longer required to
+create a string, and may return its first argument if the argument
+already has the correct value.
+
++++
 ** substitute-command-keys now replaces quotes.
 That is, it converts documentation strings' quoting style as per the
-value of the new custom variable ‘text-quoting-style’: ‘curve’ means
-use curved quotes (also known as curly quotes) ‘like this’, ‘straight’
-means use straight apostrophes 'like this', ‘grave’ means use grave
-accent and apostrophe `like this', and nil (default) means use curved
-quotes if displayable and grave accent and apostrophe otherwise.  Doc
-strings in source code can use either curved quotes or grave accent
-and apostrophe.  As before, isolated apostrophes and characters
-preceded by \= are output as-is.
+value of ‘text-quoting-style’ as described above.  Doc strings in
+source code can use either curved quotes or grave accent and
+apostrophe.  As before, isolated apostrophes and characters preceded
+by \= are output as-is.
 
 +++
 ** The character classes [:alpha:] and [:alnum:] in regular expressions
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index b2e7df1..7a1a983 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -365,7 +365,7 @@ C-w  Describe how there is no warranty for Calc."
     (let (Info-history)
       (Info-goto-node (buffer-substring (match-beginning 1) (match-end 1))))
     (let* ((string-target (or target thing))
-           (quoted (format "['`‘]%s['’]" (regexp-quote string-target)))
+           (quoted (concat "['`‘]" (regexp-quote string-target) "['’]"))
            (bracketed (format "\\[%s\\]\\|(%s)\\|\\<The[ \n]%s"
                               quoted quoted quoted)))
       (or (let ((case-fold-search nil))
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index ee137f1..1f8572b 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -331,9 +331,10 @@ which more-or-less shadow%s %s's corresponding table%s."
                        "\n\nThis mode "
                      (concat
                       "\n\nIn addition to any hooks its parent mode "
-                      (if (string-match (format "[`‘]%s['’]"
+                      (if (string-match (concat "[`%‘]"
                                                  (regexp-quote
-                                                 (symbol-name parent)))
+                                                 (symbol-name parent))
+                                                 "['%’]")
                                         docstring)
                            nil
                         (format "`%s' " parent))
diff --git a/lisp/info.el b/lisp/info.el
index 0a2206d..1b02c35 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3398,10 +3398,12 @@ Give an empty topic name to go to the Index node 
itself."
            (re-search-forward (format
                                 "[a-zA-Z]+: [a-zA-Z0-9_ *&]+ %s\\( \\|$\\)"
                                 (regexp-quote name)) nil t)
-           (search-forward (format "['`‘]%s['’]" name) nil t)
+           (search-forward (concat "['`‘]" name "['’]") nil t)
            (and (string-match "\\`.*\\( (.*)\\)\\'" name)
                 (search-forward
-                 (format "['`‘]%s['’]" (substring name 0 (match-beginning 1)))
+                 (concat "['`%‘]"
+                          (substring name 0 (match-beginning 1))
+                          "['%’]")
                  nil t))
            (search-forward name nil t)
            ;; Try again without the " <1>" makeinfo can append
diff --git a/src/doc.c b/src/doc.c
index 36619e1..9864b46 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -684,18 +684,34 @@ 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
-  {
-    LEFT_SINGLE_QUOTATION_MARK = 0x2018,
-    uLSQM0 = 0xE2, uLSQM1 = 0x80, uLSQM2 = 0x98,
-    uRSQM0 = 0xE2, uRSQM1 = 0x80, uRSQM2 = 0x99,
-  };
+/* U+2018 LEFT SINGLE QUOTATION MARK as an integer and as a sequence
+   of bytes.  */
+enum { LEFT_SINGLE_QUOTATION_MARK = 0x2018 };
 static unsigned char const LSQM[] = { uLSQM0, uLSQM1, uLSQM2 };
+
+/* U+2019 RIGHT SINGLE QUOTATION MARK as a sequence of bytes.  */
 static unsigned char const RSQM[] = { uRSQM0, uRSQM1, uRSQM2 };
 
+/* 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.
@@ -750,20 +766,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;
@@ -962,7 +965,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;
@@ -972,7 +975,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++;
@@ -987,9 +990,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 9ff39f9..ed57d8a 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 02109d7..ff20489 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4299,6 +4299,25 @@ extern void set_initial_environment (void);
 extern void syms_of_callproc (void);
 
 /* Defined in doc.c.  */
+enum
+  {
+    /* Named constants for tue 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);
-- 
2.1.0






reply via email to

[Prev in Thread] Current Thread [Next in Thread]