return i1 < SCHARS (s2) ? Qt : Qnil;
}
-DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 2, 0,
+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.
-
-Case is significant. Symbols are also allowed; their print names are
-used instead.
+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.
+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'.
+The optional argument LOCALE, a string, overrides the setting of your
+current locale identifier for collation. The value is system
+dependent; a LOCALE \"en_US.UTF-8\" is applicable on POSIX systems,
+while it would be \"English_USA.1252\" on MS Windows systems.
-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)
+If IGNORE-CASE is non-nil, characters are converted to lower-case
+before comparing them.
+
+If your system does not support a locale environment, this function
+behaves like `string-lessp'. */)
+ (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case)
{
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
/* Check parameters. */
s2 = SYMBOL_NAME (s2);
CHECK_STRING (s1);
CHECK_STRING (s2);
+ if (!NILP (locale))
+ CHECK_STRING (locale);
- return (str_collate (s1, s2) < 0) ? Qt : Qnil;
+ return (str_collate (s1, s2, locale, ignore_case) < 0) ? Qt : Qnil;
#else /* !__STDC_ISO_10646__, !WINDOWSNT */
return Fstring_lessp (s1, s2);
#endif /* !__STDC_ISO_10646__, !WINDOWSNT */
}
-DEFUN ("string-collate-equalp", Fstring_collate_equalp, Sstring_collate_equalp, 2, 2, 0,
+DEFUN ("string-collate-equalp", Fstring_collate_equalp, Sstring_collate_equalp, 2, 4, 0,
doc: /* Return t if two strings have identical contents.
-
-Case is significant. Symbols are also allowed; their print names are
-used instead.
+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.
+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'.
+The optional argument LOCALE, a string, overrides the setting of your
+current locale identifier for collation. The value is system
+dependent; a LOCALE \"en_US.UTF-8\" is applicable on POSIX systems,
+while it would be \"English_USA.1252\" on MS Windows systems.
-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)
+If IGNORE-CASE is non-nil, characters are converted to lower-case
+before comparing them.
+
+If your system does not support a locale environment, this function
+behaves like `string-equal'. */)
+ (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case)
{
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
/* Check parameters. */
s2 = SYMBOL_NAME (s2);
CHECK_STRING (s1);
CHECK_STRING (s2);
+ if (!NILP (locale))
+ CHECK_STRING (locale);
- return (str_collate (s1, s2) == 0) ? Qt : Qnil;
+ return (str_collate (s1, s2, locale, ignore_case) == 0) ? Qt : Qnil;
#else /* !__STDC_ISO_10646__, !WINDOWSNT */
return Fstring_equal (s1, s2);
#ifdef __STDC_ISO_10646__
# include <wchar.h>
+# include <wctype.h>
# if defined HAVE_NEWLOCALE || defined HAVE_SETLOCALE
# include <locale.h>
# ifndef LC_COLLATE_MASK
# define LC_COLLATE_MASK 0
# endif
+# ifndef LC_CTYPE
+# define LC_CTYPE 0
+# endif
+# ifndef LC_CTYPE_MASK
+# define LC_CTYPE_MASK 0
+# endif
+
# ifndef HAVE_NEWLOCALE
# undef freelocale
# undef locale_t
# undef newlocale
# undef wcscoll_l
+# undef towlower_l
# define freelocale emacs_freelocale
# define locale_t emacs_locale_t
# define newlocale emacs_newlocale
# define wcscoll_l emacs_wcscoll_l
+# define towlower_l emacs_towlower_l
typedef char const *locale_t;
errno = err;
return result;
}
+
+static wint_t
+towlower_l (wint_t wc, locale_t loc)
+{
+ wint_t result = wc;
+ char *oldloc = emacs_setlocale (LC_CTYPE, NULL);
+
+ if (oldloc)
+ {
+ USE_SAFE_ALLOCA;
+ char *oldcopy = SAFE_ALLOCA (strlen (oldloc) + 1);
+ strcpy (oldcopy, oldloc);
+ if (emacs_setlocale (LC_CTYPE, loc))
+ {
+ result = towlower (wc);
+ emacs_setlocale (LC_COLLATE, oldcopy);
+ }
+ SAFE_FREE ();
+ }
+
+ return result;
+}
# endif
int
-str_collate (Lisp_Object s1, Lisp_Object s2)
+str_collate (Lisp_Object s1, Lisp_Object s2,
+ Lisp_Object locale, Lisp_Object ignore_case)
{
int res, err;
ptrdiff_t len, i, i_byte;
wchar_t *p1, *p2;
- Lisp_Object lc_collate;
USE_SAFE_ALLOCA;
FETCH_STRING_CHAR_ADVANCE (*(p2+i-1), s2, i, i_byte);
*(p2+len) = 0;
- lc_collate =
- Fgetenv_internal (build_string ("LC_COLLATE"), Vprocess_environment);
-
- if (STRINGP (lc_collate))
+ if (STRINGP (locale))
{
- locale_t loc = newlocale (LC_COLLATE_MASK, SSDATA (lc_collate), 0);
+ locale_t loc = newlocale (LC_COLLATE_MASK | LC_CTYPE_MASK,
+ SSDATA (locale), 0);
if (!loc)
error ("Wrong locale: %s", strerror (errno));
errno = 0;
- res = wcscoll_l (p1, p2, loc);
+
+ if (! NILP (ignore_case))
+ for (int i = 1; i < 3; i++)
+ {
+ wchar_t *p = (i == 1) ? p1 : p2;
+ for (; *p; p++)
+ {
+ *p = towlower_l (*p, loc);
+ if (errno)
+ break;
+ }
+ if (errno)
+ break;
+ }
+
+ if (! errno)
+ res = wcscoll_l (p1, p2, loc);
err = errno;
freelocale (loc);
}
else
{
errno = 0;
+ if (! NILP (ignore_case))
+ for (int i = 1; i < 3; i++)
+ {
+ wchar_t *p = (i == 1) ? p1 : p2;
+ for (; *p; p++)
+ *p = towlower (*p);
+ }
res = wcscoll (p1, p2);
err = errno;
}
SAFE_FREE ();
return res;
}
-#endif /* __STDC_ISO_10646__ */
+#endif /* __STDC_ISO_10646__ */
#ifdef WINDOWSNT
int
-str_collate (Lisp_Object s1, Lisp_Object s2)
-{
- Lisp_Object lc_collate =
- Fgetenv_internal (build_string ("LC_COLLATE"), Vprocess_environment);
- char *loc = STRINGP (lc_collate) ? SSDATA (lc_collate) : NULL;
+str_collate (Lisp_Object s1, Lisp_Object s2,
+{ Lisp_Object locale, Lisp_Object ignore_case)
+
+ char *loc = STRINGP (locale) ? SSDATA (locale) : NULL;
return w32_compare_strings (SDATA (s1), SDATA (s2), loc);
}