Re: Text collation

[ludovic.courtes@laas.fr (Ludovic Courtès)]

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

Hi,

I have come up with an `(ice-9 i18n)' module that contains
locale-dependent text collation functions and also character case
mapping and functions to read numbers.  There would be a lot more things
to add, like `strfmon ()', but I think that's a good start.

Here are the key points that may deserve further discussion:

1. Use of a glibc-specific reentrant API (the `_l' functions).  As I
   mentioned in my previous post, the idea here is to provide the option
   to pass locale information as an additional argument, as in:

     (string-locale<? "hello" "world" my-locale)

   That last argument may be omitted, in which case the current process
   locale is used (and the "regular" C function is used behind the
   scenes).  Note that in cases where this optional argument is not
   used, the implementation is exactly the same on both GNU and non-GNU
   systems.

   For non-GNU systems, I implemented this (dealing with the LOCALE
   argument) by serializing calls to `setlocale', and performing as many
   `setlocale' calls as needed to install the locale specified by this
   third argument (details in `i18n.c' below).  This is not efficient
   nor very elegant, but at least, it provides users with the same
   semantics across all systems.

   There's one difference, though, between the behavior on GNU and
   non-GNU systems: on GNU, passing a wrong locale name to `make-locale'
   immediately yields an exception, while on non-GNU that exception will
   only be raised when the locale object is actually used.

   Kevin mentioned the argument in glibc's <locale.h> stating that the
   `locale_t' API was a "proof-of-concept".  It seems, however, that
   it's built to stay [0].

2. Kevin said: "I wonder if the unicode of r6rs might make the
   implementation difficult later."  When we support Unicode, `i18n.c'
   "just" has to be changed to use the wide-character variants of the
   various functions (e.g., `wstrcoll' instead of `strcoll', etc.).  So
   I don't think there's much to worry about here.

3. I've put those functions in `(ice-9 i18n)' but they are actually
   implemented in C so `i18n.scm' simply `dynamic-link's a new library,
   `libguile-i18n-v0', that is compiled from within the `libguile'
   directory.

   The rationale for doing it was the following:

   * Reduce startup time.  The approach that consists in initializing
     _everything_ at startup is not scalable.

   * Optionally, reduce memory footprint when the module is not used,
     although that's arguably not a major concern.

   On IRC, Rob identified a number of issues with this approach:

   * It would be the first `ice-9' module that does a `dynamic-link', so
     we may want to think twice before doing it.

   * The C programmer willing to use those functions would have to link
     against `libguile-i18n' additionally.

   There's another (small) issue:

   * The online help is a bit confused because the doc of the i18n.c
     functions is include in libguile's `guile-procedure.txt'.  Thus,
     `(help make-locale)' always works, even when `(ice-9 i18n)' is not
     loaded.

Personally, I'm not worried about issues (1) and (2).  As for item (3),
I'd be tempted to leave the thing in a separate shared library.  While I
agree that this practically precludes use of those functions by C
programmers (as is the case for those SRFIs that are implemented in C),
I believe that this module is more targeted towards Scheme programmers
and, consequently, I see more value in keeping the module's code in a
separate shared lib than in providing access to the C functions.

What do you think?

Thanks,
Ludovic.

[0] http://sources.redhat.com/ml/libc-alpha/2006-09/msg00033.html


[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 67843 bytes --]

--- orig/configure.in
+++ mod/configure.in
@@ -613,8 +613,9 @@ AC_CHECK_HEADERS([assert.h crt_externs.h
 #   truncate - not in mingw
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
+#   strcoll_l, newlocale - GNU extensions (glibc)
 #
-AC_CHECK_FUNCS([DINFINITY DQNAN chsize clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron])
+AC_CHECK_FUNCS([DINFINITY DQNAN chsize clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale])
 
 # Reasons for testing:
 #   netdb.h - not in mingw
--- orig/doc/ref/api-i18n.texi
+++ mod/doc/ref/api-i18n.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -8,6 +8,266 @@
 @node Internationalization
 @section Support for Internationalization
 
+@cindex internationalization
+@cindex i18n
+
+Guile provides internationalization support for Scheme programs in two
+ways.  First, procedures to manipulate text and data in a way that
+conforms to particular cultural conventions (i.e., in a
+``locale-dependent'' way) are provided in the @code{(ice-9 i18n)}.
+Second, Guile allows the use of GNU @code{gettext} to translate
+program message strings.
+
+@menu
+* The ice-9 i18n Module::            Honoring cultural conventions.
+* Gettext Support::                  Translating message strings.
+@end menu
+
+
+@node The ice-9 i18n Module
+@subsection The @code{(ice-9 i18n)} Module
+
+In order to make use of the following functions, one must import the
+@code{(ice-9 i18n)} module in the usual way:
+
+@example
+(use-modules (ice-9 i18n))
+@end example
+
+@cindex cultural conventions
+
+The @code{(ice-9 i18n)} module provides procedures to manipulate text
+and other data in a way that conforms to the cultural conventions
+chosen by the user.  Each region of the world or language has its own
+customs to, for instance, represent real numbers, classify characters,
+collate text, etc.  All these aspects comprise the so-called
+``cultural conventions'' of that region or language.
+
+@cindex locale
+@cindex locale category
+
+Computer systems typically refer to a set of cultural conventions as a
+@dfn{locale}.  For each particular aspect that comprise those cultural
+conventions, a @dfn{locale category} is defined.  For instance, the
+way characters are classified is defined by the @code{LC_CTYPE}
+category, while the language in which program messages are issued to
+the user is defined by the @code{LC_MESSAGES} category
+(@pxref{Locales, General Locale Information} for details).
+
+@cindex locale object
+
+The procedures provided by this module allow the development of
+programs that adapt automatically to any locale setting.  As we will
+see later, many of the locale-dependent procedures provided by this
+module can optionally take a @dfn{locale object} argument.  This
+additional argument defines the locale settings that must be followed
+by the invoked procedure.  When it is omitted, then the current locale
+settings of the process are followed (@pxref{Locales,
+@code{setlocale}}).
+
+The following procedures allow the manipulation of such locale
+objects.
+
+@deffn {Scheme Procedure} make-locale category_mask locale_name [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.
+The optional @var{base_locale} argument can be used to specify a
+locale object whose settings are to be used as a basis for the locale
+object being returned.
+
+The available locale category masks are the following:
+
+@defvar LC_COLLATE_MASK
+Represents the collation locale category.
+@end defvar
+@defvar LC_CTYPE_MASK
+Represents the character classification locale category.
+@end defvar
+@defvar LC_MESSAGES_MASK
+Represents the messages locale category.
+@end defvar
+@defvar LC_MONETARY_MASK
+Represents the monetary locale category.
+@end defvar
+@defvar LC_NUMERIC_MASK
+Represents the way numbers are displayed.
+@end defvar
+@defvar LC_TIME_MASK
+Represents the way date and time are displayed
+@end defvar
+
+The following category masks are also available but will not have any
+effect on systems that do not support them:
+
+@defvar LC_PAPER_MASK
+@defvarx LC_NAME_MASK
+@defvarx LC_ADDRESS_MASK
+@defvarx LC_TELEPHONE_MASK
+@defvarx LC_MEASUREMENT_MASK
+@defvarx LC_IDENTIFICATION_MASK
+@end defvar
+
+Finally, there is also:
+
+@defvar LC_ALL_MASK
+This represents all the locale categories supported by the system.
+@end defvar
+
+The @code{LC_*_MASK} variables are bound to integers which may be OR'd
+together using @code{logior} (@pxref{Primitive Numerics,
+@code{logior}}).  For instance, the following invocation creates a
+locale object that combines the use of Esperanto for messages and
+character classification with the default settings for the other
+categories (i.e., the settings of the default @code{C} locale which
+usually represents conventions in use in the USA):
+
+@example
+(make-locale (logior LC_MESSAGE_MASK LC_CTYPE_MASK) "eo_EO")
+@end example
+
+The following example combines the use of Swedish conventions with
+monetary conventions from Croatia:
+
+@example
+(make-locale LC_MONETARY_MASK "hr_HR"
+             (make-locale LC_ALL_MASK "sv_SE"))
+@end example
+
+A @code{system-error} exception (@pxref{Handling Errors}) is raised by
+@code{make-locale} when @var{locale_name} does not match any of the
+locales compiled on the system.
+
+@end deffn
+
+@deffn {Scheme Procedure} locale? obj
+Return true if @var{obj} is a locale object.
+@end deffn
+
+The following procedures provide support for text collation.
+
+@deffn {Scheme Procedure} string-locale<? s1 s2 [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.
+@end deffn
+
+@deffn {Scheme Procedure} string-locale>? s1 s2 [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.
+@end deffn
+
+@deffn {Scheme Procedure} string-locale-ci<? s1 s2 [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.
+@end deffn
+
+@deffn {Scheme Procedure} string-locale-ci>? s1 s2 [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.
+@end deffn
+
+@deffn {Scheme Procedure} string-locale-ci=? s1 s2 [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.
+@end deffn
+
+@deffn {Scheme Procedure} char-locale<? c1 c2 [locale]
+Return true if character @var{c1} is lower than @var{c2} according to
+@var{locale} or to the current locale.
+@end deffn
+
+@deffn {Scheme Procedure} char-locale>? c1 c2 [locale]
+Return true if character @var{c1} is greater than @var{c2} according
+to @var{locale} or to the current locale.
+@end deffn
+
+@deffn {Scheme Procedure} char-locale-ci<? c1 c2 [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.
+@end deffn
+
+@deffn {Scheme Procedure} char-locale-ci>? c1 c2 [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.
+@end deffn
+
+@deffn {Scheme Procedure} char-locale-ci=? c1 c2 [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.
+@end deffn
+
+The procedures below provide support for ``character case mapping'',
+i.e., to convert characters or strings to their upper-case or
+lower-case equivalent.  Note that SRFI-13 provides procedures that
+look similar (@pxref{Alphabetic Case Mapping}).  However, the SRFI-13
+procedures are locale-independent.  Therefore, they do not take into
+account specificities of the customs in use in a particular language
+or region of the world.  For instance, while most languages using the
+Latin alphabet map lower-case letter ``i'' to upper-case letter ``I'',
+Turkish maps lower-case ``i'' to ``Latin capital letter I with dot
+above''.  The following procedures allow to provide idiomatic
+character mapping.
+
+@deffn {Scheme Procedure} char-locale-downcase chr [locale]
+Return the lowercase character that corresponds to @var{chr} according
+to either @var{locale} or the current locale.
+@end deffn
+
+@deffn {Scheme Procedure} char-locale-upcase chr [locale]
+Return the uppercase character that corresponds to @var{chr} according
+to either @var{locale} or the current locale.
+@end deffn
+
+@deffn {Scheme Procedure} string-locale-upcase str [locale]
+Return a new string that is the uppercase version of @var{str}
+according to either @var{locale} or the current locale.
+@end deffn
+
+@deffn {Scheme Procedure} string-locale-downcase str [locale]
+Return a new string that is the down-case version of @var{str}
+according to either @var{locale} or the current locale.
+@end deffn
+
+Finally, the following procedures allow programs to read numbers
+written according to a particular locale.  As an example, in English,
+``ten thousand and a half'' is usually written @code{10,000.5} while
+in French it is written @code{10000,5}.  These procedures allow to
+account for this differences.
+
+@deffn {Scheme Procedure} locale-string->integer str [base [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.  If @var{base} is specified, then it
+determines the base of the integer being read (e.g., @code{16} for an
+hexadecimal number, @code{10} for a decimal number); by default,
+decimal numbers are read.  Return two values: an integer (on success)
+or @code{#f}, and the number of characters read from @var{str}
+(@code{0} on failure).
+@end deffn
+
+@deffn {Scheme Procedure} locale-string->inexact str [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).
+@end deffn
+
+
+@node Gettext Support
+@subsection Gettext Support
+
 Guile provides an interface to GNU @code{gettext} for translating
 message strings (@pxref{Introduction,,, gettext, GNU @code{gettext}
 utilities}).
@@ -155,4 +415,5 @@ future.
 
 @c Local Variables:
 @c TeX-master: "guile.texi"
+@c ispell-local-dictionary: "american"
 @c End:
--- orig/doc/ref/posix.texi
+++ mod/doc/ref/posix.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -3159,6 +3159,10 @@ categories based on standard environment
 For full details on categories and locale names @pxref{Locales,,
 Locales and Internationalization, libc, The GNU C Library Reference
 Manual}.
+
+Note that @code{setlocale} affects locale settings for the whole
+process.  For a safer, thread-safe and reentrant alternative,
+@xref{The ice-9 i18n Module, Locale Objects and @code{make-locale}}.
 @end deffn
 
 @node Encryption
--- orig/libguile/Makefile.am
+++ mod/libguile/Makefile.am
@@ -31,7 +31,7 @@ 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-v0.la
 bin_PROGRAMS = guile
 
 noinst_PROGRAMS = guile_filter_doc_snarfage gen-scmconfig
@@ -97,9 +97,10 @@ libguile_la_SOURCES = alist.c arbiters.c
     deprecated.c discouraged.c dynwind.c environments.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 +110,16 @@ libguile_la_SOURCES = alist.c arbiters.c
     throw.c values.c variable.c vectors.c version.c vports.c weaks.c	\
     ramap.c unif.c
 
+libguile_i18n_v0_la_SOURCES = i18n.c
+libguile_i18n_v0_la_CFLAGS = $(libguile_la_CFLAGS)
+libguile_i18n_v0_la_LDFLAGS = -module -L$(builddir) -lguile
+
 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 environments.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 +137,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc a
     environments.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 +160,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 +195,8 @@ modinclude_HEADERS = __scm.h alist.h arb
     deprecation.h deprecated.h discouraged.h dynl.h dynwind.h		\
     environments.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 +221,7 @@ EXTRA_DIST = ChangeLog-gh ChangeLog-scm 
     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
 
--- orig/libguile/i18n.c
+++ mod/libguile/gettext.c
@@ -22,11 +22,11 @@
 
 #include "libguile/_scm.h"
 #include "libguile/feature.h"
-#include "libguile/i18n.h"
 #include "libguile/strings.h"
 #include "libguile/dynwind.h"
 
-#include "gettext.h"
+#include "libguile/gettext.h"
+#include "libgettext.h"
 #include <locale.h>
 
 
@@ -312,11 +312,15 @@ SCM_DEFINE (scm_bind_textdomain_codeset,
 }
 #undef FUNC_NAME
 
-void 
-scm_init_i18n ()
+void
+scm_init_gettext ()
 {
+  /* When gettext support was first added (in 1.8.0), it provided feature
+     `i18n'.  We keep this as is although the name is a bit misleading
+     now.  */
   scm_add_feature ("i18n");
-#include "libguile/i18n.x"
+
+#include "libguile/gettext.x"
 }
 
 
--- orig/libguile/i18n.h
+++ mod/libguile/gettext.h
@@ -1,7 +1,7 @@
 /* classes: h_files */
 
-#ifndef SCM_I18N_H
-#define SCM_I18N_H
+#ifndef SCM_GETTEXT_H
+#define SCM_GETTEXT_H
 
 /* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
  *
@@ -30,9 +30,9 @@ SCM_API SCM scm_bind_textdomain_codeset 
 
 SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all);
 
-SCM_API void scm_init_i18n (void);
+SCM_API void scm_init_gettext (void);
 
-#endif  /* SCM_I18N_H */
+#endif  /* SCM_GETTEXT_H */
 
 /*
   Local Variables:
--- orig/libguile/init.c
+++ mod/libguile/init.c
@@ -63,7 +63,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"
@@ -473,7 +473,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 ();
--- orig/libguile/posix.c
+++ mod/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"
 \f
 
@@ -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, 
 }
 #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", 
       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, "gethostnam
 #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");
--- orig/libguile/posix.h
+++ mod/libguile/posix.h
@@ -23,8 +23,7 @@
 \f
 
 #include "libguile/__scm.h"
-
-\f
+#include "libguile/threads.h"
 
 
 \f
@@ -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 */
 
 /*
--- orig/test-suite/Makefile.am
+++ mod/test-suite/Makefile.am
@@ -43,6 +43,7 @@ SCM_TESTS = tests/alist.test			\
 	    tests/guardians.test		\
 	    tests/hash.test			\
 	    tests/hooks.test			\
+	    tests/i18n.test			\
 	    tests/import.test			\
 	    tests/interp.test			\
 	    tests/list.test			\

* added files

--- /dev/null
+++ mod/ice-9/.arch-ids/i18n.scm.id
@@ -0,0 +1 @@
+Ludovic Courtes <ludovic.courtes@laas.fr> Sat Oct 21 16:12:32 2006 29433.0
--- /dev/null
+++ mod/ice-9/i18n.scm
@@ -0,0 +1,68 @@
+;;;; i18n.scm --- internationalization support
+
+;;;;	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
+;;;; 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
+
+;;; Author: Ludovic Courtès <ludovic.courtes@laas.fr>
+
+;;; Commentary:
+;;;
+;;; This module provides a number of routines that support
+;;; internationalization (e.g., locale-dependent text collation, character
+;;; mapping, etc.).  It also defines `locale' objects, representing locale
+;;; settings, that may be passed around to most of these procedures.
+;;;
+
+;;; Code:
+
+(define-module (ice-9 i18n)
+  :export (;; `locale' type
+           make-locale locale?
+
+           ;; locale category masks (standard)
+           LC_ALL_MASK
+           LC_COLLATE_MASK LC_CTYPE_MASK LC_MESSAGES_MASK
+           LC_MONETARY_MASK LC_NUMERIC_MASK LC_TIME_MASK
+
+           ;; locale category masks (non-standard)
+           LC_PAPER_MASK LC_NAME_MASK LC_ADDRESS_MASK
+           LC_TELEPHONE_MASK LC_MEASUREMENT_MASK
+           LC_IDENTIFICATION_MASK
+
+           ;; text collation
+           string-locale<? string-locale>?
+           string-locale-ci<? string-locale-ci>? string-locale-ci=?
+
+           char-locale<? char-locale>?
+           char-locale-ci<? char-locale-ci>? char-locale-ci=?
+
+           ;; character mapping
+           char-locale-downcase char-locale-upcase
+           string-locale-downcase string-locale-upcase
+
+           ;; reading numbers
+           locale-string->integer locale-string->inexact))
+
+
+(dynamic-call "scm_init_i18n"
+              (dynamic-link "libguile-i18n-v0"))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; i18n.scm ends here
--- /dev/null
+++ mod/libguile/.arch-ids/i18n.c.id
@@ -0,0 +1 @@
+Ludovic Courtes <ludovic.courtes@laas.fr> Sat Oct 21 17:24:34 2006 11178.0
--- /dev/null
+++ mod/libguile/.arch-ids/i18n.h.id
@@ -0,0 +1 @@
+Ludovic Courtes <ludovic.courtes@laas.fr> Sat Oct 21 17:24:44 2006 11192.0
--- /dev/null
+++ mod/libguile/.arch-ids/locale-categories.h.id
@@ -0,0 +1 @@
+Ludovic Courtes <ludovic.courtes@laas.fr> Sat Oct 14 17:20:45 2006 6695.0
--- /dev/null
+++ mod/libguile/i18n.c
@@ -0,0 +1,1161 @@
+/* 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
+ * 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
+ */
+
+#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 <locale.h>
+#include <string.h> /* `strcoll ()' */
+#include <ctype.h>  /* `toupper ()' et al. */
+#include <errno.h>
+
+#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
+# define USE_GNU_LOCALE_API
+#endif
+
+#ifndef USE_GNU_LOCALE_API
+# include "libguile/posix.h"  /* for `scm_i_locale_mutex' */
+#endif
+
+#ifndef HAVE_SETLOCALE
+static inline char *
+setlocale (int category, const char *name)
+{
+  errno = ENOSYS;
+  return NULL;
+}
+#endif
+
+
+\f
+/* 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
+
+/* 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
+
+  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
+
+
+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 locale;
+}
+#undef FUNC_NAME
+
+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
+{
+  if (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type, obj))
+    return SCM_BOOL_T;
+
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+
+\f
+#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;
+
+ 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
+}
+
+/* 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 (category_mask == LC_ALL_MASK)
+    {
+      SCM_SYSCALL (result = setlocale (LC_ALL, locale_name));
+      if (result == NULL)
+	goto handle_error;
+    }
+  else
+    {
+#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
+    }
+
+  return 0;
+
+ 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
+	locale = NULL;
+    }
+  while (locale != NULL);
+
+  /* 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;
+    }
+
+  return 0;
+
+ handle_error:
+  return errno;
+}
+
+/* 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);
+}
+
+/* Enter a locked locale section.  */
+static inline int
+enter_locale_section (scm_t_locale locale,
+		      scm_t_locale_settings *prev_locale)
+{
+  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;
+    }
+
+  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 */
+
+\f
+/* Locale-dependent string comparison.  */
+
+/* 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;
+
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
+
+  if (c_locale)
+    {
+#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)
+    {
+#ifdef USE_GNU_LOCALE_API
+      str_upcase_l (c_us1, c_s1, c_locale);
+      str_upcase_l (c_us2, c_s2, c_locale);
+
+      result = strcoll_l (c_us1, c_us2, c_locale);
+#else
+      int err;
+      scm_t_locale_settings prev_locale;
+
+      err = enter_locale_section (c_locale, &prev_locale);
+      if (err)
+	{
+	  scm_locale_error (func_name, err);
+	  return 0;
+	}
+
+      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 */
+
+      leave_locale_section (&prev_locale);
+      free_locale_settings (&prev_locale);
+#endif /* !USE_GNU_LOCALE_API */
+    }
+  else
+    {
+      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_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
+{
+  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_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
+
+
+\f
+/* 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)
+    {
+#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);
+
+  return (SCM_MAKE_CHAR (c_result));
+}
+#undef FUNC_NAME
+
+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_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)
+    {
+#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)
+    {
+#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
+
+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_str = scm_i_string_chars (str);
+  c_lstr = (char *) alloca (strlen (c_str) + 1);
+
+  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
+    str_downcase (c_lstr, c_str);
+
+  scm_remember_upto_here (str);
+
+  return (scm_from_locale_string (c_lstr));
+}
+#undef FUNC_NAME
+
+/* 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.  */
+
+
+\f
+/* 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
+{
+  SCM result;
+  long c_result;
+  int c_base;
+  const char *c_str;
+  char *c_endptr;
+  scm_t_locale c_locale;
+
+  SCM_VALIDATE_STRING (1, str);
+  c_str = scm_i_string_chars (str);
+
+  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)
+    {
+#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;
+
+  SCM_VALIDATE_STRING (1, str);
+  c_str = scm_i_string_chars (str);
+
+  SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale);
+
+  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);
+
+  return (scm_values (scm_list_2 (result, scm_from_long (c_endptr - c_str))));
+}
+#undef FUNC_NAME
+
+
+\f
+void
+scm_init_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
+}
+
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
--- /dev/null
+++ mod/libguile/i18n.h
@@ -0,0 +1,52 @@
+/* classes: h_files */
+
+#ifndef SCM_I18N_H
+#define SCM_I18N_H
+
+/* 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
+ * 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_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);
+
+#endif  /* SCM_I18N_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
--- /dev/null
+++ mod/libguile/locale-categories.h
@@ -0,0 +1,47 @@
+/* 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
+ * 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
+ */
+
+/* A list of all available locale categories, not including `ALL'.  */
+
+
+/* The six standard categories, as defined in IEEE Std 1003.1-2001.  */
+SCM_DEFINE_LOCALE_CATEGORY (COLLATE)
+SCM_DEFINE_LOCALE_CATEGORY (CTYPE)
+SCM_DEFINE_LOCALE_CATEGORY (MESSAGES)
+SCM_DEFINE_LOCALE_CATEGORY (MONETARY)
+SCM_DEFINE_LOCALE_CATEGORY (NUMERIC)
+SCM_DEFINE_LOCALE_CATEGORY (TIME)
+
+/* Additional non-standard categories.  */
+#ifdef LC_PAPER
+SCM_DEFINE_LOCALE_CATEGORY (PAPER)
+#endif
+#ifdef LC_NAME
+SCM_DEFINE_LOCALE_CATEGORY (NAME)
+#endif
+#ifdef LC_ADDRESS
+SCM_DEFINE_LOCALE_CATEGORY (ADDRESS)
+#endif
+#ifdef LC_TELEPHONE
+SCM_DEFINE_LOCALE_CATEGORY (TELEPHONE)
+#endif
+#ifdef LC_MEASUREMENT
+SCM_DEFINE_LOCALE_CATEGORY (MEASUREMENT)
+#endif
+#ifdef LC_IDENTIFICATION
+SCM_DEFINE_LOCALE_CATEGORY (IDENTIFICATION)
+#endif
--- /dev/null
+++ mod/test-suite/tests/.arch-ids/i18n.test.id
@@ -0,0 +1 @@
+Ludovic Courtes <ludovic.courtes@laas.fr> Thu Oct 19 01:46:26 2006 25287.0
--- /dev/null
+++ mod/test-suite/tests/i18n.test
@@ -0,0 +1,143 @@
+;;;; i18n.test --- Exercise the i18n API.
+;;;;
+;;;; Copyright (C) 2006 Free Software Foundation, Inc.
+;;;; Ludovic Courtès
+;;;;
+;;;; 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
+
+(define-module (test-suite i18n)
+  :use-module (ice-9 i18n)
+  :use-module (test-suite lib))
+
+;; Start from a pristine locale state.
+(setlocale LC_ALL "C")
+
+\f
+(with-test-prefix "locale objects"
+
+  (pass-if "make-locale (2 args)"
+    (not (not (make-locale LC_ALL_MASK "C"))))
+
+  (pass-if "make-locale (3 args)"
+    (not (not (make-locale LC_COLLATE_MASK "C"
+                           (make-locale LC_MESSAGES_MASK "C")))))
+
+  (pass-if "locale?"
+    (and (locale? (make-locale LC_ALL_MASK "C"))
+         (locale? (make-locale (logior LC_MESSAGES_MASK LC_NUMERIC_MASK) "C"
+                               (make-locale LC_CTYPE_MASK "C"))))))
+
+
+\f
+(with-test-prefix "text collation (English)"
+
+  (pass-if "string-locale<?"
+    (and (string-locale<? "hello" "world")
+         (string-locale<? "hello" "world"
+                          (make-locale LC_COLLATE_MASK "C"))))
+
+  (pass-if "char-locale<?"
+    (and (char-locale<? #\a #\b)
+         (char-locale<? #\a #\b (make-locale LC_COLLATE_MASK "C"))))
+
+  (pass-if "string-locale-ci=?"
+    (and (string-locale-ci=? "Hello" "HELLO")
+         (string-locale-ci=? "Hello" "HELLO"
+                             (make-locale LC_COLLATE_MASK "C"))))
+
+  (pass-if "string-locale-ci<?"
+    (and (string-locale-ci<? "hello" "WORLD")
+         (string-locale-ci<? "hello" "WORLD"
+                             (make-locale LC_COLLATE_MASK "C")))))
+
+\f
+(define %french-locale
+  (false-if-exception
+   (make-locale (logior LC_CTYPE_MASK LC_COLLATE_MASK)
+                "fr_FR.ISO-8859-1")))
+
+(define (under-french-locale-or-unresolved thunk)
+  ;; On non-GNU systems, an exception may be raised only when the locale is
+  ;; actually used rather than at `make-locale'-time.  Thus, we must guard
+  ;; against both.
+  (if %french-locale
+      (catch 'system-error thunk
+             (lambda (key . args)
+               (throw 'unresolved)))
+      (throw 'unresolved)))
+
+(with-test-prefix "text collation (French)"
+
+  (pass-if "string-locale<?"
+    (under-french-locale-or-unresolved
+      (lambda ()
+        (string-locale<? "été" "hiver" %french-locale))))
+
+  (pass-if "char-locale<?"
+    (under-french-locale-or-unresolved
+      (lambda ()
+        (char-locale<? #\é #\h %french-locale))))
+
+  (pass-if "string-locale-ci=?"
+    (under-french-locale-or-unresolved
+      (lambda ()
+        (string-locale-ci=? "ÉTÉ" "été" %french-locale))))
+
+  (pass-if "string-locale-ci<>?"
+    (under-french-locale-or-unresolved
+      (lambda ()
+        (and (string-locale-ci<? "été" "Hiver" %french-locale)
+             (string-locale-ci>? "HiVeR" "été" %french-locale)))))
+
+  (pass-if "char-locale-ci<>?"
+     (under-french-locale-or-unresolved
+       (lambda ()
+         (and (char-locale-ci<? #\é #\H %french-locale)
+              (char-locale-ci>? #\h #\É %french-locale))))))
+
+\f
+(with-test-prefix "character mapping"
+
+  (pass-if "char-locale-downcase"
+    (and (eq? #\a (char-locale-downcase #\A))
+         (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL_MASK "C")))))
+
+  (pass-if "char-locale-upcase"
+    (and (eq? #\Z (char-locale-upcase #\z))
+         (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL_MASK "C"))))))
+
+\f
+(with-test-prefix "number parsing"
+
+  (pass-if "locale-string->integer"
+    (call-with-values (lambda () (locale-string->integer "123"))
+      (lambda (result char-count)
+        (and (equal? result 123)
+             (equal? char-count 3)))))
+
+  (pass-if "locale-string->inexact"
+    (call-with-values
+        (lambda ()
+          (locale-string->inexact "123.456"
+                                  (make-locale LC_NUMERIC_MASK "C")))
+      (lambda (result char-count)
+        (and (equal? result 123.456)
+             (equal? char-count 7))))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; mode: scheme
+;;; End:

[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel