Add the string-numeric-lessp function

* doc/lispref/strings.texi (Text Comparison): Document
`string-numerical-lessp'.

* src/fns.c (Fstring_numeric_lessp): New function.
(gather_number_from_string): Helper function for that function.

* test/src/fns-tests.el (fns-tests-string-numeric-lessp): Add tests.

1 files changed, 98 insertions, 0 deletions

diff --git a/src/fns.c b/src/fns.c
index d1808440966..927fcdac02d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -331,6 +331,103 @@ Symbols are also allowed; their print names are used instead.  */)
   return i1 < SCHARS (string2) ? Qt : Qnil;
 }
 
+/* Return the numerical value of a consecutive run of numerical
+   characters from STRING.  The ISP and ISP_BYTE address pointer
+   pointers are increased and left at the next character after the
+   numerical characters. */
+static size_t
+gather_number_from_string (int c, Lisp_Object string,
+                           ptrdiff_t *isp, ptrdiff_t *isp_byte)
+{
+  size_t number = c - '0';
+  unsigned char *chp;
+  int chlen;
+
+  do
+    {
+      if (STRING_MULTIBYTE (string))
+        {
+          chp = &SDATA (string)[*isp_byte];
+          c = STRING_CHAR_AND_LENGTH (chp, chlen);
+        }
+      else
+        {
+          c = SREF (string, *isp_byte);
+          chlen = 1;
+        }
+
+      /* If we're still in a number, add it to the sum and continue. */
+      /* FIXME: Integer overflow? */
+      if (c >= '0' && c <= '9')
+        {
+          number = number * 10;
+          number += c - '0';
+          (*isp)++;
+          (*isp_byte) += chlen;
+        }
+      else
+        break;
+    }
+  /* Stop when we get to the end of the string anyway. */
+  while (c != 0);
+
+  return number;
+}
+
+DEFUN ("string-numeric-lessp", Fstring_numeric_lessp,
+       Sstring_numeric_lessp, 2, 2, 0,
+       doc: /* Return non-nil if STRING1 is less than STRING2 in 'numeric' order.
+Sequences of non-numerical characters are compared lexicographically,
+while sequences of numerical characters are converted into numbers,
+and then the numbers are compared.  This means that \"foo2.png\" is
+less than \"foo12.png\" according to this predicate.
+Case is significant.
+Symbols are also allowed; their print names are used instead.  */)
+  (register Lisp_Object string1, Lisp_Object string2)
+{
+  ptrdiff_t end;
+  ptrdiff_t i1, i1_byte, i2, i2_byte;
+  size_t num1, num2;
+
+  if (SYMBOLP (string1))
+    string1 = SYMBOL_NAME (string1);
+  if (SYMBOLP (string2))
+    string2 = SYMBOL_NAME (string2);
+  CHECK_STRING (string1);
+  CHECK_STRING (string2);
+
+  i1 = i1_byte = i2 = i2_byte = 0;
+
+  end = SCHARS (string1);
+  if (end > SCHARS (string2))
+    end = SCHARS (string2);
+
+  while (i1 < end)
+    {
+      /* When we find a mismatch, we must compare the
+         characters, not just the bytes.  */
+      int c1, c2;
+
+      FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
+      FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
+
+      if (c1 >= '0' && c1 <= '9' &&
+          c2 >= '0' && c2 <= '9')
+        /* Both strings are numbers, so compare them. */
+        {
+          num1 = gather_number_from_string (c1, string1, &i1, &i1_byte);
+          num2 = gather_number_from_string (c2, string2, &i2, &i2_byte);
+          if (num1 < num2)
+            return Qt;
+          else if (num1 > num2)
+            return Qnil;
+        }
+      else if (c1 != c2)
+        return c1 < c2 ? Qt : Qnil;
+    }
+  return i1 < SCHARS (string2) ? Qt : Qnil;
+}
+
 DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
        doc: /* Return t if first arg string is less than second in collation order.
 Symbols are also allowed; their print names are used instead.
@@ -5049,6 +5146,7 @@ this variable.  */);
   defsubr (&Sstring_equal);
   defsubr (&Scompare_strings);
   defsubr (&Sstring_lessp);
+  defsubr (&Sstring_numeric_lessp);
   defsubr (&Sstring_collate_lessp);
   defsubr (&Sstring_collate_equalp);
   defsubr (&Sappend);