From b89c494395ce659d04508f47ea489d4fd1002182 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 18 Nov 2006 18:14:55 +0000 Subject: Changes from arch/CVS synchronization --- libguile/ChangeLog | 37 ++ libguile/Makefile.am | 33 +- libguile/gettext.h | 110 ++--- libguile/i18n.c | 1234 ++++++++++++++++++++++++++++++++++++++++++-------- libguile/i18n.h | 27 +- libguile/init.c | 4 +- libguile/posix.c | 27 +- libguile/posix.h | 5 +- 8 files changed, 1185 insertions(+), 292 deletions(-) (limited to 'libguile') 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 + + * 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 * 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 . - 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 - -#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 a NOP. We don't include - as well because people using "gettext.h" will not include , - and also including would fail on SunOS 4, whereas - is OK. */ -#if defined(__sun) -# include -#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 #endif +#if HAVE_ALLOCA_H +# include +#elif defined __GNUC__ +# define alloca __builtin_alloca +#elif defined _AIX +# define alloca __alloca +#elif defined _MSC_VER +# include +# define alloca _alloca +#else +# include +# 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 +#include /* `strcoll ()' */ +#include /* `toupper ()' et al. */ +#include - -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 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_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_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 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 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 #endif +#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L) +# define USE_GNU_LOCALE_API +#endif + #if HAVE_CRYPT_H # include #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 */ /* -- cgit v1.2.1