Re: RFC: locale-sensitive Emacs functions

[Gdobbins <gdobbins@protonmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 81 bytes --]

Attached is a new patch which implements everything requested.

-- Graham Dobbins

[-- Attachment #1.2: Type: text/html, Size: 314 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-new-d-specifier-to-format.patch --]
[-- Type: text/x-patch; name="0001-Add-new-d-specifier-to-format.patch", Size: 9349 bytes --]

From e52eb215cb7dcace3a97180dbc744522db98f4d0 Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Fri, 31 Mar 2017 00:16:17 -0400
Subject: [PATCH] Add new %'d specifier to format.

* src/editfns.c (styled_format): Add the new functionality.
* test/src/editfns-tests.el: Add tests for new functionality.
* doc/lispref/strings.texi: Document new specifier.
---
 doc/lispref/strings.texi  |  16 ++++++
 etc/NEWS                  |   5 ++
 src/editfns.c             | 125 ++++++++++++++++++++++++++++++++++++++++++++--
 test/src/editfns-tests.el |  14 ++++++
 4 files changed, 157 insertions(+), 3 deletions(-)

diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index ae2b31c541..9d5786e26b 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -1030,8 +1030,24 @@ Formatting Strings
 If both @samp{-} and @samp{0} are present, the @samp{0} flag is
 ignored.
 
+  The flag @samp{'} only has defined behavior when combined with the
+@samp{%d} specifier. It causes the number to be printed in groups with
+width determined by @code{format-digit-grouping} and separated by the
+character @code{format-digit-separator}. This action takes place
+before any padding is applied. This flag is typically used to achieve
+more human readable representations of numbers such as
+@samp{"1,234,567"}.
+
 @example
 @group
+(format "%'d" 123456789)
+     @result{} "123,456,789"
+
+(let ((format-digit-grouping 4)
+      (format-digit-separator ?.))
+   (format "%'d" 123456789))
+     @result{} "1.2345.6789"
+
 (format "%06d is padded on the left with zeros" 123)
      @result{} "000123 is padded on the left with zeros"
 
diff --git a/etc/NEWS b/etc/NEWS
index cd98f53399..5105904687 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1055,6 +1055,11 @@ its window gets deleted by 'delete-other-windows'.
 *** New command 'window-swap-states' swaps the states of two live
 windows.
 
++++
+*** 'format' now accepts the specifier "%'d" to format integers into
+groups of size 'format-digit-grouping' with separator
+'format-digit-separator' which default to 3 and comma respectively.
+
 \f
 * Changes in Emacs 26.1 on Non-Free Operating Systems
 
diff --git a/src/editfns.c b/src/editfns.c
index 2dafd8e7b1..eb7d1a4829 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3884,7 +3884,7 @@ specifiers, as follows:
 
   %<flags><width><precision>character
 
-where flags is [+ #-0]+, width is [0-9]+, and precision is a literal
+where flags is [+ #-0\\=']+, width is [0-9]+, and precision is a literal
 period "." followed by [0-9]+
 
 The + flag character inserts a + before any positive number, while a
@@ -3900,6 +3900,12 @@ the precision is zero; for %g, it causes a decimal point to be
 included even if the the precision is zero, and also forces trailing
 zeros after the decimal point to be left in place.
 
+The behavior of the \\=' flag is only defined for %d. The argument is
+printed in groupings whose size is dictated by `format-digit-grouping'
+and are separated by `format-digit-separator'. This is typically used
+to print more human readable representations of numbers like
+"1,000." This action takes place before any padding is done.
+
 The width specifier supplies a lower limit for the length of the
 printed representation.  The padding, if any, normally goes on the
 left, but it goes on the right if the - flag is present.  The padding
@@ -4042,7 +4048,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 
 	     where
 
-	     flags ::= [-+0# ]+
+	     flags ::= [-+0# ']+
 	     field-width ::= [0-9]+
 	     precision ::= '.' [0-9]*
 
@@ -4059,6 +4065,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 	  bool space_flag = false;
 	  bool sharp_flag = false;
 	  bool  zero_flag = false;
+	  bool  apos_flag = false;
 
 	  for (; ; format++)
 	    {
@@ -4069,6 +4076,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 		case ' ': space_flag = true; continue;
 		case '#': sharp_flag = true; continue;
 		case '0':  zero_flag = true; continue;
+		case '\'': apos_flag = true; continue;
 		}
 	      break;
 	    }
@@ -4274,7 +4282,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 		   precision is no more than USEFUL_PRECISION_MAX.
 		   On all practical hosts, %f is the worst case.  */
 		SPRINTF_BUFSIZE =
-		  sizeof "-." + (LDBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX,
+		max (sizeof "-." + (LDBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX,
+		     (INT_BUFSIZE_BOUND (printmax_t)
+		      + (INT_STRLEN_BOUND (printmax_t) - 2)
+		      * MAX_MULTIBYTE_LENGTH)),
 
 		/* Length of pM (that is, of pMd without the
 		   trailing "d").  */
@@ -4381,6 +4392,100 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 			}
 		    }
 		  sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x);
+
+		  if (apos_flag)
+		    {
+		      CHECK_CHARACTER (Vformat_digit_separator);
+		      int separator = XFASTINT (Vformat_digit_separator);
+
+                      int separator_size = CHAR_BYTES (separator);
+		      if (separator_size != 1 && !multibyte)
+			{
+			  multibyte = true;
+			  goto retry;
+			}
+
+		      ptrdiff_t beg_pos = 0;
+		      for (; !('0' <= sprintf_buf[beg_pos]
+			       && sprintf_buf[beg_pos] <= '9');
+			   ++beg_pos);
+
+		      Lisp_Object real_grouping = Vformat_digit_grouping;
+		      EMACS_INT grouping;
+		      ptrdiff_t separator_count;
+
+		      if (CONSP (real_grouping))
+			{
+			  EMACS_INT temp_bytes = sprintf_bytes;
+			  EMACS_INT temp_grouping;
+			  separator_count = 0;
+			  FOR_EACH_TAIL (real_grouping)
+			    {
+			      CHECK_RANGED_INTEGER (XCAR (real_grouping),
+						    1, MOST_POSITIVE_FIXNUM);
+			      temp_grouping = XINT (XCAR (real_grouping));
+			      if (temp_bytes > beg_pos + temp_grouping)
+				{
+				  temp_bytes -= temp_grouping;
+				  ++separator_count;
+				  if (NILP (XCDR (real_grouping)))
+				    {
+				      separator_count
+					+= ((temp_bytes - beg_pos - 1)
+					    / temp_grouping);
+				    }
+				}
+			      else
+				break;
+			    }
+			  real_grouping = Vformat_digit_grouping;
+			  grouping = XINT (XCAR (real_grouping));
+			}
+		      else
+			{
+			  CHECK_RANGED_INTEGER (real_grouping,
+						1, MOST_POSITIVE_FIXNUM);
+			  grouping = XINT (real_grouping);
+			  separator_count = (sprintf_bytes - beg_pos - 1) / grouping;
+			}
+		      separator_count *= separator_size;
+
+		      EMACS_INT group_count = -2;
+
+		      for (ptrdiff_t i = sprintf_bytes + 1; i > beg_pos; --i)
+			{
+                          sprintf_buf[i + separator_count] = sprintf_buf[i];
+			  ++group_count;
+
+			  if (group_count == grouping)
+			    {
+			      separator_count -= separator_size;
+
+			      if (separator_size == 1)
+				sprintf_buf[i + separator_count] = separator;
+			      else
+				{
+				  CHAR_STRING (separator,
+					       (unsigned char *)
+					       (sprintf_buf + i  + separator_count));
+				  nchars -= (separator_size - 1);
+				}
+
+			      if (CONSP (real_grouping)
+				  && !NILP (XCDR (real_grouping)))
+				{
+				  real_grouping = XCDR (real_grouping);
+				  CHECK_RANGED_INTEGER
+				    (XCAR (real_grouping),
+				     1, MOST_POSITIVE_FIXNUM);
+				  grouping = XINT (XCAR (real_grouping));
+				}
+
+			      group_count = 0;
+			      sprintf_bytes += separator_size;
+			    }
+			}
+		    }
 		}
 	      else
 		{
@@ -5171,6 +5276,20 @@ functions if all the text being accessed has this property.  */);
   DEFVAR_LISP ("operating-system-release", Voperating_system_release,
 	       doc: /* The release of the operating system Emacs is running on.  */);
 
+  DEFVAR_LISP ("format-digit-grouping",
+	       Vformat_digit_grouping,
+	       doc: /* Number of digits in each group of a formatted
+number in `format'. If a list, the first number applies to the least
+significant grouping and so on, with the last number applying to all
+remaining groupings.  */);
+  Vformat_digit_grouping = make_number (3);
+
+  DEFVAR_LISP ("format-digit-separator",
+	       Vformat_digit_separator,
+	       doc: /* Character to use as grouping separator for
+formatted numbers in `format'.  */);
+  Vformat_digit_separator = make_number (',');
+
   defsubr (&Spropertize);
   defsubr (&Schar_equal);
   defsubr (&Sgoto_char);
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 14124ef85f..231c72ead6 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -136,4 +136,18 @@ transpose-test-get-byte-positions
 (ert-deftest format-c-float ()
   (should-error (format "%c" 0.5)))
 
+(ert-deftest format-quote-d ()
+  (let ((format-digit-grouping 3)
+        (format-digit-separator ?,))
+    (should (string= (format "%'d" 123456789) "123,456,789"))
+    (should (string= (format "%+'d" 123456789) "+123,456,789"))
+    (should (string= (format "% 'd" 123456789) " 123,456,789"))
+    (should (string= (format "%0'15d" 123456789) "0000123,456,789"))
+    (let ((format-digit-grouping 1))
+      (should (string= (format "%'d" -123456789) "-1,2,3,4,5,6,7,8,9")))
+    (let ((format-digit-grouping '(3 2)))
+      (should (string= (format "%'d" 123456789) "12,34,56,789")))
+    (let ((format-digit-separator ?Ĭ))
+      (should (string= (format "%'d" 123456789) "123Ĭ456Ĭ789")))))
+
 ;;; editfns-tests.el ends here
-- 
2.12.1