*** /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 + #endif /* HAVE_SETLOCALE */ + #ifdef __STDC_ISO_10646__ + #include + #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__ */ + } 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);