Changes from arch/CVS synchronization

8 files changed, 1185 insertions, 292 deletions

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 20186db64..cc567810b 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,40 @@
+2006-11-18  Ludovic Courtès  <ludovic.courtes@laas.fr>
+
+	* Makefile.am (lib_LTLIBRARIES): Added `libguile-i18n-v-XX.la'.
+	(libguile_la_SOURCES): Added `gettext.c', removed `i18n.c'.
+	(libguile_i18n_v_XX_la_SOURCES, libguile_i18n_v_XX_la_CFLAGS,
+	libguile_i18n_v_XX_la_LIBADD, libguile_i18n_v_XX_la_LDFLAGS): New.
+	(DOT_X_FILES): Added `gettext.x'.
+	(DOT_DOC_FILES): Likewise.
+	(EXTRA_libguile_la_SOURCES): Added `locale-categories.h'.
+	(modinclude_HEADERS): Added `gettext.h'.
+	(EXTRA_DIST): Added `libgettext.h'.
+
+	* gettext.h: Renamed to...
+	* libgettext.h: New file.
+
+	* i18n.c: Renamed to...
+	* gettext.c: New file.
+
+	* i18n.h: Renamed to...
+	* gettext.h: New file.
+
+	* i18n.c, i18n.h, locale-categories.h: New files.
+
+	* init.c: Include "libguile/gettext.h" instead of
+	"libguile/i18n.h".
+	(scm_i_init_guile): Invoke `scm_init_gettext ()' instead of
+	`scm_init_i18n ()'.
+
+	* posix.c: Include "libguile/gettext.h" instead of
+	"libguile/i18n.h"  Test `HAVE_NEWLOCALE' and `HAVE_STRCOLL_L'.
+	(USE_GNU_LOCALE_API): New macro.
+	(scm_i_locale_mutex): New variable.
+	(scm_setlocale): Lock and unlock it around `setlocale ()' calls.
+
+	* posix.h: Include "libguile/threads.h".
+	(scm_i_locale_mutex): New declaration.
+
 2006-11-17  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* script.c (scm_shell_usage): Note need for subscription to bug-guile@gnu.org.
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index e8a161afa..47220ddb6 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -31,7 +31,8 @@ INCLUDES = -I.. -I$(top_srcdir)
 ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \
    --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/'
 
-lib_LTLIBRARIES = libguile.la
+lib_LTLIBRARIES = libguile.la						\
+		  libguile-i18n-v-@LIBGUILE_I18N_MAJOR@.la
 bin_PROGRAMS = guile
 
 noinst_PROGRAMS = guile_filter_doc_snarfage gen-scmconfig
@@ -97,9 +98,10 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
     deprecated.c discouraged.c dynwind.c eq.c error.c	\
     eval.c evalext.c extensions.c feature.c fluids.c fports.c		\
     futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c		\
-    gc-freelist.c gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c	\
+    gc-freelist.c gc_os_dep.c gdbint.c gettext.c			\
+    gh_data.c gh_eval.c gh_funcs.c					\
     gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c		\
-    guardians.c hash.c hashtab.c hooks.c i18n.c init.c inline.c		\
+    guardians.c hash.c hashtab.c hooks.c init.c inline.c		\
     ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c		\
     modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c	\
     print.c procprop.c procs.c properties.c random.c rdelim.c read.c	\
@@ -109,11 +111,21 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
     throw.c values.c variable.c vectors.c version.c vports.c weaks.c	\
     ramap.c unif.c
 
+libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c
+libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_CFLAGS =	\
+   $(libguile_la_CFLAGS)
+libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LIBADD =	\
+   libguile.la
+libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS =	\
+   -module -L$(builddir) -lguile				\
+   -version-info @LIBGUILE_I18N_INTERFACE@
+
 DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	\
     continuations.x debug.x deprecation.x deprecated.x discouraged.x	\
     dynl.x dynwind.x eq.x error.x eval.x evalext.x	\
     extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x	\
-    gc-segment.x gc-malloc.x gc-card.x goops.x gsubr.x guardians.x	\
+    gc-segment.x gc-malloc.x gc-card.x gettext.x goops.x		\
+    gsubr.x guardians.x							\
     hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x	\
     list.x load.x macros.x mallocs.x modules.x numbers.x objects.x	\
     objprop.x options.x pairs.x ports.x print.x procprop.x procs.x	\
@@ -131,7 +143,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc		\
     eq.doc error.doc eval.doc evalext.doc		\
     extensions.doc feature.doc fluids.doc fports.doc futures.doc	\
     gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc		\
-    gc-malloc.doc gc-card.doc guardians.doc hash.doc hashtab.doc	\
+    gc-malloc.doc gc-card.doc gettext.doc				\
+    guardians.doc hash.doc hashtab.doc					\
     hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc		\
     list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc	\
     objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc	\
@@ -153,8 +166,9 @@ EXTRA_libguile_la_SOURCES = _scm.h		\
     inet_aton.c memmove.c putenv.c strerror.c	\
     dynl.c regex-posix.c			\
     filesys.c posix.c net_db.c socket.c		\
-    debug-malloc.c mkstemp.c	\
-    win32-uname.c win32-dirent.c win32-socket.c
+    debug-malloc.c mkstemp.c			\
+    win32-uname.c win32-dirent.c win32-socket.c	\
+    locale-categories.h
 
 ## delete guile-snarf.awk from the installation bindir, in case it's
 ## lingering there due to an earlier guile version not having been
@@ -187,7 +201,8 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h	\
     deprecation.h deprecated.h discouraged.h dynl.h dynwind.h		\
     eq.h error.h eval.h evalext.h extensions.h		\
     feature.h filesys.h fluids.h fports.h futures.h gc.h		\
-    gdb_interface.h gdbint.h goops.h gsubr.h guardians.h hash.h		\
+    gdb_interface.h gdbint.h gettext.h goops.h				\
+    gsubr.h guardians.h hash.h						\
     hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h		\
     keywords.h lang.h list.h load.h macros.h mallocs.h modules.h	\
     net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h	\
@@ -212,7 +227,7 @@ EXTRA_DIST = ChangeLog-gh ChangeLog-scm ChangeLog-threads		\
     cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c		\
     cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk	\
     c-tokenize.lex version.h.in \
-    scmconfig.h.top gettext.h
+    scmconfig.h.top libgettext.h
 #    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
 #    guile-procedures.txt guile.texi
 
diff --git a/libguile/gettext.h b/libguile/gettext.h
index f54b6bff7..4d91358e5 100644
--- a/libguile/gettext.h
+++ b/libguile/gettext.h
@@ -1,69 +1,41 @@
-/* Convenience header for conditional use of GNU <libintl.h>.
-   Copyright (C) 1995-1998, 2000-2002, 2006 Free Software Foundation, Inc.
-
-   This program is free software; you can redistribute it and/or modify it
-   under the terms of the GNU Library General Public License as published
-   by the Free Software Foundation; either version 2, or (at your option)
-   any later version.
-
-   This program is distributed in the hope that it will be useful,
-   but WITHOUT ANY WARRANTY; without even the implied warranty of
-   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-   Library General Public License for more details.
-
-   You should have received a copy of the GNU Library General Public
-   License along with this program; if not, write to the Free Software
-   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
-   USA.  */
-
-#ifndef _LIBGETTEXT_H
-#define _LIBGETTEXT_H 1
-
-/* NLS can be disabled through the configure --disable-nls option.  */
-#if ENABLE_NLS
-
-/* Get declarations of GNU message catalog functions.  */
-# include <libintl.h>
-
-#else
-
-/* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which
-   chokes if dcgettext is defined as a macro.  So include it now, to make
-   later inclusions of <locale.h> a NOP.  We don't include <libintl.h>
-   as well because people using "gettext.h" will not include <libintl.h>,
-   and also including <libintl.h> would fail on SunOS 4, whereas <locale.h>
-   is OK.  */
-#if defined(__sun)
-# include <locale.h>
-#endif
-
-/* Disabled NLS.
-   The casts to 'const char *' serve the purpose of producing warnings
-   for invalid uses of the value returned from these functions.
-   On pre-ANSI systems without 'const', the config.h file is supposed to
-   contain "#define const".  */
-# define gettext(Msgid) ((const char *) (Msgid))
-# define dgettext(Domainname, Msgid) ((const char *) (Msgid))
-# define dcgettext(Domainname, Msgid, Category) ((const char *) (Msgid))
-# define ngettext(Msgid1, Msgid2, N) \
-    ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
-# define dngettext(Domainname, Msgid1, Msgid2, N) \
-    ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
-# define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \
-    ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
-# define textdomain(Domainname) ((const char *) (Domainname))
-# define bindtextdomain(Domainname, Dirname) ((const char *) (Dirname))
-# define bind_textdomain_codeset(Domainname, Codeset) ((const char *) (Codeset))
-
-#endif
-
-/* A pseudo function call that serves as a marker for the automated
-   extraction of messages, but does not call gettext().  The run-time
-   translation is done at a different place in the code.
-   The argument, String, should be a literal string.  Concatenated strings
-   and other string expressions won't work.
-   The macro's expansion is not parenthesized, so that it is suitable as
-   initializer for static 'char[]' or 'const char[]' variables.  */
-#define gettext_noop(String) String
-
-#endif /* _LIBGETTEXT_H */
+/* classes: h_files */
+
+#ifndef SCM_GETTEXT_H
+#define SCM_GETTEXT_H
+
+/* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#include "libguile/__scm.h"
+
+SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category);
+SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category);
+SCM_API SCM scm_textdomain (SCM domainname);
+SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory);
+SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding);
+
+SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all);
+
+SCM_API void scm_init_gettext (void);
+
+#endif  /* SCM_GETTEXT_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 16e45e495..76dd9a514 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -15,308 +15,1142 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
+#define _GNU_SOURCE /* Ask for glibc's `newlocale' API */
 
 #if HAVE_CONFIG_H
 # include <config.h>
 #endif
 
+#if HAVE_ALLOCA_H
+# include <alloca.h>
+#elif defined __GNUC__
+# define alloca __builtin_alloca
+#elif defined _AIX
+# define alloca __alloca
+#elif defined _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+#else
+# include <stddef.h>
+# ifdef  __cplusplus
+extern "C"
+# endif
+void *alloca (size_t);
+#endif
+
 #include "libguile/_scm.h"
 #include "libguile/feature.h"
 #include "libguile/i18n.h"
 #include "libguile/strings.h"
+#include "libguile/chars.h"
 #include "libguile/dynwind.h"
+#include "libguile/validate.h"
+#include "libguile/values.h"
 
-#include "gettext.h"
 #include <locale.h>
+#include <string.h> /* `strcoll ()' */
+#include <ctype.h>  /* `toupper ()' et al. */
+#include <errno.h>
 
-
-int
-scm_i_to_lc_category (SCM category, int allow_lc_all)
-{
-  int c_category = scm_to_int (category);
-  switch (c_category)
-    {
-#ifdef LC_CTYPE
-    case LC_CTYPE:
-#endif
-#ifdef LC_NUMERIC
-    case LC_NUMERIC:
-#endif
-#ifdef LC_COLLATE
-    case LC_COLLATE:
-#endif
-#ifdef LC_TIME
-    case LC_TIME:
-#endif
-#ifdef LC_MONETARY
-    case LC_MONETARY:
-#endif
-#ifdef LC_MESSAGES
-    case LC_MESSAGES:
+#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
+# define USE_GNU_LOCALE_API
 #endif
-#ifdef LC_PAPER
-    case LC_PAPER:
+
+#ifndef USE_GNU_LOCALE_API
+# include "libguile/posix.h"  /* for `scm_i_locale_mutex' */
 #endif
-#ifdef LC_NAME
-    case LC_NAME:
+
+#ifndef HAVE_SETLOCALE
+static inline char *
+setlocale (int category, const char *name)
+{
+  errno = ENOSYS;
+  return NULL;
+}
 #endif
-#ifdef LC_ADDRESS
-    case LC_ADDRESS:
+
+
+
+/* Locale objects, string and character collation, and other locale-dependent
+   string operations.
+
+   A large part of the code here deals with emulating glibc's reentrant
+   locale API on non-GNU systems.  The emulation is a bit "brute-force":
+   Whenever a `-locale<?' procedure is passed a locale object, then:
+
+   1. The `scm_t_locale_mutex' is locked.
+   2. A series of `setlocale ()' call is performed to store the current
+      locale for each category in an `scm_t_locale_settings' object.
+   3. A series of `setlocale ()' call is made to install each of the locale
+      categories of each of the base locales of each locale object,
+      recursively, starting from the last locale object of the chain.
+   4. The settings captured in step (2) are restored.
+   5. The `scm_t_locale_mutex' is released.
+
+   Hopefully, some smart standard will make that hack useless someday...
+   A similar API can be found in MzScheme starting from version 200:
+   http://download.plt-scheme.org/chronology/mzmr200alpha14.html .
+
+   Note: We don't wrap glibc's `uselocale ()' call because it sets the locale
+   of the current _thread_ (unlike `setlocale ()') and doing so would require
+   maintaining per-thread locale information on non-GNU systems and always
+   re-installing this locale upon locale-dependent calls.  */
+
+
+#ifndef USE_GNU_LOCALE_API
+
+/* Provide the locale category masks as found in glibc (copied from
+   <locale.h> as found in glibc 2.3.6).  This must be kept in sync with
+   `locale-categories.h'.  */
+
+# define LC_CTYPE_MASK		(1 << LC_CTYPE)
+# define LC_COLLATE_MASK	(1 << LC_COLLATE)
+# define LC_MESSAGES_MASK	(1 << LC_MESSAGES)
+# define LC_MONETARY_MASK	(1 << LC_MONETARY)
+# define LC_NUMERIC_MASK	(1 << LC_NUMERIC)
+# define LC_TIME_MASK		(1 << LC_TIME)
+
+# ifdef LC_PAPER
+#   define LC_PAPER_MASK	(1 << LC_PAPER)
+# else
+#   define LC_PAPER_MASK	0
+# endif
+# ifdef LC_NAME
+#   define LC_NAME_MASK		(1 << LC_NAME)
+# else
+#   define LC_NAME_MASK		0
+# endif
+# ifdef LC_ADDRESS
+#   define LC_ADDRESS_MASK	(1 << LC_ADDRESS)
+# else
+#   define LC_ADDRESS_MASK	0
+# endif
+# ifdef LC_TELEPHONE
+#   define LC_TELEPHONE_MASK	(1 << LC_TELEPHONE)
+# else
+#   define LC_TELEPHONE_MASK	0
+# endif
+# ifdef LC_MEASUREMENT
+#   define LC_MEASUREMENT_MASK	(1 << LC_MEASUREMENT)
+# else
+#   define LC_MEASUREMENT_MASK	0
+# endif
+# ifdef LC_IDENTIFICATION
+#   define LC_IDENTIFICATION_MASK (1 << LC_IDENTIFICATION)
+# else
+#   define LC_IDENTIFICATION_MASK 0
+# endif
+
+# define LC_ALL_MASK		(LC_CTYPE_MASK \
+				 | LC_NUMERIC_MASK \
+				 | LC_TIME_MASK \
+				 | LC_COLLATE_MASK \
+				 | LC_MONETARY_MASK \
+				 | LC_MESSAGES_MASK \
+				 | LC_PAPER_MASK \
+				 | LC_NAME_MASK \
+				 | LC_ADDRESS_MASK \
+				 | LC_TELEPHONE_MASK \
+				 | LC_MEASUREMENT_MASK \
+				 | LC_IDENTIFICATION_MASK \
+				 )
+
+/* Locale objects as returned by `make-locale' on non-GNU systems.  */
+typedef struct scm_locale
+{
+  SCM   base_locale; /* a `locale' object */
+  char *locale_name;
+  int   category_mask;
+} *scm_t_locale;
+
+#else
+
+/* Alias for glibc's locale type.  */
+typedef locale_t scm_t_locale;
+
 #endif
-#ifdef LC_TELEPHONE
-    case LC_TELEPHONE:
+
+/* Validate parameter ARG as a locale object and set C_LOCALE to the
+   corresponding C locale object.  */
+#define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale)		\
+  do								\
+    {								\
+      SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type);	\
+      (_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg);		\
+    }								\
+  while (0)
+
+/* Validate optional parameter ARG as either undefined or bound to a locale
+   object.  Set C_LOCALE to the corresponding C locale object or NULL.  */
+#define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale)	\
+  do									\
+    {									\
+      if ((_arg) != SCM_UNDEFINED)					\
+	SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale);		\
+      else								\
+	(_c_locale) = NULL;						\
+    }									\
+  while (0)
+
+
+SCM_SMOB (scm_tc16_locale_smob_type, "locale", 0);
+
+SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale)
+{
+  scm_t_locale c_locale;
+
+  c_locale = (scm_t_locale)SCM_SMOB_DATA (locale);
+
+#ifdef USE_GNU_LOCALE_API
+  freelocale ((locale_t)c_locale);
+#else
+  c_locale->base_locale = SCM_UNDEFINED;
+  free (c_locale->locale_name);
+
+  scm_gc_free (c_locale, sizeof (* c_locale), "locale");
 #endif
-#ifdef LC_MEASUREMENT
-    case LC_MEASUREMENT:
+
+  return 0;
+}
+
+#ifndef USE_GNU_LOCALE_API
+static SCM
+smob_locale_mark (SCM locale)
+{
+  scm_t_locale c_locale;
+
+  c_locale = (scm_t_locale)SCM_SMOB_DATA (locale);
+  return (c_locale->base_locale);
+}
 #endif
-#ifdef LC_IDENTIFICATION
-    case LC_IDENTIFICATION:
+
+
+SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
+	    (SCM category_mask, SCM locale_name, SCM base_locale),
+	    "Return a reference to a data structure representing a set of "
+	    "locale datasets.  Unlike for the @var{category} parameter for "
+	    "@code{setlocale}, the @var{category_mask} parameter here uses "
+	    "a single bit for each category, made by OR'ing together "
+	    "@code{LC_*_MASK} bits.")
+#define FUNC_NAME s_scm_make_locale
+{
+  SCM locale = SCM_BOOL_F;
+  int c_category_mask;
+  char *c_locale_name;
+  scm_t_locale c_base_locale, c_locale;
+
+  SCM_VALIDATE_INT_COPY (1, category_mask, c_category_mask);
+  SCM_VALIDATE_STRING (2, locale_name);
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, base_locale, c_base_locale);
+
+  c_locale_name = scm_to_locale_string (locale_name);
+
+#ifdef USE_GNU_LOCALE_API
+
+  c_locale = newlocale (c_category_mask, c_locale_name, c_base_locale);
+
+  if (!c_locale)
+    locale = SCM_BOOL_F;
+  else
+    SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
+
+  free (c_locale_name);
+
+#else
+
+  c_locale = scm_gc_malloc (sizeof (* c_locale), "locale");
+  c_locale->base_locale = base_locale;
+
+  c_locale->category_mask = c_category_mask;
+  c_locale->locale_name = c_locale_name;
+
+  SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
+
 #endif
-      return c_category;
-#ifdef LC_ALL
-    case LC_ALL:
-      if (allow_lc_all)
-	return c_category;
-#endif  
-    }
-  scm_wrong_type_arg (0, 0, category);
+
+  return locale;
 }
+#undef FUNC_NAME
 
-SCM_DEFINE (scm_gettext, "gettext", 1, 2, 0,
-	    (SCM msgid, SCM domain, SCM category),
-	    "Return the translation of @var{msgid} in the message domain "
-	    "@var{domain}. @var{domain} is optional and defaults to the "
-	    "domain set through (textdomain).  @var{category} is optional "
-	    "and defaults to LC_MESSAGES.")
-#define FUNC_NAME s_scm_gettext
+SCM_DEFINE (scm_locale_p, "locale?", 1, 0, 0,
+	    (SCM obj),
+	    "Return true if @var{obj} is a locale object.")
+#define FUNC_NAME s_scm_locale_p
 {
-  char *c_msgid;
-  char const *c_result;
-  SCM result;
+  if (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type, obj))
+    return SCM_BOOL_T;
+
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+
+
+#ifndef USE_GNU_LOCALE_API  /* Emulate GNU's reentrant locale API.  */
+
+
+/* Maximum number of chained locales (via `base_locale').  */
+#define LOCALE_STACK_SIZE_MAX  256
+
+typedef struct
+{
+#define SCM_DEFINE_LOCALE_CATEGORY(_name)  char * _name;
+#include "locale-categories.h"
+#undef SCM_DEFINE_LOCALE_CATEGORY
+} scm_t_locale_settings;
+
+/* Fill out SETTINGS according to the current locale settings.  On success
+   zero is returned and SETTINGS is properly initialized.  */
+static int
+get_current_locale_settings (scm_t_locale_settings *settings)
+{
+  const char *locale_name;
+
+#define SCM_DEFINE_LOCALE_CATEGORY(_name)			\
+  {								\
+    SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL));	\
+    if (!locale_name)						\
+      goto handle_error;					\
+								\
+    settings-> _name = strdup (locale_name);			\
+    if (settings-> _name == NULL)				\
+      goto handle_oom;						\
+  }
+
+#include "locale-categories.h"
+#undef SCM_DEFINE_LOCALE_CATEGORY
+
+  return 0;
+
+ handle_error:
+  return errno;
 
-  scm_dynwind_begin (0);
+ handle_oom:
+  return ENOMEM;
+}
+
+/* Restore locale settings SETTINGS.  On success, return zero.  */
+static int
+restore_locale_settings (const scm_t_locale_settings *settings)
+{
+  const char *result;
+
+#define SCM_DEFINE_LOCALE_CATEGORY(_name)				\
+  SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name));	\
+  if (result == NULL)							\
+    goto handle_error;
+
+#include "locale-categories.h"
+#undef SCM_DEFINE_LOCALE_CATEGORY
+
+  return 0;
+
+ handle_error:
+  return errno;
+}
+
+/* Free memory associated with SETTINGS.  */
+static void
+free_locale_settings (scm_t_locale_settings *settings)
+{
+#define SCM_DEFINE_LOCALE_CATEGORY(_name)	\
+  free (settings-> _name);			\
+  settings->_name = NULL;
+#include  "locale-categories.h"
+#undef SCM_DEFINE_LOCALE_CATEGORY
+}
 
-  c_msgid = scm_to_locale_string (msgid);
-  scm_dynwind_free (c_msgid);
+/* Install the locale named LOCALE_NAME for all the categories listed in
+   CATEGORY_MASK.  */
+static int
+install_locale_categories (const char *locale_name, int category_mask)
+{
+  const char *result;
 
-  if (SCM_UNBNDP (domain))
+  if (category_mask == LC_ALL_MASK)
     {
-      /* 1 argument case.  */
-      c_result = gettext (c_msgid);
+      SCM_SYSCALL (result = setlocale (LC_ALL, locale_name));
+      if (result == NULL)
+	goto handle_error;
     }
   else
     {
-      char *c_domain;
+#define SCM_DEFINE_LOCALE_CATEGORY(_name)				\
+  if (category_mask & LC_ ## _name ## _MASK)				\
+    {									\
+      SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name));	\
+      if (result == NULL)						\
+	goto handle_error;						\
+    }
+#include "locale-categories.h"
+#undef SCM_DEFINE_LOCALE_CATEGORY
+    }
 
-      c_domain = scm_to_locale_string (domain);
-      scm_dynwind_free (c_domain);
+  return 0;
 
-      if (SCM_UNBNDP (category))
-	{
-	  /* 2 argument case.  */
-	  c_result = dgettext (c_domain, c_msgid);
-	}
+ handle_error:
+  return errno;
+}
+
+/* Install LOCALE, recursively installing its base locales first.  On
+   success, zero is returned.  */
+static int
+install_locale (scm_t_locale locale)
+{
+  scm_t_locale stack[LOCALE_STACK_SIZE_MAX];
+  size_t stack_size = 0;
+  int stack_offset = 0;
+  const char *result = NULL;
+
+  /* Build up a locale stack by traversing the `base_locale' link.  */
+  do
+    {
+      if (stack_size >= LOCALE_STACK_SIZE_MAX)
+	/* We cannot use `scm_error ()' here because otherwise the locale
+	   mutex may remain locked.  */
+	return EINVAL;
+
+      stack[stack_size++] = locale;
+
+      if (locale->base_locale != SCM_UNDEFINED)
+	locale = (scm_t_locale)SCM_SMOB_DATA (locale->base_locale);
       else
-	{
-	  /* 3 argument case.  */
-	  int c_category;
+	locale = NULL;
+    }
+  while (locale != NULL);
 
-	  c_category = scm_i_to_lc_category (category, 0);
-	  c_result = dcgettext (c_domain, c_msgid, c_category);
-	}
+  /* Install the C locale to start from a pristine state.  */
+  SCM_SYSCALL (result = setlocale (LC_ALL, "C"));
+  if (result == NULL)
+    goto handle_error;
+
+  /* Install the locales in reverse order.  */
+  for (stack_offset = stack_size - 1;
+       stack_offset >= 0;
+       stack_offset--)
+    {
+      int err;
+      scm_t_locale locale;
+
+      locale = stack[stack_offset];
+      err = install_locale_categories (locale->locale_name,
+				       locale->category_mask);
+      if (err)
+	goto handle_error;
     }
 
-  if (c_result == c_msgid)
-    result = msgid;
-  else
-    result = scm_from_locale_string (c_result);
+  return 0;
 
-  scm_dynwind_end ();
-  return result;
+ handle_error:
+  return errno;
 }
-#undef FUNC_NAME
 
+/* Leave the locked locale section.  */
+static inline void
+leave_locale_section (const scm_t_locale_settings *settings)
+{
+  /* Restore the previous locale settings.  */
+  (void)restore_locale_settings (settings);
+
+  scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+}
 
-SCM_DEFINE (scm_ngettext, "ngettext", 3, 2, 0,
-	    (SCM msgid, SCM msgid_plural, SCM n, SCM domain, SCM category),
-	    "Return the translation of @var{msgid}/@var{msgid_plural} in the "
-	    "message domain @var{domain}, with the plural form being chosen "
-	    "appropriately for the number @var{n}.  @var{domain} is optional "
-	    "and defaults to the domain set through (textdomain). "
-	    "@var{category} is optional and defaults to LC_MESSAGES.")
-#define FUNC_NAME s_scm_ngettext
+/* Enter a locked locale section.  */
+static inline int
+enter_locale_section (scm_t_locale locale,
+		      scm_t_locale_settings *prev_locale)
 {
-  char *c_msgid;
-  char *c_msgid_plural;
-  unsigned long c_n;
-  const char *c_result;
-  SCM result;
+  int err;
+
+  scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+
+  err = get_current_locale_settings (prev_locale);
+  if (err)
+    {
+      scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+      return err;
+    }
 
-  scm_dynwind_begin (0);
+  err = install_locale (locale);
+  if (err)
+    {
+      leave_locale_section (prev_locale);
+      free_locale_settings (prev_locale);
+    }
+
+  return err;
+}
+
+/* Throw an exception corresponding to error ERR.  */
+static void inline
+scm_locale_error (const char *func_name, int err)
+{
+  SCM s_err;
+
+  s_err = scm_from_int (err);
+  scm_error (scm_system_error_key, func_name,
+	     "Failed to install locale",
+	     scm_cons (scm_strerror (s_err), SCM_EOL),
+	     scm_cons (s_err, SCM_EOL));
+}
+
+/* Convenient macro to run STATEMENT in the locale context of C_LOCALE.  */
+#define RUN_IN_LOCALE_SECTION(_c_locale, _statement)			\
+  do									\
+   {									\
+      int lsec_err;							\
+      scm_t_locale_settings lsec_prev_locale;				\
+									\
+      lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale);	\
+      if (lsec_err)							\
+	scm_locale_error (FUNC_NAME, lsec_err);				\
+      else								\
+	{								\
+	  _statement ;							\
+									\
+	  leave_locale_section (&lsec_prev_locale);			\
+	  free_locale_settings (&lsec_prev_locale);			\
+	}								\
+   }									\
+  while (0)
+
+#endif /* !USE_GNU_LOCALE_API */
 
-  c_msgid = scm_to_locale_string (msgid);
-  scm_dynwind_free (c_msgid);
+
+/* Locale-dependent string comparison.  */
 
-  c_msgid_plural = scm_to_locale_string (msgid_plural);
-  scm_dynwind_free (c_msgid_plural);
+/* Compare null-terminated strings C_S1 and C_S2 according to LOCALE.  Return
+   an integer whose sign is the same as the difference between C_S1 and
+   C_S2.  */
+static inline int
+compare_strings (const char *c_s1, const char *c_s2, SCM locale,
+		 const char *func_name)
+#define FUNC_NAME func_name
+{
+  int result;
+  scm_t_locale c_locale;
 
-  c_n = scm_to_ulong (n);
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
 
-  if (SCM_UNBNDP (domain))
+  if (c_locale)
     {
-      /* 3 argument case.  */
-      c_result = ngettext (c_msgid, c_msgid_plural, c_n);
+#ifdef USE_GNU_LOCALE_API
+      result = strcoll_l (c_s1, c_s2, c_locale);
+#else
+#ifdef HAVE_STRCOLL
+      RUN_IN_LOCALE_SECTION (c_locale, result = strcoll (c_s1, c_s2));
+#else
+      result = strcmp (c_s1, c_s2);
+#endif
+#endif /* !USE_GNU_LOCALE_API */
     }
   else
+
+#ifdef HAVE_STRCOLL
+    result = strcoll (c_s1, c_s2);
+#else
+    result = strcmp (c_s1, c_s2);
+#endif
+
+  return result;
+}
+#undef FUNC_NAME
+
+/* Store into DST an upper-case version of SRC.  */
+static inline void
+str_upcase (register char *dst, register const char *src)
+{
+  for (; *src != '\0'; src++, dst++)
+    *dst = toupper (*src);
+  *dst = '\0';
+}
+
+static inline void
+str_downcase (register char *dst, register const char *src)
+{
+  for (; *src != '\0'; src++, dst++)
+    *dst = tolower (*src);
+  *dst = '\0';
+}
+
+#ifdef USE_GNU_LOCALE_API
+static inline void
+str_upcase_l (register char *dst, register const char *src,
+	      scm_t_locale locale)
+{
+  for (; *src != '\0'; src++, dst++)
+    *dst = toupper_l (*src, locale);
+  *dst = '\0';
+}
+
+static inline void
+str_downcase_l (register char *dst, register const char *src,
+		scm_t_locale locale)
+{
+  for (; *src != '\0'; src++, dst++)
+    *dst = tolower_l (*src, locale);
+  *dst = '\0';
+}
+#endif
+
+
+/* Compare null-terminated strings C_S1 and C_S2 in a case-independent way
+   according to LOCALE.  Return an integer whose sign is the same as the
+   difference between C_S1 and C_S2.  */
+static inline int
+compare_strings_ci (const char *c_s1, const char *c_s2, SCM locale,
+		    const char *func_name)
+#define FUNC_NAME func_name
+{
+  int result;
+  scm_t_locale c_locale;
+  char *c_us1, *c_us2;
+
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
+
+  c_us1 = (char *) alloca (strlen (c_s1) + 1);
+  c_us2 = (char *) alloca (strlen (c_s2) + 1);
+
+  if (c_locale)
     {
-      char *c_domain;
+#ifdef USE_GNU_LOCALE_API
+      str_upcase_l (c_us1, c_s1, c_locale);
+      str_upcase_l (c_us2, c_s2, c_locale);
 
-      c_domain = scm_to_locale_string (domain);
-      scm_dynwind_free (c_domain);
+      result = strcoll_l (c_us1, c_us2, c_locale);
+#else
+      int err;
+      scm_t_locale_settings prev_locale;
 
-      if (SCM_UNBNDP (category))
+      err = enter_locale_section (c_locale, &prev_locale);
+      if (err)
 	{
-	  /* 4 argument case.  */
-	  c_result = dngettext (c_domain, c_msgid, c_msgid_plural, c_n);
+	  scm_locale_error (func_name, err);
+	  return 0;
 	}
-      else
-	{
-	  /* 5 argument case.  */
-	  int c_category;
 
-	  c_category = scm_i_to_lc_category (category, 0);
-	  c_result = dcngettext (c_domain, c_msgid, c_msgid_plural, c_n,
-				 c_category);
-	}
-    }
+      str_upcase (c_us1, c_s1);
+      str_upcase (c_us2, c_s2);
+
+#ifdef HAVE_STRCOLL
+      result = strcoll (c_us1, c_us2);
+#else
+      result = strcmp (c_us1, c_us2);
+#endif /* !HAVE_STRCOLL */
 
-  if (c_result == c_msgid)
-    result = msgid;
-  else if (c_result == c_msgid_plural)
-    result = msgid_plural;
+      leave_locale_section (&prev_locale);
+      free_locale_settings (&prev_locale);
+#endif /* !USE_GNU_LOCALE_API */
+    }
   else
-    result = scm_from_locale_string (c_result);
-  
-  scm_dynwind_end ();
+    {
+      str_upcase (c_us1, c_s1);
+      str_upcase (c_us2, c_s2);
+
+#ifdef HAVE_STRCOLL
+      result = strcoll (c_us1, c_us2);
+#else
+      result = strcmp (c_us1, c_us2);
+#endif
+    }
+
   return result;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_textdomain, "textdomain", 0, 1, 0,
-	    (SCM domainname),
-	    "If optional parameter @var{domainname} is supplied, "
-	    "set the textdomain.  "
-	    "Return the textdomain.")
-#define FUNC_NAME s_scm_textdomain
+
+SCM_DEFINE (scm_string_locale_lt, "string-locale<?", 2, 1, 0,
+	    (SCM s1, SCM s2, SCM locale),
+	    "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
+	    "If @var{locale} is provided, it should be locale object (as "
+	    "returned by @code{make-locale}) and will be used to perform the "
+	    "comparison; otherwise, the current system locale is used.")
+#define FUNC_NAME s_scm_string_locale_lt
 {
-  char const *c_result;
-  char *c_domain;
-  SCM result = SCM_BOOL_F;
+  int result;
+  const char *c_s1, *c_s2;
 
-  scm_dynwind_begin (0);
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
 
-  if (SCM_UNBNDP (domainname))
-    c_domain = NULL;
-  else
+  c_s1 = scm_i_string_chars (s1);
+  c_s2 = scm_i_string_chars (s2);
+
+  result = compare_strings (c_s1, c_s2, locale, FUNC_NAME);
+
+  scm_remember_upto_here_2 (s1, s2);
+
+  return scm_from_bool (result < 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_locale_gt, "string-locale>?", 2, 1, 0,
+	    (SCM s1, SCM s2, SCM locale),
+	    "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
+	    "If @var{locale} is provided, it should be locale object (as "
+	    "returned by @code{make-locale}) and will be used to perform the "
+	    "comparison; otherwise, the current system locale is used.")
+#define FUNC_NAME s_scm_string_locale_gt
+{
+  int result;
+  const char *c_s1, *c_s2;
+
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  c_s1 = scm_i_string_chars (s1);
+  c_s2 = scm_i_string_chars (s2);
+
+  result = compare_strings (c_s1, c_s2, locale, FUNC_NAME);
+
+  scm_remember_upto_here_2 (s1, s2);
+
+  return scm_from_bool (result > 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_locale_ci_lt, "string-locale-ci<?", 2, 1, 0,
+	    (SCM s1, SCM s2, SCM locale),
+	    "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
+	    "and locale-dependent way.  If @var{locale} is provided, it "
+	    "should be locale object (as returned by @code{make-locale}) "
+	    "and will be used to perform the comparison; otherwise, the "
+	    "current system locale is used.")
+#define FUNC_NAME s_scm_string_locale_ci_lt
+{
+  int result;
+  const char *c_s1, *c_s2;
+
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  c_s1 = scm_i_string_chars (s1);
+  c_s2 = scm_i_string_chars (s2);
+
+  result = compare_strings_ci (c_s1, c_s2, locale, FUNC_NAME);
+
+  scm_remember_upto_here_2 (s1, s2);
+
+  return scm_from_bool (result < 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_locale_ci_gt, "string-locale-ci>?", 2, 1, 0,
+	    (SCM s1, SCM s2, SCM locale),
+	    "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
+	    "and locale-dependent way.  If @var{locale} is provided, it "
+	    "should be locale object (as returned by @code{make-locale}) "
+	    "and will be used to perform the comparison; otherwise, the "
+	    "current system locale is used.")
+#define FUNC_NAME s_scm_string_locale_ci_gt
+{
+  int result;
+  const char *c_s1, *c_s2;
+
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  c_s1 = scm_i_string_chars (s1);
+  c_s2 = scm_i_string_chars (s2);
+
+  result = compare_strings_ci (c_s1, c_s2, locale, FUNC_NAME);
+
+  scm_remember_upto_here_2 (s1, s2);
+
+  return scm_from_bool (result > 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_locale_ci_eq, "string-locale-ci=?", 2, 1, 0,
+	    (SCM s1, SCM s2, SCM locale),
+	    "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
+	    "and locale-dependent way.  If @var{locale} is provided, it "
+	    "should be locale object (as returned by @code{make-locale}) "
+	    "and will be used to perform the comparison; otherwise, the "
+	    "current system locale is used.")
+#define FUNC_NAME s_scm_string_locale_ci_eq
+{
+  int result;
+  const char *c_s1, *c_s2;
+
+  SCM_VALIDATE_STRING (1, s1);
+  SCM_VALIDATE_STRING (2, s2);
+
+  c_s1 = scm_i_string_chars (s1);
+  c_s2 = scm_i_string_chars (s2);
+
+  result = compare_strings_ci (c_s1, c_s2, locale, FUNC_NAME);
+
+  scm_remember_upto_here_2 (s1, s2);
+
+  return scm_from_bool (result == 0);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_char_locale_lt, "char-locale<?", 2, 1, 0,
+	    (SCM c1, SCM c2, SCM locale),
+	    "Return true if character @var{c1} is lower than @var{c2} "
+	    "according to @var{locale} or to the current locale.")
+#define FUNC_NAME s_scm_char_locale_lt
+{
+  char c_c1[2], c_c2[2];
+
+  SCM_VALIDATE_CHAR (1, c1);
+  SCM_VALIDATE_CHAR (2, c2);
+
+  c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0';
+  c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0';
+
+  return scm_from_bool (compare_strings (c_c1, c_c2, locale, FUNC_NAME) < 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_char_locale_gt, "char-locale>?", 2, 1, 0,
+	    (SCM c1, SCM c2, SCM locale),
+	    "Return true if character @var{c1} is greater than @var{c2} "
+	    "according to @var{locale} or to the current locale.")
+#define FUNC_NAME s_scm_char_locale_gt
+{
+  char c_c1[2], c_c2[2];
+
+  SCM_VALIDATE_CHAR (1, c1);
+  SCM_VALIDATE_CHAR (2, c2);
+
+  c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0';
+  c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0';
+
+  return scm_from_bool (compare_strings (c_c1, c_c2, locale, FUNC_NAME) > 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_char_locale_ci_lt, "char-locale-ci<?", 2, 1, 0,
+	    (SCM c1, SCM c2, SCM locale),
+	    "Return true if character @var{c1} is lower than @var{c2}, "
+	    "in a case insensitive way according to @var{locale} or to "
+	    "the current locale.")
+#define FUNC_NAME s_scm_char_locale_ci_lt
+{
+  int result;
+  char c_c1[2], c_c2[2];
+
+  SCM_VALIDATE_CHAR (1, c1);
+  SCM_VALIDATE_CHAR (2, c2);
+
+  c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0';
+  c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0';
+
+  result = compare_strings_ci (c_c1, c_c2, locale, FUNC_NAME);
+
+  return scm_from_bool (result < 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_char_locale_ci_gt, "char-locale-ci>?", 2, 1, 0,
+	    (SCM c1, SCM c2, SCM locale),
+	    "Return true if character @var{c1} is greater than @var{c2}, "
+	    "in a case insensitive way according to @var{locale} or to "
+	    "the current locale.")
+#define FUNC_NAME s_scm_char_locale_ci_gt
+{
+  int result;
+  char c_c1[2], c_c2[2];
+
+  SCM_VALIDATE_CHAR (1, c1);
+  SCM_VALIDATE_CHAR (2, c2);
+
+  c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0';
+  c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0';
+
+  result = compare_strings_ci (c_c1, c_c2, locale, FUNC_NAME);
+
+  return scm_from_bool (result > 0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_char_locale_ci_eq, "char-locale-ci=?", 2, 1, 0,
+	    (SCM c1, SCM c2, SCM locale),
+	    "Return true if character @var{c1} is equal to @var{c2}, "
+	    "in a case insensitive way according to @var{locale} or to "
+	    "the current locale.")
+#define FUNC_NAME s_scm_char_locale_ci_eq
+{
+  int result;
+  char c_c1[2], c_c2[2];
+
+  SCM_VALIDATE_CHAR (1, c1);
+  SCM_VALIDATE_CHAR (2, c2);
+
+  c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0';
+  c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0';
+
+  result = compare_strings_ci (c_c1, c_c2, locale, FUNC_NAME);
+
+  return scm_from_bool (result == 0);
+}
+#undef FUNC_NAME
+
+
+
+/* Locale-dependent alphabetic character mapping.  */
+
+SCM_DEFINE (scm_char_locale_downcase, "char-locale-downcase", 1, 1, 0,
+	    (SCM chr, SCM locale),
+	    "Return the lowercase character that corresponds to @var{chr} "
+	    "according to either @var{locale} or the current locale.")
+#define FUNC_NAME s_scm_char_locale_downcase
+{
+  char c_chr;
+  int c_result;
+  scm_t_locale c_locale;
+
+  SCM_VALIDATE_CHAR (1, chr);
+  c_chr = SCM_CHAR (chr);
+
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale);
+
+  if (c_locale != NULL)
     {
-      c_domain = scm_to_locale_string (domainname);
-      scm_dynwind_free (c_domain);
+#ifdef USE_GNU_LOCALE_API
+      c_result = tolower_l (c_chr, c_locale);
+#else
+      RUN_IN_LOCALE_SECTION (c_locale, c_result = tolower (c_chr));
+#endif
     }
+  else
+    c_result = tolower (c_chr);
 
-  c_result = textdomain (c_domain);
-  if (c_result != NULL)
-    result = scm_from_locale_string (c_result);
-  else if (!SCM_UNBNDP (domainname))
-    SCM_SYSERROR;
-
-  scm_dynwind_end ();
-  return result;
+  return (SCM_MAKE_CHAR (c_result));
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_bindtextdomain, "bindtextdomain", 1, 1, 0,
-	    (SCM domainname, SCM directory),
-	    "If optional parameter @var{directory} is supplied, "
-	    "set message catalogs to directory @var{directory}.  "
-	    "Return the directory bound to @var{domainname}.")
-#define FUNC_NAME s_scm_bindtextdomain
+SCM_DEFINE (scm_char_locale_upcase, "char-locale-upcase", 1, 1, 0,
+	    (SCM chr, SCM locale),
+	    "Return the uppercase character that corresponds to @var{chr} "
+	    "according to either @var{locale} or the current locale.")
+#define FUNC_NAME s_scm_char_locale_upcase
 {
-  char *c_domain;
-  char *c_directory;
-  char const *c_result;
-  SCM result;
+  char c_chr;
+  int c_result;
+  scm_t_locale c_locale;
+
+  SCM_VALIDATE_CHAR (1, chr);
+  c_chr = SCM_CHAR (chr);
 
-  scm_dynwind_begin (0);
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale);
 
-  if (SCM_UNBNDP (directory))
-    c_directory = NULL;
+  if (c_locale != NULL)
+    {
+#ifdef USE_GNU_LOCALE_API
+      c_result = toupper_l (c_chr, c_locale);
+#else
+      RUN_IN_LOCALE_SECTION (c_locale, c_result = toupper (c_chr));
+#endif
+    }
   else
+    c_result = toupper (c_chr);
+
+  return (SCM_MAKE_CHAR (c_result));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_locale_upcase, "string-locale-upcase", 1, 1, 0,
+	    (SCM str, SCM locale),
+	    "Return a new string that is the uppercase version of "
+	    "@var{str} according to either @var{locale} or the current "
+	    "locale.")
+#define FUNC_NAME s_scm_string_locale_upcase
+{
+  const char *c_str;
+  char *c_ustr;
+  scm_t_locale c_locale;
+
+  SCM_VALIDATE_STRING (1, str);
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale);
+
+  c_str = scm_i_string_chars (str);
+  c_ustr = (char *) alloca (strlen (c_str) + 1);
+
+  if (c_locale)
     {
-      c_directory = scm_to_locale_string (directory);
-      scm_dynwind_free (c_directory);
+#ifdef USE_GNU_LOCALE_API
+      str_upcase_l (c_ustr, c_str, c_locale);
+#else
+      RUN_IN_LOCALE_SECTION (c_locale, str_upcase (c_ustr, c_str));
+#endif
     }
+  else
+    str_upcase (c_ustr, c_str);
+
+  scm_remember_upto_here (str);
+
+  return (scm_from_locale_string (c_ustr));
+}
+#undef FUNC_NAME
 
-  c_domain = scm_to_locale_string (domainname);
-  scm_dynwind_free (c_domain);
+SCM_DEFINE (scm_string_locale_downcase, "string-locale-downcase", 1, 1, 0,
+	    (SCM str, SCM locale),
+	    "Return a new string that is the down-case version of "
+	    "@var{str} according to either @var{locale} or the current "
+	    "locale.")
+#define FUNC_NAME s_scm_string_locale_downcase
+{
+  const char *c_str;
+  char *c_lstr;
+  scm_t_locale c_locale;
+
+  SCM_VALIDATE_STRING (1, str);
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale);
 
-  c_result = bindtextdomain (c_domain, c_directory);
+  c_str = scm_i_string_chars (str);
+  c_lstr = (char *) alloca (strlen (c_str) + 1);
 
-  if (c_result != NULL)
-    result = scm_from_locale_string (c_result);
-  else if (!SCM_UNBNDP (directory))
-    SCM_SYSERROR;
+  if (c_locale)
+    {
+#ifdef USE_GNU_LOCALE_API
+      str_downcase_l (c_lstr, c_str, c_locale);
+#else
+      RUN_IN_LOCALE_SECTION (c_locale, str_downcase (c_lstr, c_str));
+#endif
+    }
   else
-    result = SCM_BOOL_F;
+    str_downcase (c_lstr, c_str);
 
-  scm_dynwind_end ();
-  return result;
+  scm_remember_upto_here (str);
+
+  return (scm_from_locale_string (c_lstr));
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_bind_textdomain_codeset, "bind-textdomain-codeset", 1, 1, 0,
-	    (SCM domainname, SCM encoding),
-	    "If optional parameter @var{encoding} is supplied, "
-	    "set encoding for message catalogs of @var{domainname}.  "
-	    "Return the encoding of @var{domainname}.")
-#define FUNC_NAME s_scm_bind_textdomain_codeset
+/* Note: We don't provide mutative versions of `string-locale-(up|down)case'
+   because, in some languages, a single downcase character maps to a couple
+   of uppercase characters.  Read the SRFI-13 document for a detailed
+   discussion about this.  */
+
+
+
+/* Locale-dependent number parsing.  */
+
+SCM_DEFINE (scm_locale_string_to_integer, "locale-string->integer",
+	    1, 2, 0, (SCM str, SCM base, SCM locale),
+	    "Convert string @var{str} into an integer according to either "
+	    "@var{locale} (a locale object as returned by @code{make-locale}) "
+	    "or the current process locale.  Return two values: an integer "
+	    "(on success) or @code{#f}, and the number of characters read "
+	    "from @var{str} (@code{0} on failure).")
+#define FUNC_NAME s_scm_locale_string_to_integer
 {
-  char *c_domain;
-  char *c_encoding;
-  char const *c_result;
   SCM result;
+  long c_result;
+  int c_base;
+  const char *c_str;
+  char *c_endptr;
+  scm_t_locale c_locale;
 
-  scm_dynwind_begin (0);
+  SCM_VALIDATE_STRING (1, str);
+  c_str = scm_i_string_chars (str);
 
-  if (SCM_UNBNDP (encoding))
-    c_encoding = NULL;
+  if (base != SCM_UNDEFINED)
+    SCM_VALIDATE_INT_COPY (2, base, c_base);
   else
+    c_base = 10;
+
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
+
+  if (c_locale != NULL)
     {
-      c_encoding = scm_to_locale_string (encoding);
-      scm_dynwind_free (c_encoding);
+#ifdef USE_GNU_LOCALE_API
+      c_result = strtol_l (c_str, &c_endptr, c_base, c_locale);
+#else
+      RUN_IN_LOCALE_SECTION (c_locale,
+			     c_result = strtol (c_str, &c_endptr, c_base));
+#endif
     }
+  else
+    c_result = strtol (c_str, &c_endptr, c_base);
+
+  scm_remember_upto_here (str);
+
+  if (c_endptr == c_str)
+    result = SCM_BOOL_F;
+  else
+    result = scm_from_long (c_result);
+
+  return (scm_values (scm_list_2 (result, scm_from_long (c_endptr - c_str))));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_locale_string_to_inexact, "locale-string->inexact",
+	    1, 1, 0, (SCM str, SCM locale),
+	    "Convert string @var{str} into an inexact number according to "
+	    "either @var{locale} (a locale object as returned by "
+	    "@code{make-locale}) or the current process locale.  Return "
+	    "two values: an inexact number (on success) or @code{#f}, and "
+	    "the number of characters read from @var{str} (@code{0} on "
+	    "failure).")
+#define FUNC_NAME s_scm_locale_string_to_inexact
+{
+  SCM result;
+  double c_result;
+  const char *c_str;
+  char *c_endptr;
+  scm_t_locale c_locale;
 
-  c_domain = scm_to_locale_string (domainname);
-  scm_dynwind_free (c_domain);
+  SCM_VALIDATE_STRING (1, str);
+  c_str = scm_i_string_chars (str);
 
-  c_result = bind_textdomain_codeset (c_domain, c_encoding);
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale);
 
-  if (c_result != NULL)
-    result = scm_from_locale_string (c_result);
-  else if (!SCM_UNBNDP (encoding))
-    SCM_SYSERROR;
+  if (c_locale != NULL)
+    {
+#ifdef USE_GNU_LOCALE_API
+      c_result = strtod_l (c_str, &c_endptr, c_locale);
+#else
+      RUN_IN_LOCALE_SECTION (c_locale,
+			     c_result = strtod (c_str, &c_endptr));
+#endif
+    }
   else
+    c_result = strtod (c_str, &c_endptr);
+
+  scm_remember_upto_here (str);
+
+  if (c_endptr == c_str)
     result = SCM_BOOL_F;
+  else
+    result = scm_from_double (c_result);
 
-  scm_dynwind_end ();
-  return result;
+  return (scm_values (scm_list_2 (result, scm_from_long (c_endptr - c_str))));
 }
 #undef FUNC_NAME
 
-void 
+
+
+void
 scm_init_i18n ()
 {
-  scm_add_feature ("i18n");
+  scm_add_feature ("ice-9-i18n");
+
+#define _SCM_STRINGIFY_LC(_name)  # _name
+#define SCM_STRINGIFY_LC(_name)   _SCM_STRINGIFY_LC (_name)
+
+  /* Define all the relevant `_MASK' variables.  */
+#define SCM_DEFINE_LOCALE_CATEGORY(_name)		\
+  scm_c_define ("LC_" SCM_STRINGIFY_LC (_name) "_MASK",	\
+		SCM_I_MAKINUM (LC_ ## _name ## _MASK));
+#include "locale-categories.h"
+
+#undef SCM_DEFINE_LOCALE_CATEGORY
+#undef SCM_STRINGIFY_LC
+#undef _SCM_STRINGIFY_LC
+
+  scm_c_define ("LC_ALL_MASK", SCM_I_MAKINUM (LC_ALL_MASK));
+
 #include "libguile/i18n.x"
+
+#ifndef USE_GNU_LOCALE_API
+  scm_set_smob_mark (scm_tc16_locale_smob_type, smob_locale_mark);
+#endif
 }
 
 
diff --git a/libguile/i18n.h b/libguile/i18n.h
index 1f0cb0852..7d5d9baa9 100644
--- a/libguile/i18n.h
+++ b/libguile/i18n.h
@@ -3,7 +3,7 @@
 #ifndef SCM_I18N_H
 #define SCM_I18N_H
 
-/* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -22,13 +22,24 @@
 
 #include "libguile/__scm.h"
 
-SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category);
-SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category);
-SCM_API SCM scm_textdomain (SCM domainname);
-SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory);
-SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding);
-
-SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all);
+SCM_API SCM scm_make_locale (SCM category_mask, SCM locale_name, SCM base_locale);
+SCM_API SCM scm_locale_p (SCM obj);
+SCM_API SCM scm_string_locale_lt (SCM s1, SCM s2, SCM locale);
+SCM_API SCM scm_string_locale_gt (SCM s1, SCM s2, SCM locale);
+SCM_API SCM scm_string_locale_ci_lt (SCM s1, SCM s2, SCM locale);
+SCM_API SCM scm_string_locale_ci_gt (SCM s1, SCM s2, SCM locale);
+SCM_API SCM scm_string_locale_ci_eq (SCM s1, SCM s2, SCM locale);
+SCM_API SCM scm_char_locale_lt (SCM c1, SCM c2, SCM locale);
+SCM_API SCM scm_char_locale_gt (SCM c1, SCM c2, SCM locale);
+SCM_API SCM scm_char_locale_ci_lt (SCM c1, SCM c2, SCM locale);
+SCM_API SCM scm_char_locale_ci_gt (SCM c1, SCM c2, SCM locale);
+SCM_API SCM scm_char_locale_ci_eq (SCM c1, SCM c2, SCM locale);
+SCM_API SCM scm_char_locale_upcase (SCM chr, SCM locale);
+SCM_API SCM scm_char_locale_downcase (SCM chr, SCM locale);
+SCM_API SCM scm_string_locale_upcase (SCM chr, SCM locale);
+SCM_API SCM scm_string_locale_downcase (SCM chr, SCM locale);
+SCM_API SCM scm_locale_string_to_integer (SCM str, SCM base, SCM locale);
+SCM_API SCM scm_locale_string_to_inexact (SCM str, SCM locale);
 
 SCM_API void scm_init_i18n (void);
 
diff --git a/libguile/init.c b/libguile/init.c
index e3a0bc41a..219ef620d 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -65,7 +65,7 @@
 #include "libguile/hash.h"
 #include "libguile/hashtab.h"
 #include "libguile/hooks.h"
-#include "libguile/i18n.h"
+#include "libguile/gettext.h"
 #include "libguile/iselect.h"
 #include "libguile/ioext.h"
 #include "libguile/keywords.h"
@@ -479,7 +479,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_properties ();
   scm_init_hooks ();            /* Requires smob_prehistory */
   scm_init_gc ();		/* Requires hooks, async */
-  scm_init_i18n ();
+  scm_init_gettext ();
   scm_init_ioext ();
   scm_init_keywords ();
   scm_init_list ();
diff --git a/libguile/posix.c b/libguile/posix.c
index 8a83a1e7e..8129c6413 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -40,7 +40,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/posix.h"
-#include "libguile/i18n.h"
+#include "libguile/gettext.h"
 #include "libguile/threads.h"
 
 
@@ -115,6 +115,10 @@ extern char ** environ;
 #include <locale.h>
 #endif
 
+#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
+# define USE_GNU_LOCALE_API
+#endif
+
 #if HAVE_CRYPT_H
 #  include <crypt.h>
 #endif
@@ -1380,7 +1384,15 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifndef USE_GNU_LOCALE_API
+/* This mutex is used to serialize invocations of `setlocale ()' on non-GNU
+   systems (i.e., systems where a reentrant locale API is not available).
+   See `i18n.c' for details.  */
+scm_i_pthread_mutex_t scm_i_locale_mutex;
+#endif
+
 #ifdef HAVE_SETLOCALE
+
 SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
             (SCM category, SCM locale),
 	    "If @var{locale} is omitted, return the current value of the\n"
@@ -1409,7 +1421,14 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
       scm_dynwind_free (clocale);
     }
 
+#ifndef USE_GNU_LOCALE_API
+  scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+#endif
   rv = setlocale (scm_i_to_lc_category (category, 1), clocale);
+#ifndef USE_GNU_LOCALE_API
+  scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+#endif
+
   if (rv == NULL)
     {
       /* POSIX and C99 don't say anything about setlocale setting errno, so
@@ -1943,9 +1962,13 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
 #endif /* HAVE_GETHOSTNAME */
 
 
-void 
+void
 scm_init_posix ()
 {
+#ifndef USE_GNU_LOCALE_API
+  scm_i_pthread_mutex_init (&scm_i_locale_mutex, NULL);
+#endif
+
   scm_add_feature ("posix");
 #ifdef HAVE_GETEUID
   scm_add_feature ("EIDs");
diff --git a/libguile/posix.h b/libguile/posix.h
index 3bef9f96d..871bba850 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -23,8 +23,7 @@
 
 
 #include "libguile/__scm.h"
-
-
+#include "libguile/threads.h"
 
 
 
@@ -87,6 +86,8 @@ SCM_API SCM scm_sethostname (SCM name);
 SCM_API SCM scm_gethostname (void);
 SCM_API void scm_init_posix (void);
 
+SCM_API scm_i_pthread_mutex_t scm_i_locale_mutex;
+
 #endif  /* SCM_POSIX_H */
 
 /*