Subject: bug#18051: 24.3.92; ls-lisp: Sorting; make ls-lisp-string-lessp a normal function?

From: Michael Albinus <[email-masked]>
Date: Sat, 23 Aug 2014 22:32:00 +0200

Eli Zaretskii <[email-masked]> writes:

>> > Btw, I wonder whether we should have a way to pass the locale string
>> > explicitly, instead of relying on $LC_COLLATE.
>> 
>> We could add an optional argument to string-collate-*. But this would
>> break signature equivalence with string-lessp and string-equal,
>> respectively.
>> 
>> Or we could introduce a global var, which shall be let-bound to the
>> locale string.
>
> Or have a new optional argument in string-lessp etc., or introduce a
> new set of APIs which will accept a locale, and have string-lessp
> etc. call them with that argument nil.

An optional argument to string-lessp could be inconvenient. IMHO, the
most important use-case of string-lessp is being a PREDICATE of
sort. This does not support optional arguments.

>> This raises the question, whether we shall use also my first setlocale
>> approach in case of uselocale absence?
>
> I think so, yes.

Extended patch appended.

Best regards, Michael.

=== modified file 'src/fns.c'
--- src/fns.c	2014-08-02 15:56:18 +0000
+++ src/fns.c	2014-08-23 15:57:06 +0000
@@ -40,7 +40,7 @@
 #include "xterm.h"
 #endif
 
-Lisp_Object Qstring_lessp;
+Lisp_Object Qstring_lessp, Qstring_collate_lessp, Qstring_collate_equalp;
 static Lisp_Object Qprovide, Qrequire;
 static Lisp_Object Qyes_or_no_p_history;
 Lisp_Object Qcursor_in_echo_area;
@@ -343,6 +343,84 @@
     }
   return i1 < SCHARS (s2) ? Qt : Qnil;
 }
+
+#ifdef __STDC_ISO_10646__
+/* Defined in sysdep.c.  */
+extern ptrdiff_t str_collate (Lisp_Object, Lisp_Object);
+#endif /* __STDC_ISO_10646__ */
+
+DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 2, 0,
+       doc: /* Return t if first arg string is less than second in collation order.
+
+Case is significant.  Symbols are also allowed; their print names are
+used instead.
+
+This function obeys the conventions for collation order in your
+locale settings.  For example, punctuation and whitespace characters
+are considered less significant for sorting.
+
+\(sort '\("11" "12" "1 1" "1 2" "1.1" "1.2") 'string-collate-lessp)
+  => \("11" "1 1" "1.1" "12" "1 2" "1.2")
+
+If your system does not support a locale environment, this function
+behaves like `string-lessp'.
+
+If the environment variable \"LC_COLLATE\" is set in `process-environment',
+it overrides the setting of your current locale.  */)
+  (Lisp_Object s1, Lisp_Object s2)
+{
+#ifdef __STDC_ISO_10646__
+  /* Check parameters.  */
+  if (SYMBOLP (s1))
+    s1 = SYMBOL_NAME (s1);
+  if (SYMBOLP (s2))
+    s2 = SYMBOL_NAME (s2);
+  CHECK_STRING (s1);
+  CHECK_STRING (s2);
+
+  return (str_collate (s1, s2) < 0) ? Qt : Qnil;
+
+#else
+  return Fstring_lessp (s1, s2);
+#endif /* __STDC_ISO_10646__ */
+}
+
+DEFUN ("string-collate-equalp", Fstring_collate_equalp, Sstring_collate_equalp, 2, 2, 0,
+       doc: /* Return t if two strings have identical contents.
+
+Case is significant.  Symbols are also allowed; their print names are
+used instead.
+
+This function obeys the conventions for collation order in your locale
+settings.  For example, characters with different coding points but
+the same meaning are considered as equal, like different grave accent
+unicode characters.
+
+\(string-collate-equalp \(string ?\\uFF40) \(string ?\\u1FEF))
+  => t
+
+If your system does not support a locale environment, this function
+behaves like `string-equal'.
+
+If the environment variable \"LC_COLLATE\" is set in `process-environment',
+it overrides the setting of your current locale.  */)
+  (Lisp_Object s1, Lisp_Object s2)
+{
+#ifdef __STDC_ISO_10646__
+  /* Check parameters.  */
+  if (SYMBOLP (s1))
+    s1 = SYMBOL_NAME (s1);
+  if (SYMBOLP (s2))
+    s2 = SYMBOL_NAME (s2);
+  CHECK_STRING (s1);
+  CHECK_STRING (s2);
+
+  return (str_collate (s1, s2) == 0) ? Qt : Qnil;
+
+#else
+  return Fstring_equal (s1, s2);
+#endif /* __STDC_ISO_10646__ */
+}
 
 static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
 			   enum Lisp_Type target_type, bool last_special);
@@ -4919,6 +4997,8 @@
   defsubr (&Sdefine_hash_table_test);
 
   DEFSYM (Qstring_lessp, "string-lessp");
+  DEFSYM (Qstring_collate_lessp, "string-collate-lessp");
+  DEFSYM (Qstring_collate_equalp, "string-collate-equalp");
   DEFSYM (Qprovide, "provide");
   DEFSYM (Qrequire, "require");
   DEFSYM (Qyes_or_no_p_history, "yes-or-no-p-history");
@@ -4972,6 +5052,8 @@
   defsubr (&Sstring_equal);
   defsubr (&Scompare_strings);
   defsubr (&Sstring_lessp);
+  defsubr (&Sstring_collate_lessp);
+  defsubr (&Sstring_collate_equalp);
   defsubr (&Sappend);
   defsubr (&Sconcat);
   defsubr (&Svconcat);

=== modified file 'src/sysdep.c'
--- src/sysdep.c	2014-07-14 19:23:18 +0000
+++ src/sysdep.c	2014-08-23 20:23:11 +0000
@@ -3513,3 +3513,77 @@
 }
 
 #endif	/* !defined (WINDOWSNT) */
+
+/* Wide character string collation.  */
+
+#ifdef __STDC_ISO_10646__
+#include <wchar.h>
+
+#if defined (HAVE_USELOCALE) || defined (HAVE_SETLOCALE)
+#include <locale.h>
+#endif /* HAVE_USELOCALE || HAVE_SETLOCALE */
+
+ptrdiff_t
+str_collate (Lisp_Object s1, Lisp_Object s2)
+{
+  register ptrdiff_t res, len, i, i_byte;
+  wchar_t *p1, *p2;
+  Lisp_Object lc_collate;
+#ifdef HAVE_USELOCALE
+  locale_t loc = (locale_t) 0, oldloc = (locale_t) 0;
+#elif defined (HAVE_SETLOCALE)
+  char *oldloc = NULL;
+#endif /* HAVE_USELOCALE */
+
+  USE_SAFE_ALLOCA;
+
+  /* Convert byte stream to code points.  */
+  len = SCHARS (s1); i = i_byte = 0;
+  p1 = (wchar_t *) SAFE_ALLOCA ((len+1) * (sizeof *p1));
+  while (i < len)
+    FETCH_STRING_CHAR_ADVANCE (*(p1+i-1), s1, i, i_byte);
+  *(p1+len) = 0;
+
+  len = SCHARS (s2); i = i_byte = 0;
+  p2 = (wchar_t *) SAFE_ALLOCA ((len+1) * (sizeof *p2));
+  while (i < len)
+    FETCH_STRING_CHAR_ADVANCE (*(p2+i-1), s2, i, i_byte);
+  *(p2+len) = 0;
+
+#if defined (HAVE_USELOCALE) || defined (HAVE_SETLOCALE)
+  /* Create a new locale object, and set it.  */
+  lc_collate =
+    Fgetenv_internal (build_string ("LC_COLLATE"), Vprocess_environment);
+
+#ifdef HAVE_USELOCALE
+  if (STRINGP (lc_collate)
+      && (loc = newlocale (LC_COLLATE_MASK, SSDATA (lc_collate), (locale_t) 0)))
+    oldloc = uselocale (loc);
+#elif defined (HAVE_SETLOCALE)
+  if (STRINGP (lc_collate))
+    {
+      oldloc = xstrdup (setlocale (LC_COLLATE, NULL));
+      setlocale (LC_COLLATE, SSDATA (lc_collate));
+    }
+#endif /* HAVE_USELOCALE */
+#endif /* HAVE_USELOCALE || HAVE_SETLOCALE */
+
+  res = wcscoll (p1, p2);
+
+#ifdef HAVE_USELOCALE
+  /* Free the locale object, and reset.  */
+  if (loc)
+    freelocale (loc);
+  if (oldloc)
+    uselocale (oldloc);
+#elif defined (HAVE_SETLOCALE)
+  /* Restore the original locale. */
+  if (oldloc)
+    setlocale (LC_COLLATE, oldloc);
+#endif /* HAVE_USELOCALE */
+
+  /* Return result.  */
+  SAFE_FREE ();
+  return res;
+}
+#endif /* __STDC_ISO_10646__ */