=== 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 16:36:39 +0000 @@ -3513,3 +3513,63 @@ } #endif /* !defined (WINDOWSNT) */ + +/* Wide character string collation. */ + +#ifdef __STDC_ISO_10646__ +#include + +#ifdef HAVE_USELOCALE +#include +#endif /* HAVE_USELOCALE */ + +ptrdiff_t +str_collate (Lisp_Object s1, Lisp_Object s2) +{ + register ptrdiff_t res, len, i, i_byte; + wchar_t *p1, *p2; +#ifdef HAVE_USELOCALE + Lisp_Object lc_collate; + locale_t loc = (locale_t) 0, oldloc = (locale_t) 0; +#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; + +#ifdef HAVE_USELOCALE + /* Create a new locale object, and set it. */ + lc_collate = + Fgetenv_internal (build_string ("LC_COLLATE"), Vprocess_environment); + + if (STRINGP (lc_collate) + && (loc = newlocale (LC_COLLATE_MASK, SSDATA (lc_collate), (locale_t) 0))) + oldloc = uselocale (loc); +#endif /* HAVE_USELOCALE */ + + res = wcscoll (p1, p2); + +#ifdef HAVE_USELOCALE + /* Free the locale object, and reset. */ + if (loc) + freelocale (loc); + if (oldloc) + uselocale (oldloc); +#endif /* HAVE_USELOCALE */ + + /* Return result. */ + SAFE_FREE (); + return res; +} +#endif /* __STDC_ISO_10646__ */