1 files changed, 50 insertions, 3 deletions

diff --git a/src/fns.c b/src/fns.c
index 86ad333702e..d314fcd0711 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -21,8 +21,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <config.h>
 
 #include <unistd.h>
+#include <filevercmp.h>
 #include <intprops.h>
 #include <vla.h>
+#include <errno.h>
 
 #include "lisp.h"
 #include "character.h"
@@ -331,6 +333,50 @@ Symbols are also allowed; their print names are used instead.  */)
   return i1 < SCHARS (string2) ? Qt : Qnil;
 }
 
+DEFUN ("string-version-lessp", Fstring_version_lessp,
+       Sstring_version_lessp, 2, 2, 0,
+       doc: /* Return non-nil if S1 is less than S2, as version strings.
+
+This function compares version strings S1 and S2:
+   1) By prefix lexicographically.
+   2) Then by version (similarly to version comparison of Debian's dpkg).
+      Leading zeros in version numbers are ignored.
+   3) If both prefix and version are equal, compare as ordinary strings.
+
+For example, \"foo2.png\" compares less than \"foo12.png\".
+Case is significant.
+Symbols are also allowed; their print names are used instead.  */)
+  (Lisp_Object string1, Lisp_Object string2)
+{
+  if (SYMBOLP (string1))
+    string1 = SYMBOL_NAME (string1);
+  if (SYMBOLP (string2))
+    string2 = SYMBOL_NAME (string2);
+  CHECK_STRING (string1);
+  CHECK_STRING (string2);
+
+  char *p1 = SSDATA (string1);
+  char *p2 = SSDATA (string2);
+  char *lim1 = p1 + SBYTES (string1);
+  char *lim2 = p2 + SBYTES (string2);
+  int cmp;
+
+  while ((cmp = filevercmp (p1, p2)) == 0)
+    {
+      /* If the strings are identical through their first null bytes,
+	 skip past identical prefixes and try again.  */
+      ptrdiff_t size = strlen (p1) + 1;
+      p1 += size;
+      p2 += size;
+      if (lim1 < p1)
+	return lim2 < p2 ? Qnil : Qt;
+      if (lim2 < p2)
+	return Qnil;
+    }
+
+  return cmp < 0 ? 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.
@@ -1349,7 +1395,7 @@ The value is actually the tail of LIST whose car is ELT.  */)
   (register Lisp_Object elt, Lisp_Object list)
 {
   register Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
+  for (tail = list; !NILP (tail); tail = XCDR (tail))
     {
       register Lisp_Object tem;
       CHECK_LIST_CONS (tail, list);
@@ -1397,7 +1443,7 @@ The value is actually the tail of LIST whose car is ELT.  */)
   if (!FLOATP (elt))
     return Fmemq (elt, list);
 
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
+  for (tail = list; !NILP (tail); tail = XCDR (tail))
     {
       register Lisp_Object tem;
       CHECK_LIST_CONS (tail, list);
@@ -1710,7 +1756,7 @@ changing the value of a sequence `foo'.  */)
     {
       Lisp_Object tail, prev;
 
-      for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
+      for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
 	{
 	  CHECK_LIST_CONS (tail, seq);
 
@@ -5049,6 +5095,7 @@ this variable.  */);
   defsubr (&Sstring_equal);
   defsubr (&Scompare_strings);
   defsubr (&Sstring_lessp);
+  defsubr (&Sstring_version_lessp);
   defsubr (&Sstring_collate_lessp);
   defsubr (&Sstring_collate_equalp);
   defsubr (&Sappend);