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

[Michael Albinus <michael.albinus@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 675 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> So what, maybe it is sufficient to take over the implementation from
>> glib, indeed. There's not too much logic added there, and we would avoid
>> the glib dependency.
>
> That's what I had in mind, yes.

Finally, I came out with the appended patch. Comments appreciated.

>> do you or somebody else has some test cases for `gstring-lessp' or
>> `gstring-equalp', which shall return different results than
>> `string-lessp' and `string-equal'?
>
> I don't have such test cases, but I'd start by looking in the glib
> test suite.

There aren't so many glib test cases for collation. I need to search further.

Best regards, Michael.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: collate-patch --]
[-- Type: text/x-patch, Size: 5295 bytes --]

*** /usr/local/src/emacs/src/fns.c.~117719~	2014-08-21 10:58:42.195613026 +0200
--- /usr/local/src/emacs/src/fns.c	2014-08-21 10:27:30.986334200 +0200
***************
*** 39,46 ****
  #if defined (HAVE_X_WINDOWS)
  #include "xterm.h"
  #endif

! Lisp_Object Qstring_lessp;
  static Lisp_Object Qprovide, Qrequire;
  static Lisp_Object Qyes_or_no_p_history;
  Lisp_Object Qcursor_in_echo_area;
--- 39,52 ----
  #if defined (HAVE_X_WINDOWS)
  #include "xterm.h"
  #endif
+ #ifdef HAVE_SETLOCALE
+ #include <locale.h>
+ #endif /* HAVE_SETLOCALE */
+ #ifdef __STDC_ISO_10646__
+ #include <wchar.h>
+ #endif /* __STDC_ISO_10646__ */

! 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,348 ****
--- 349,467 ----
      }
    return i1 < SCHARS (s2) ? Qt : Qnil;
  }
+
+ #ifdef __STDC_ISO_10646__
+ 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;
+   char *old_collate, *saved_collate;
+
+   USE_SAFE_ALLOCA;
+
+   /* Check parameters.  */
+   if (SYMBOLP (s1))
+     s1 = SYMBOL_NAME (s1);
+   if (SYMBOLP (s2))
+     s2 = SYMBOL_NAME (s2);
+   CHECK_STRING (s1);
+   CHECK_STRING (s2);
+
+   /* Convert byte stream to code pointers.  */
+   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;
+
+ #ifdef HAVE_SETLOCALE
+   /* Set locale.  */
+   lc_collate =
+     Fgetenv_internal (build_string ("LC_COLLATE"), Vprocess_environment);
+   if (STRINGP (lc_collate))
+     {
+       old_collate = setlocale (LC_COLLATE, NULL);
+       saved_collate = xstrdup (old_collate);
+       setlocale (LC_COLLATE, SSDATA (lc_collate));
+     }
+ #endif /* HAVE_SETLOCALE */
+
+   res = wcscoll (p1, p2);
+
+ #ifdef HAVE_SETLOCALE
+   /* Restore the original locale. */
+   if (STRINGP (lc_collate))
+     setlocale (LC_COLLATE, saved_collate);
+ #endif /* HAVE_SETLOCALE */
+
+   /* Return result.  */
+   SAFE_FREE ();
+   return res;
+ }
+ #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__
+   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__
+   return (str_collate (s1, s2) == 0) ? Qt : Qnil;
+ #else
+   return Fstring_equal (s1, s2);
+ #endif /* __STDC_ISO_10646__ */
+ }
  \f
  static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
  			   enum Lisp_Type target_type, bool last_special);
***************
*** 4919,4924 ****
--- 5038,5045 ----
    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,4977 ****
--- 5093,5100 ----
    defsubr (&Sstring_equal);
    defsubr (&Scompare_strings);
    defsubr (&Sstring_lessp);
+   defsubr (&Sstring_collate_lessp);
+   defsubr (&Sstring_collate_equalp);
    defsubr (&Sappend);
    defsubr (&Sconcat);
    defsubr (&Svconcat);