diff options
author | Ludovic Courtès <ludo@gnu.org> | 2006-11-18 18:14:55 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2006-11-18 18:14:55 +0000 |
commit | b89c494395ce659d04508f47ea489d4fd1002182 (patch) | |
tree | 17049ea4f1e947c4e5083bbe757b843b1195769c | |
parent | cbea802b3763aa8cb43c88f7df272da3e41c32da (diff) |
Changes from arch/CVS synchronization
-rw-r--r-- | ChangeLog | 9 | ||||
-rw-r--r-- | GUILE-VERSION | 6 | ||||
-rw-r--r-- | NEWS | 2 | ||||
-rw-r--r-- | configure.in | 10 | ||||
-rw-r--r-- | doc/ref/ChangeLog | 39 | ||||
-rw-r--r-- | doc/ref/Makefile.am | 9 | ||||
-rwxr-xr-x | doc/ref/api-data.texi | 9 | ||||
-rw-r--r-- | doc/ref/api-i18n.texi | 292 | ||||
-rw-r--r-- | doc/ref/guile.texi | 3 | ||||
-rw-r--r-- | doc/ref/posix.texi | 15 | ||||
-rw-r--r-- | libguile/ChangeLog | 37 | ||||
-rw-r--r-- | libguile/Makefile.am | 33 | ||||
-rw-r--r-- | libguile/gettext.h | 110 | ||||
-rw-r--r-- | libguile/i18n.c | 1234 | ||||
-rw-r--r-- | libguile/i18n.h | 27 | ||||
-rw-r--r-- | libguile/init.c | 4 | ||||
-rw-r--r-- | libguile/posix.c | 27 | ||||
-rw-r--r-- | libguile/posix.h | 5 | ||||
-rw-r--r-- | test-suite/ChangeLog | 28 | ||||
-rw-r--r-- | test-suite/Makefile.am | 1 |
20 files changed, 1582 insertions, 318 deletions
@@ -1,3 +1,12 @@ +2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr> + + * GUILE-VERSION: Added `LIBGUILE_I18N_*'. + + * configure.in: Look for `strcoll_l ()' and `newlocale ()'. + Substitute the `LIBGUILE_I18N_' variables. + + * NEWS: Mention `(ice-9 i18n)'. + 2006-11-17 Neil Jerram <neil@ossau.uklinux.net> * README: Note need for subscription to bug-guile@gnu.org. diff --git a/GUILE-VERSION b/GUILE-VERSION index 9bc0caf4f..c23f8f6f9 100644 --- a/GUILE-VERSION +++ b/GUILE-VERSION @@ -54,3 +54,9 @@ LIBGUILE_SRFI_SRFI_60_INTERFACE_CURRENT=3 LIBGUILE_SRFI_SRFI_60_INTERFACE_REVISION=0 LIBGUILE_SRFI_SRFI_60_INTERFACE_AGE=0 LIBGUILE_SRFI_SRFI_60_INTERFACE="${LIBGUILE_SRFI_SRFI_60_INTERFACE_CURRENT}:${LIBGUILE_SRFI_SRFI_60_INTERFACE_REVISION}:${LIBGUILE_SRFI_SRFI_60_INTERFACE_AGE}" + +LIBGUILE_I18N_MAJOR=0 +LIBGUILE_I18N_INTERFACE_CURRENT=0 +LIBGUILE_I18N_INTERFACE_REVISION=0 +LIBGUILE_I18N_INTERFACE_AGE=0 +LIBGUILE_I18N_INTERFACE="${LIBGUILE_I18N_INTERFACE_CURRENT}:${LIBGUILE_INTERFACE_REVISION}:${LIBGUILE_I18N_INTERFACE_AGE}" @@ -39,6 +39,8 @@ Changes in 1.8.1 (since 1.8.0): ** scm_exp - [C] ** scm_sqrt - [C] +* New `(ice-9 i18n)' module (see the manual for details) + * Bugs fixed ** Build problems have been fixed on MacOS, SunOS, and QNX. diff --git a/configure.in b/configure.in index 6dd983933..8444f60d2 100644 --- a/configure.in +++ b/configure.in @@ -616,8 +616,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 @@ -1275,6 +1276,13 @@ AC_SUBST(LIBGUILE_SRFI_SRFI_60_INTERFACE_REVISION) AC_SUBST(LIBGUILE_SRFI_SRFI_60_INTERFACE_AGE) AC_SUBST(LIBGUILE_SRFI_SRFI_60_INTERFACE) +AC_SUBST(LIBGUILE_I18N_MAJOR) +AC_SUBST(LIBGUILE_I18N_INTERFACE_CURRENT) +AC_SUBST(LIBGUILE_I18N_INTERFACE_REVISION) +AC_SUBST(LIBGUILE_I18N_INTERFACE_AGE) +AC_SUBST(LIBGUILE_I18N_INTERFACE) + + ####################################################################### dnl Tell guile-config what flags guile users should compile and link with. diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 0b3444cb5..8b8e0befe 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,23 @@ +2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr> + + * Makefile.am (BUILT_SOURCES): New variable. + (lib-version.texi): New target. + + * guile.texi: Include `lib-version.texi'. + + * api-data.texi (Conversion): Link to `The ice-9 i18n Module' when + describing `string->number'. + (String Comparison): Likewise. + + * api-i18n.texi (Internationalization)[The ice-9 i18n Module]: New + node. + [Gettext Support]: New node; contains text formerly in + `Internationalization'. + + * posix.texi (Locales): Added a link to the glibc manual + describing the various locale categories. Mention locale objects + and link to `The ice-9 i18n Module' when describing `setlocale'. + 2006-11-17 Neil Jerram <neil@ossau.uklinux.net> * intro.texi (Reporting Bugs): Note need for subscription to @@ -87,7 +107,7 @@ * api-data.texi (Scientific): In sqrt, note it's the positive root which is returned (as per R5RS). -2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr> * api-data.texi (Standard Character Sets): Documented the charset recomputation upon successful `setlocale'. @@ -214,12 +234,12 @@ * posix.texi (Time): In tm:gmtoff, give example values, note not the same as C tm_gmtoff. -2006-06-16 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-06-16 Ludovic Courtès <ludovic.courtes@laas.fr> * api-utility.texi (Equality): Mentioned the behavior of `equal?' for structures (as suggested by Kevin Ryde). -2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr> * api-compound.texi (Structure Concepts): Mentioned the behavior of `equal?' for structures. @@ -286,7 +306,7 @@ SCM_SIMPLE_VECTOR_SET not SCM_SIMPLE_VECTOR_SET_X, the former is what's in vector.h. -2006-03-21 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-03-21 Ludovic Courtès <ludovic.courtes@laas.fr> * api-data.texi (Conversion): Add scm_c_locale_stringn_to_number. @@ -338,7 +358,7 @@ contexts. Renamed all functions from scm_frame_ to scm_dynwind_. Updated documentation. -2005-12-19 Ludovic Courtès <ludovic.courtes@laas.fr> +2005-12-19 Ludovic Courtès <ludovic.courtes@laas.fr> * api-data.texi (Operations Related to Symbols): Documented `scm_take_locale_symbol ()'. @@ -380,7 +400,7 @@ 2005-11-06 Kevin Ryde <user42@zip.com.au> - From Ludovic Courtès, partial rework by me: + From Ludovic Courtès, partial rework by me: * doc/ref/api-modules.texi (Creating Guile Modules): In define-module, describe #:re-export, #:export-syntax, #:re-export-syntax, #:replace and #:duplicates. Add re-export. @@ -393,7 +413,7 @@ * posix.texi (Network Socket Address): Add scm_make_socket_address, scm_c_make_socket_address, scm_from_sockaddr, scm_to_sockaddr. This - change by Ludovic Courtès and revised a bit by me. + change by Ludovic Courtès and revised a bit by me. 2005-10-27 Kevin Ryde <user42@zip.com.au> @@ -2499,3 +2519,8 @@ The change log for files in this directory continues backwards from 2001-08-27 in ../ChangeLog, as all the Guile documentation prior to this date was contained in a single directory. + + +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 76a66f0c9..7d009ff52 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -21,6 +21,9 @@ AUTOMAKE_OPTIONS = gnu +BUILT_SOURCES = lib-version.texi + + info_TEXINFOS = guile.texi guile_TEXINFOS = preface.texi \ @@ -86,4 +89,10 @@ autoconf.texi: autoconf-macros.texi autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4 $(preinstguiletool)/snarf-guile-m4-docs $< > $(srcdir)/$@ +lib-version.texi: $(top_srcdir)/GUILE-VERSION + cat "$^" | grep '^LIBGUILE_.*_MAJOR' | \ + sed 's/^LIBGUILE_\([A-Z0-9_]*\)_MAJOR=\([0-9]\+\)/@set LIBGUILE_\1_MAJOR \2/' \ + > "$@" + + MAINTAINERCLEANFILES = autoconf-macros.texi diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index ccd34e38f..abcb28de1 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1012,6 +1012,12 @@ zero. @rnindex number->string @rnindex string->number +The following procedures read and write numbers according to their +external representation as defined by R5RS (@pxref{Lexical structure, +R5RS Lexical Structure,, r5rs, The Revised^5 Report on the Algorithmic +Language Scheme}). @xref{The ice-9 i18n Module, the @code{(ice-9 +i18n)} module}, for locale-dependent number parsing. + @deffn {Scheme Procedure} number->string n [radix] @deffnx {C Function} scm_number_to_string (n, radix) Return a string holding the external representation of the @@ -2943,7 +2949,8 @@ predicates (@pxref{Characters}), but are defined on character sequences. The first set is specified in R5RS and has names that end in @code{?}. The second set is specified in SRFI-13 and the names have no ending @code{?}. The predicates ending in @code{-ci} ignore the character case -when comparing strings. +when comparing strings. @xref{The ice-9 i18n Module, the @code{(ice-9 +i18n)} module}, for locale-dependent string comparison. @rnindex string=? @deffn {Scheme Procedure} string=? s1 s2 diff --git a/doc/ref/api-i18n.texi b/doc/ref/api-i18n.texi index 63884254a..1927a755b 100644 --- a/doc/ref/api-i18n.texi +++ b/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,292 @@ @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 libguile-i18n-v-@value{LIBGUILE_I18N_MAJOR} + +C programs can use the C functions corresponding to the procedures of +this module by including @code{<libguile/i18n.h>} and by linking +against @code{libguile-i18n-v-@value{LIBGUILE_I18N_MAJOR}}. + +@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] +@deffnx {C Function} scm_make_locale (category_mask, locale_name, base_locale) +Return a reference to a data structure representing a set of locale +datasets. @var{locale-name} should be a string denoting a particular +locale, e.g., @code{"aa_DJ"}. 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. Note that on non-GNU systems, this +error may be raised later, when the locale object is actually used. + +@end deffn + +@deffn {Scheme Procedure} locale? obj +@deffnx {C Function} scm_locale_p (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] +@deffnx {C Function} scm_string_locale_lt (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] +@deffnx {C Function} scm_string_locale_gt (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] +@deffnx {C Function} scm_string_locale_ci_lt (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] +@deffnx {C Function} scm_string_locale_ci_gt (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] +@deffnx {C Function} scm_string_locale_ci_eq (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] +@deffnx {C Function} scm_char_locale_lt (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] +@deffnx {C Function} scm_char_locale_gt (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] +@deffnx {C Function} scm_char_locale_ci_lt (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] +@deffnx {C Function} scm_char_locale_ci_gt (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] +@deffnx {C Function} scm_char_locale_ci_eq (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] +@deffnx {C Function} scm_char_locale_upcase (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] +@deffnx {C Function} scm_char_locale_downcase (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] +@deffnx {C Function} scm_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] +@deffnx {C Function} scm_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 these differences. + +@deffn {Scheme Procedure} locale-string->integer str [base [locale]] +@deffnx {C Function} scm_locale_string_to_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] +@deffnx {C Function} scm_locale_string_to_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}). @@ -19,7 +305,8 @@ catalog filename). When @code{gettext} is not available, or if Guile was configured @samp{--without-nls}, dummy functions doing no translation are -provided. +provided. When @code{gettext} support is available in Guile, the +@code{i18n} feature is provided (@pxref{Feature Tracking}). @deffn {Scheme Procedure} gettext msg [domain [category]] @deffnx {C Function} scm_gettext (msg, domain, category) @@ -155,4 +442,5 @@ future. @c Local Variables: @c TeX-master: "guile.texi" +@c ispell-local-dictionary: "american" @c End: diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index 992ca28c4..109a50b7f 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -7,6 +7,7 @@ @set MANUAL-EDITION 1.1 @c %**end of header @include version.texi +@include lib-version.texi @copying This reference manual documents Guile, GNU's Ubiquitous Intelligent @@ -137,7 +138,7 @@ x @comment The title is printed in a large font. @title Guile Reference Manual @subtitle Edition @value{MANUAL-EDITION}, for use with Guile @value{VERSION} -@c @subtitle $Id: guile.texi,v 1.47 2006-10-09 22:45:02 kryde Exp $ +@c @subtitle $Id: guile.texi,v 1.48 2006-11-18 18:14:55 civodul Exp $ @c See preface.texi for the list of authors @author The Guile Developers diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 0711b9a1e..6f496fe8d 100644 --- a/doc/ref/posix.texi +++ b/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. @@ -3139,10 +3139,11 @@ specified. Get or set the current locale, used for various internationalizations. Locales are strings, such as @samp{sv_SE}. -If @var{locale} is given then the locale for the given @var{category} is set -and the new value returned. If @var{locale} is not given then the -current value is returned. @var{category} should be one of the -following values +If @var{locale} is given then the locale for the given @var{category} +is set and the new value returned. If @var{locale} is not given then +the current value is returned. @var{category} should be one of the +following values (@pxref{Locale Categories, Categories of Activities +that Locales Affect,, libc, The GNU C Library Reference Manual}): @defvar LC_ALL @defvarx LC_COLLATE @@ -3159,6 +3160,10 @@ categories based on standard environment variables (@code{LANG} etc). 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. @xref{The ice-9 i18n Module, locale objects and +@code{make-locale}}, for a thread-safe alternative. @end deffn @node Encryption diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 20186db64..cc567810b 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,40 @@ +2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr> + + * Makefile.am (lib_LTLIBRARIES): Added `libguile-i18n-v-XX.la'. + (libguile_la_SOURCES): Added `gettext.c', removed `i18n.c'. + (libguile_i18n_v_XX_la_SOURCES, libguile_i18n_v_XX_la_CFLAGS, + libguile_i18n_v_XX_la_LIBADD, libguile_i18n_v_XX_la_LDFLAGS): New. + (DOT_X_FILES): Added `gettext.x'. + (DOT_DOC_FILES): Likewise. + (EXTRA_libguile_la_SOURCES): Added `locale-categories.h'. + (modinclude_HEADERS): Added `gettext.h'. + (EXTRA_DIST): Added `libgettext.h'. + + * gettext.h: Renamed to... + * libgettext.h: New file. + + * i18n.c: Renamed to... + * gettext.c: New file. + + * i18n.h: Renamed to... + * gettext.h: New file. + + * i18n.c, i18n.h, locale-categories.h: New files. + + * init.c: Include "libguile/gettext.h" instead of + "libguile/i18n.h". + (scm_i_init_guile): Invoke `scm_init_gettext ()' instead of + `scm_init_i18n ()'. + + * posix.c: Include "libguile/gettext.h" instead of + "libguile/i18n.h" Test `HAVE_NEWLOCALE' and `HAVE_STRCOLL_L'. + (USE_GNU_LOCALE_API): New macro. + (scm_i_locale_mutex): New variable. + (scm_setlocale): Lock and unlock it around `setlocale ()' calls. + + * posix.h: Include "libguile/threads.h". + (scm_i_locale_mutex): New declaration. + 2006-11-17 Neil Jerram <neil@ossau.uklinux.net> * script.c (scm_shell_usage): Note need for subscription to bug-guile@gnu.org. diff --git a/libguile/Makefile.am b/libguile/Makefile.am index e8a161afa..47220ddb6 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -31,7 +31,8 @@ INCLUDES = -I.. -I$(top_srcdir) ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' -lib_LTLIBRARIES = libguile.la +lib_LTLIBRARIES = libguile.la \ + libguile-i18n-v-@LIBGUILE_I18N_MAJOR@.la bin_PROGRAMS = guile noinst_PROGRAMS = guile_filter_doc_snarfage gen-scmconfig @@ -97,9 +98,10 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ deprecated.c discouraged.c dynwind.c eq.c error.c \ eval.c evalext.c extensions.c feature.c fluids.c fports.c \ futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c \ - gc-freelist.c gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c \ + gc-freelist.c gc_os_dep.c gdbint.c gettext.c \ + gh_data.c gh_eval.c gh_funcs.c \ gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c \ - guardians.c hash.c hashtab.c hooks.c i18n.c init.c inline.c \ + guardians.c hash.c hashtab.c hooks.c init.c inline.c \ ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c \ modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c \ print.c procprop.c procs.c properties.c random.c rdelim.c read.c \ @@ -109,11 +111,21 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ throw.c values.c variable.c vectors.c version.c vports.c weaks.c \ ramap.c unif.c +libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c +libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_CFLAGS = \ + $(libguile_la_CFLAGS) +libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LIBADD = \ + libguile.la +libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS = \ + -module -L$(builddir) -lguile \ + -version-info @LIBGUILE_I18N_INTERFACE@ + DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \ continuations.x debug.x deprecation.x deprecated.x discouraged.x \ dynl.x dynwind.x eq.x error.x eval.x evalext.x \ extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x \ - gc-segment.x gc-malloc.x gc-card.x goops.x gsubr.x guardians.x \ + gc-segment.x gc-malloc.x gc-card.x gettext.x goops.x \ + gsubr.x guardians.x \ hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x \ list.x load.x macros.x mallocs.x modules.x numbers.x objects.x \ objprop.x options.x pairs.x ports.x print.x procprop.x procs.x \ @@ -131,7 +143,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \ eq.doc error.doc eval.doc evalext.doc \ extensions.doc feature.doc fluids.doc fports.doc futures.doc \ gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \ - gc-malloc.doc gc-card.doc guardians.doc hash.doc hashtab.doc \ + gc-malloc.doc gc-card.doc gettext.doc \ + guardians.doc hash.doc hashtab.doc \ hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc \ list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc \ objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc \ @@ -153,8 +166,9 @@ EXTRA_libguile_la_SOURCES = _scm.h \ inet_aton.c memmove.c putenv.c strerror.c \ dynl.c regex-posix.c \ filesys.c posix.c net_db.c socket.c \ - debug-malloc.c mkstemp.c \ - win32-uname.c win32-dirent.c win32-socket.c + debug-malloc.c mkstemp.c \ + win32-uname.c win32-dirent.c win32-socket.c \ + locale-categories.h ## delete guile-snarf.awk from the installation bindir, in case it's ## lingering there due to an earlier guile version not having been @@ -187,7 +201,8 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h \ deprecation.h deprecated.h discouraged.h dynl.h dynwind.h \ eq.h error.h eval.h evalext.h extensions.h \ feature.h filesys.h fluids.h fports.h futures.h gc.h \ - gdb_interface.h gdbint.h goops.h gsubr.h guardians.h hash.h \ + gdb_interface.h gdbint.h gettext.h goops.h \ + gsubr.h guardians.h hash.h \ hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h \ keywords.h lang.h list.h load.h macros.h mallocs.h modules.h \ net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h \ @@ -212,7 +227,7 @@ EXTRA_DIST = ChangeLog-gh ChangeLog-scm ChangeLog-threads \ cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c \ cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk \ c-tokenize.lex version.h.in \ - scmconfig.h.top gettext.h + scmconfig.h.top libgettext.h # $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \ # guile-procedures.txt guile.texi diff --git a/libguile/gettext.h b/libguile/gettext.h index f54b6bff7..4d91358e5 100644 --- a/libguile/gettext.h +++ b/libguile/gettext.h @@ -1,69 +1,41 @@ -/* Convenience header for conditional use of GNU <libintl.h>. - Copyright (C) 1995-1998, 2000-2002, 2006 Free Software Foundation, Inc. - - This program is free software; you can redistribute it and/or modify it - under the terms of the GNU Library General Public License as published - by the Free Software Foundation; either version 2, or (at your option) - any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, - USA. */ - -#ifndef _LIBGETTEXT_H -#define _LIBGETTEXT_H 1 - -/* NLS can be disabled through the configure --disable-nls option. */ -#if ENABLE_NLS - -/* Get declarations of GNU message catalog functions. */ -# include <libintl.h> - -#else - -/* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which - chokes if dcgettext is defined as a macro. So include it now, to make - later inclusions of <locale.h> a NOP. We don't include <libintl.h> - as well because people using "gettext.h" will not include <libintl.h>, - and also including <libintl.h> would fail on SunOS 4, whereas <locale.h> - is OK. */ -#if defined(__sun) -# include <locale.h> -#endif - -/* Disabled NLS. - The casts to 'const char *' serve the purpose of producing warnings - for invalid uses of the value returned from these functions. - On pre-ANSI systems without 'const', the config.h file is supposed to - contain "#define const". */ -# define gettext(Msgid) ((const char *) (Msgid)) -# define dgettext(Domainname, Msgid) ((const char *) (Msgid)) -# define dcgettext(Domainname, Msgid, Category) ((const char *) (Msgid)) -# define ngettext(Msgid1, Msgid2, N) \ - ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2)) -# define dngettext(Domainname, Msgid1, Msgid2, N) \ - ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2)) -# define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \ - ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2)) -# define textdomain(Domainname) ((const char *) (Domainname)) -# define bindtextdomain(Domainname, Dirname) ((const char *) (Dirname)) -# define bind_textdomain_codeset(Domainname, Codeset) ((const char *) (Codeset)) - -#endif - -/* A pseudo function call that serves as a marker for the automated - extraction of messages, but does not call gettext(). The run-time - translation is done at a different place in the code. - The argument, String, should be a literal string. Concatenated strings - and other string expressions won't work. - The macro's expansion is not parenthesized, so that it is suitable as - initializer for static 'char[]' or 'const char[]' variables. */ -#define gettext_noop(String) String - -#endif /* _LIBGETTEXT_H */ +/* classes: h_files */ + +#ifndef SCM_GETTEXT_H +#define SCM_GETTEXT_H + +/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +#include "libguile/__scm.h" + +SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category); +SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category); +SCM_API SCM scm_textdomain (SCM domainname); +SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory); +SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding); + +SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all); + +SCM_API void scm_init_gettext (void); + +#endif /* SCM_GETTEXT_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/i18n.c b/libguile/i18n.c index 16e45e495..76dd9a514 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2006 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -15,308 +15,1142 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ +#define _GNU_SOURCE /* Ask for glibc's `newlocale' API */ #if HAVE_CONFIG_H # include <config.h> #endif +#if HAVE_ALLOCA_H +# include <alloca.h> +#elif defined __GNUC__ +# define alloca __builtin_alloca +#elif defined _AIX +# define alloca __alloca +#elif defined _MSC_VER +# include <malloc.h> +# define alloca _alloca +#else +# include <stddef.h> +# ifdef __cplusplus +extern "C" +# endif +void *alloca (size_t); +#endif + #include "libguile/_scm.h" #include "libguile/feature.h" #include "libguile/i18n.h" #include "libguile/strings.h" +#include "libguile/chars.h" #include "libguile/dynwind.h" +#include "libguile/validate.h" +#include "libguile/values.h" -#include "gettext.h" #include <locale.h> +#include <string.h> /* `strcoll ()' */ +#include <ctype.h> /* `toupper ()' et al. */ +#include <errno.h> - -int -scm_i_to_lc_category (SCM category, int allow_lc_all) -{ - int c_category = scm_to_int (category); - switch (c_category) - { -#ifdef LC_CTYPE - case LC_CTYPE: -#endif -#ifdef LC_NUMERIC - case LC_NUMERIC: -#endif -#ifdef LC_COLLATE - case LC_COLLATE: -#endif -#ifdef LC_TIME - case LC_TIME: -#endif -#ifdef LC_MONETARY - case LC_MONETARY: -#endif -#ifdef LC_MESSAGES - case LC_MESSAGES: +#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L) +# define USE_GNU_LOCALE_API #endif -#ifdef LC_PAPER - case LC_PAPER: + +#ifndef USE_GNU_LOCALE_API +# include "libguile/posix.h" /* for `scm_i_locale_mutex' */ #endif -#ifdef LC_NAME - case LC_NAME: + +#ifndef HAVE_SETLOCALE +static inline char * +setlocale (int category, const char *name) +{ + errno = ENOSYS; + return NULL; +} #endif -#ifdef LC_ADDRESS - case LC_ADDRESS: + + + +/* Locale objects, string and character collation, and other locale-dependent + string operations. + + A large part of the code here deals with emulating glibc's reentrant + locale API on non-GNU systems. The emulation is a bit "brute-force": + Whenever a `-locale<?' procedure is passed a locale object, then: + + 1. The `scm_t_locale_mutex' is locked. + 2. A series of `setlocale ()' call is performed to store the current + locale for each category in an `scm_t_locale_settings' object. + 3. A series of `setlocale ()' call is made to install each of the locale + categories of each of the base locales of each locale object, + recursively, starting from the last locale object of the chain. + 4. The settings captured in step (2) are restored. + 5. The `scm_t_locale_mutex' is released. + + Hopefully, some smart standard will make that hack useless someday... + A similar API can be found in MzScheme starting from version 200: + http://download.plt-scheme.org/chronology/mzmr200alpha14.html . + + Note: We don't wrap glibc's `uselocale ()' call because it sets the locale + of the current _thread_ (unlike `setlocale ()') and doing so would require + maintaining per-thread locale information on non-GNU systems and always + re-installing this locale upon locale-dependent calls. */ + + +#ifndef USE_GNU_LOCALE_API + +/* Provide the locale category masks as found in glibc (copied from + <locale.h> as found in glibc 2.3.6). This must be kept in sync with + `locale-categories.h'. */ + +# define LC_CTYPE_MASK (1 << LC_CTYPE) +# define LC_COLLATE_MASK (1 << LC_COLLATE) +# define LC_MESSAGES_MASK (1 << LC_MESSAGES) +# define LC_MONETARY_MASK (1 << LC_MONETARY) +# define LC_NUMERIC_MASK (1 << LC_NUMERIC) +# define LC_TIME_MASK (1 << LC_TIME) + +# ifdef LC_PAPER +# define LC_PAPER_MASK (1 << LC_PAPER) +# else +# define LC_PAPER_MASK 0 +# endif +# ifdef LC_NAME +# define LC_NAME_MASK (1 << LC_NAME) +# else +# define LC_NAME_MASK 0 +# endif +# ifdef LC_ADDRESS +# define LC_ADDRESS_MASK (1 << LC_ADDRESS) +# else +# define LC_ADDRESS_MASK 0 +# endif +# ifdef LC_TELEPHONE +# define LC_TELEPHONE_MASK (1 << LC_TELEPHONE) +# else +# define LC_TELEPHONE_MASK 0 +# endif +# ifdef LC_MEASUREMENT +# define LC_MEASUREMENT_MASK (1 << LC_MEASUREMENT) +# else +# define LC_MEASUREMENT_MASK 0 +# endif +# ifdef LC_IDENTIFICATION +# define LC_IDENTIFICATION_MASK (1 << LC_IDENTIFICATION) +# else +# define LC_IDENTIFICATION_MASK 0 +# endif + +# define LC_ALL_MASK (LC_CTYPE_MASK \ + | LC_NUMERIC_MASK \ + | LC_TIME_MASK \ + | LC_COLLATE_MASK \ + | LC_MONETARY_MASK \ + | LC_MESSAGES_MASK \ + | LC_PAPER_MASK \ + | LC_NAME_MASK \ + | LC_ADDRESS_MASK \ + | LC_TELEPHONE_MASK \ + | LC_MEASUREMENT_MASK \ + | LC_IDENTIFICATION_MASK \ + ) + +/* Locale objects as returned by `make-locale' on non-GNU systems. */ +typedef struct scm_locale +{ + SCM base_locale; /* a `locale' object */ + char *locale_name; + int category_mask; +} *scm_t_locale; + +#else + +/* Alias for glibc's locale type. */ +typedef locale_t scm_t_locale; + #endif -#ifdef LC_TELEPHONE - case LC_TELEPHONE: + +/* Validate parameter ARG as a locale object and set C_LOCALE to the + corresponding C locale object. */ +#define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale) \ + do \ + { \ + SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type); \ + (_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg); \ + } \ + while (0) + +/* Validate optional parameter ARG as either undefined or bound to a locale + object. Set C_LOCALE to the corresponding C locale object or NULL. */ +#define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \ + do \ + { \ + if ((_arg) != SCM_UNDEFINED) \ + SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \ + else \ + (_c_locale) = NULL; \ + } \ + while (0) + + +SCM_SMOB (scm_tc16_locale_smob_type, "locale", 0); + +SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale) +{ + scm_t_locale c_locale; + + c_locale = (scm_t_locale)SCM_SMOB_DATA (locale); + +#ifdef USE_GNU_LOCALE_API + freelocale ((locale_t)c_locale); +#else + c_locale->base_locale = SCM_UNDEFINED; + free (c_locale->locale_name); + + scm_gc_free (c_locale, sizeof (* c_locale), "locale"); #endif -#ifdef LC_MEASUREMENT - case LC_MEASUREMENT: + + return 0; +} + +#ifndef USE_GNU_LOCALE_API +static SCM +smob_locale_mark (SCM locale) +{ + scm_t_locale c_locale; + + c_locale = (scm_t_locale)SCM_SMOB_DATA (locale); + return (c_locale->base_locale); +} #endif -#ifdef LC_IDENTIFICATION - case LC_IDENTIFICATION: + + +SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0, + (SCM category_mask, SCM locale_name, SCM base_locale), + "Return a reference to a data structure representing a set of " + "locale datasets. Unlike for the @var{category} parameter for " + "@code{setlocale}, the @var{category_mask} parameter here uses " + "a single bit for each category, made by OR'ing together " + "@code{LC_*_MASK} bits.") +#define FUNC_NAME s_scm_make_locale +{ + SCM locale = SCM_BOOL_F; + int c_category_mask; + char *c_locale_name; + scm_t_locale c_base_locale, c_locale; + + SCM_VALIDATE_INT_COPY (1, category_mask, c_category_mask); + SCM_VALIDATE_STRING (2, locale_name); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, base_locale, c_base_locale); + + c_locale_name = scm_to_locale_string (locale_name); + +#ifdef USE_GNU_LOCALE_API + + c_locale = newlocale (c_category_mask, c_locale_name, c_base_locale); + + if (!c_locale) + locale = SCM_BOOL_F; + else + SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale); + + free (c_locale_name); + +#else + + c_locale = scm_gc_malloc (sizeof (* c_locale), "locale"); + c_locale->base_locale = base_locale; + + c_locale->category_mask = c_category_mask; + c_locale->locale_name = c_locale_name; + + SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale); + #endif - return c_category; -#ifdef LC_ALL - case LC_ALL: - if (allow_lc_all) - return c_category; -#endif - } - scm_wrong_type_arg (0, 0, category); + + return locale; } +#undef FUNC_NAME -SCM_DEFINE (scm_gettext, "gettext", 1, 2, 0, - (SCM msgid, SCM domain, SCM category), - "Return the translation of @var{msgid} in the message domain " - "@var{domain}. @var{domain} is optional and defaults to the " - "domain set through (textdomain). @var{category} is optional " - "and defaults to LC_MESSAGES.") -#define FUNC_NAME s_scm_gettext +SCM_DEFINE (scm_locale_p, "locale?", 1, 0, 0, + (SCM obj), + "Return true if @var{obj} is a locale object.") +#define FUNC_NAME s_scm_locale_p { - char *c_msgid; - char const *c_result; - SCM result; + if (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type, obj)) + return SCM_BOOL_T; + + return SCM_BOOL_F; +} +#undef FUNC_NAME + + + +#ifndef USE_GNU_LOCALE_API /* Emulate GNU's reentrant locale API. */ + + +/* Maximum number of chained locales (via `base_locale'). */ +#define LOCALE_STACK_SIZE_MAX 256 + +typedef struct +{ +#define SCM_DEFINE_LOCALE_CATEGORY(_name) char * _name; +#include "locale-categories.h" +#undef SCM_DEFINE_LOCALE_CATEGORY +} scm_t_locale_settings; + +/* Fill out SETTINGS according to the current locale settings. On success + zero is returned and SETTINGS is properly initialized. */ +static int +get_current_locale_settings (scm_t_locale_settings *settings) +{ + const char *locale_name; + +#define SCM_DEFINE_LOCALE_CATEGORY(_name) \ + { \ + SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \ + if (!locale_name) \ + goto handle_error; \ + \ + settings-> _name = strdup (locale_name); \ + if (settings-> _name == NULL) \ + goto handle_oom; \ + } + +#include "locale-categories.h" +#undef SCM_DEFINE_LOCALE_CATEGORY + + return 0; + + handle_error: + return errno; - scm_dynwind_begin (0); + handle_oom: + return ENOMEM; +} + +/* Restore locale settings SETTINGS. On success, return zero. */ +static int +restore_locale_settings (const scm_t_locale_settings *settings) +{ + const char *result; + +#define SCM_DEFINE_LOCALE_CATEGORY(_name) \ + SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name)); \ + if (result == NULL) \ + goto handle_error; + +#include "locale-categories.h" +#undef SCM_DEFINE_LOCALE_CATEGORY + + return 0; + + handle_error: + return errno; +} + +/* Free memory associated with SETTINGS. */ +static void +free_locale_settings (scm_t_locale_settings *settings) +{ +#define SCM_DEFINE_LOCALE_CATEGORY(_name) \ + free (settings-> _name); \ + settings->_name = NULL; +#include "locale-categories.h" +#undef SCM_DEFINE_LOCALE_CATEGORY +} - c_msgid = scm_to_locale_string (msgid); - scm_dynwind_free (c_msgid); +/* Install the locale named LOCALE_NAME for all the categories listed in + CATEGORY_MASK. */ +static int +install_locale_categories (const char *locale_name, int category_mask) +{ + const char *result; - if (SCM_UNBNDP (domain)) + if (category_mask == LC_ALL_MASK) { - /* 1 argument case. */ - c_result = gettext (c_msgid); + SCM_SYSCALL (result = setlocale (LC_ALL, locale_name)); + if (result == NULL) + goto handle_error; } else { - char *c_domain; +#define SCM_DEFINE_LOCALE_CATEGORY(_name) \ + if (category_mask & LC_ ## _name ## _MASK) \ + { \ + SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \ + if (result == NULL) \ + goto handle_error; \ + } +#include "locale-categories.h" +#undef SCM_DEFINE_LOCALE_CATEGORY + } - c_domain = scm_to_locale_string (domain); - scm_dynwind_free (c_domain); + return 0; - if (SCM_UNBNDP (category)) - { - /* 2 argument case. */ - c_result = dgettext (c_domain, c_msgid); - } + handle_error: + return errno; +} + +/* Install LOCALE, recursively installing its base locales first. On + success, zero is returned. */ +static int +install_locale (scm_t_locale locale) +{ + scm_t_locale stack[LOCALE_STACK_SIZE_MAX]; + size_t stack_size = 0; + int stack_offset = 0; + const char *result = NULL; + + /* Build up a locale stack by traversing the `base_locale' link. */ + do + { + if (stack_size >= LOCALE_STACK_SIZE_MAX) + /* We cannot use `scm_error ()' here because otherwise the locale + mutex may remain locked. */ + return EINVAL; + + stack[stack_size++] = locale; + + if (locale->base_locale != SCM_UNDEFINED) + locale = (scm_t_locale)SCM_SMOB_DATA (locale->base_locale); else - { - /* 3 argument case. */ - int c_category; + locale = NULL; + } + while (locale != NULL); - c_category = scm_i_to_lc_category (category, 0); - c_result = dcgettext (c_domain, c_msgid, c_category); - } + /* Install the C locale to start from a pristine state. */ + SCM_SYSCALL (result = setlocale (LC_ALL, "C")); + if (result == NULL) + goto handle_error; + + /* Install the locales in reverse order. */ + for (stack_offset = stack_size - 1; + stack_offset >= 0; + stack_offset--) + { + int err; + scm_t_locale locale; + + locale = stack[stack_offset]; + err = install_locale_categories (locale->locale_name, + locale->category_mask); + if (err) + goto handle_error; } - if (c_result == c_msgid) - result = msgid; - else - result = scm_from_locale_string (c_result); + return 0; - scm_dynwind_end (); - return result; + handle_error: + return errno; } -#undef FUNC_NAME +/* Leave the locked locale section. */ +static inline void +leave_locale_section (const scm_t_locale_settings *settings) +{ + /* Restore the previous locale settings. */ + (void)restore_locale_settings (settings); + + scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); +} -SCM_DEFINE (scm_ngettext, "ngettext", 3, 2, 0, - (SCM msgid, SCM msgid_plural, SCM n, SCM domain, SCM category), - "Return the translation of @var{msgid}/@var{msgid_plural} in the " - "message domain @var{domain}, with the plural form being chosen " - "appropriately for the number @var{n}. @var{domain} is optional " - "and defaults to the domain set through (textdomain). " - "@var{category} is optional and defaults to LC_MESSAGES.") -#define FUNC_NAME s_scm_ngettext +/* Enter a locked locale section. */ +static inline int +enter_locale_section (scm_t_locale locale, + scm_t_locale_settings *prev_locale) { - char *c_msgid; - char *c_msgid_plural; - unsigned long c_n; - const char *c_result; - SCM result; + int err; + + scm_i_pthread_mutex_lock (&scm_i_locale_mutex); + + err = get_current_locale_settings (prev_locale); + if (err) + { + scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); + return err; + } - scm_dynwind_begin (0); + err = install_locale (locale); + if (err) + { + leave_locale_section (prev_locale); + free_locale_settings (prev_locale); + } + + return err; +} + +/* Throw an exception corresponding to error ERR. */ +static void inline +scm_locale_error (const char *func_name, int err) +{ + SCM s_err; + + s_err = scm_from_int (err); + scm_error (scm_system_error_key, func_name, + "Failed to install locale", + scm_cons (scm_strerror (s_err), SCM_EOL), + scm_cons (s_err, SCM_EOL)); +} + +/* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */ +#define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \ + do \ + { \ + int lsec_err; \ + scm_t_locale_settings lsec_prev_locale; \ + \ + lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale); \ + if (lsec_err) \ + scm_locale_error (FUNC_NAME, lsec_err); \ + else \ + { \ + _statement ; \ + \ + leave_locale_section (&lsec_prev_locale); \ + free_locale_settings (&lsec_prev_locale); \ + } \ + } \ + while (0) + +#endif /* !USE_GNU_LOCALE_API */ - c_msgid = scm_to_locale_string (msgid); - scm_dynwind_free (c_msgid); + +/* Locale-dependent string comparison. */ - c_msgid_plural = scm_to_locale_string (msgid_plural); - scm_dynwind_free (c_msgid_plural); +/* Compare null-terminated strings C_S1 and C_S2 according to LOCALE. Return + an integer whose sign is the same as the difference between C_S1 and + C_S2. */ +static inline int +compare_strings (const char *c_s1, const char *c_s2, SCM locale, + const char *func_name) +#define FUNC_NAME func_name +{ + int result; + scm_t_locale c_locale; - c_n = scm_to_ulong (n); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale); - if (SCM_UNBNDP (domain)) + if (c_locale) { - /* 3 argument case. */ - c_result = ngettext (c_msgid, c_msgid_plural, c_n); +#ifdef USE_GNU_LOCALE_API + result = strcoll_l (c_s1, c_s2, c_locale); +#else +#ifdef HAVE_STRCOLL + RUN_IN_LOCALE_SECTION (c_locale, result = strcoll (c_s1, c_s2)); +#else + result = strcmp (c_s1, c_s2); +#endif +#endif /* !USE_GNU_LOCALE_API */ } else + +#ifdef HAVE_STRCOLL + result = strcoll (c_s1, c_s2); +#else + result = strcmp (c_s1, c_s2); +#endif + + return result; +} +#undef FUNC_NAME + +/* Store into DST an upper-case version of SRC. */ +static inline void +str_upcase (register char *dst, register const char *src) +{ + for (; *src != '\0'; src++, dst++) + *dst = toupper (*src); + *dst = '\0'; +} + +static inline void +str_downcase (register char *dst, register const char *src) +{ + for (; *src != '\0'; src++, dst++) + *dst = tolower (*src); + *dst = '\0'; +} + +#ifdef USE_GNU_LOCALE_API +static inline void +str_upcase_l (register char *dst, register const char *src, + scm_t_locale locale) +{ + for (; *src != '\0'; src++, dst++) + *dst = toupper_l (*src, locale); + *dst = '\0'; +} + +static inline void +str_downcase_l (register char *dst, register const char *src, + scm_t_locale locale) +{ + for (; *src != '\0'; src++, dst++) + *dst = tolower_l (*src, locale); + *dst = '\0'; +} +#endif + + +/* Compare null-terminated strings C_S1 and C_S2 in a case-independent way + according to LOCALE. Return an integer whose sign is the same as the + difference between C_S1 and C_S2. */ +static inline int +compare_strings_ci (const char *c_s1, const char *c_s2, SCM locale, + const char *func_name) +#define FUNC_NAME func_name +{ + int result; + scm_t_locale c_locale; + char *c_us1, *c_us2; + + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale); + + c_us1 = (char *) alloca (strlen (c_s1) + 1); + c_us2 = (char *) alloca (strlen (c_s2) + 1); + + if (c_locale) { - char *c_domain; +#ifdef USE_GNU_LOCALE_API + str_upcase_l (c_us1, c_s1, c_locale); + str_upcase_l (c_us2, c_s2, c_locale); - c_domain = scm_to_locale_string (domain); - scm_dynwind_free (c_domain); + result = strcoll_l (c_us1, c_us2, c_locale); +#else + int err; + scm_t_locale_settings prev_locale; - if (SCM_UNBNDP (category)) + err = enter_locale_section (c_locale, &prev_locale); + if (err) { - /* 4 argument case. */ - c_result = dngettext (c_domain, c_msgid, c_msgid_plural, c_n); + scm_locale_error (func_name, err); + return 0; } - else - { - /* 5 argument case. */ - int c_category; - c_category = scm_i_to_lc_category (category, 0); - c_result = dcngettext (c_domain, c_msgid, c_msgid_plural, c_n, - c_category); - } - } + str_upcase (c_us1, c_s1); + str_upcase (c_us2, c_s2); + +#ifdef HAVE_STRCOLL + result = strcoll (c_us1, c_us2); +#else + result = strcmp (c_us1, c_us2); +#endif /* !HAVE_STRCOLL */ - if (c_result == c_msgid) - result = msgid; - else if (c_result == c_msgid_plural) - result = msgid_plural; + leave_locale_section (&prev_locale); + free_locale_settings (&prev_locale); +#endif /* !USE_GNU_LOCALE_API */ + } else - result = scm_from_locale_string (c_result); - - scm_dynwind_end (); + { + str_upcase (c_us1, c_s1); + str_upcase (c_us2, c_s2); + +#ifdef HAVE_STRCOLL + result = strcoll (c_us1, c_us2); +#else + result = strcmp (c_us1, c_us2); +#endif + } + return result; } #undef FUNC_NAME -SCM_DEFINE (scm_textdomain, "textdomain", 0, 1, 0, - (SCM domainname), - "If optional parameter @var{domainname} is supplied, " - "set the textdomain. " - "Return the textdomain.") -#define FUNC_NAME s_scm_textdomain + +SCM_DEFINE (scm_string_locale_lt, "string-locale<?", 2, 1, 0, + (SCM s1, SCM s2, SCM locale), + "Compare strings @var{s1} and @var{s2} in a locale-dependent way." + "If @var{locale} is provided, it should be locale object (as " + "returned by @code{make-locale}) and will be used to perform the " + "comparison; otherwise, the current system locale is used.") +#define FUNC_NAME s_scm_string_locale_lt { - char const *c_result; - char *c_domain; - SCM result = SCM_BOOL_F; + int result; + const char *c_s1, *c_s2; - scm_dynwind_begin (0); + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); - if (SCM_UNBNDP (domainname)) - c_domain = NULL; - else + c_s1 = scm_i_string_chars (s1); + c_s2 = scm_i_string_chars (s2); + + result = compare_strings (c_s1, c_s2, locale, FUNC_NAME); + + scm_remember_upto_here_2 (s1, s2); + + return scm_from_bool (result < 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_string_locale_gt, "string-locale>?", 2, 1, 0, + (SCM s1, SCM s2, SCM locale), + "Compare strings @var{s1} and @var{s2} in a locale-dependent way." + "If @var{locale} is provided, it should be locale object (as " + "returned by @code{make-locale}) and will be used to perform the " + "comparison; otherwise, the current system locale is used.") +#define FUNC_NAME s_scm_string_locale_gt +{ + int result; + const char *c_s1, *c_s2; + + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + c_s1 = scm_i_string_chars (s1); + c_s2 = scm_i_string_chars (s2); + + result = compare_strings (c_s1, c_s2, locale, FUNC_NAME); + + scm_remember_upto_here_2 (s1, s2); + + return scm_from_bool (result > 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_string_locale_ci_lt, "string-locale-ci<?", 2, 1, 0, + (SCM s1, SCM s2, SCM locale), + "Compare strings @var{s1} and @var{s2} in a case-insensitive, " + "and locale-dependent way. If @var{locale} is provided, it " + "should be locale object (as returned by @code{make-locale}) " + "and will be used to perform the comparison; otherwise, the " + "current system locale is used.") +#define FUNC_NAME s_scm_string_locale_ci_lt +{ + int result; + const char *c_s1, *c_s2; + + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + c_s1 = scm_i_string_chars (s1); + c_s2 = scm_i_string_chars (s2); + + result = compare_strings_ci (c_s1, c_s2, locale, FUNC_NAME); + + scm_remember_upto_here_2 (s1, s2); + + return scm_from_bool (result < 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_string_locale_ci_gt, "string-locale-ci>?", 2, 1, 0, + (SCM s1, SCM s2, SCM locale), + "Compare strings @var{s1} and @var{s2} in a case-insensitive, " + "and locale-dependent way. If @var{locale} is provided, it " + "should be locale object (as returned by @code{make-locale}) " + "and will be used to perform the comparison; otherwise, the " + "current system locale is used.") +#define FUNC_NAME s_scm_string_locale_ci_gt +{ + int result; + const char *c_s1, *c_s2; + + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + c_s1 = scm_i_string_chars (s1); + c_s2 = scm_i_string_chars (s2); + + result = compare_strings_ci (c_s1, c_s2, locale, FUNC_NAME); + + scm_remember_upto_here_2 (s1, s2); + + return scm_from_bool (result > 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_string_locale_ci_eq, "string-locale-ci=?", 2, 1, 0, + (SCM s1, SCM s2, SCM locale), + "Compare strings @var{s1} and @var{s2} in a case-insensitive, " + "and locale-dependent way. If @var{locale} is provided, it " + "should be locale object (as returned by @code{make-locale}) " + "and will be used to perform the comparison; otherwise, the " + "current system locale is used.") +#define FUNC_NAME s_scm_string_locale_ci_eq +{ + int result; + const char *c_s1, *c_s2; + + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + c_s1 = scm_i_string_chars (s1); + c_s2 = scm_i_string_chars (s2); + + result = compare_strings_ci (c_s1, c_s2, locale, FUNC_NAME); + + scm_remember_upto_here_2 (s1, s2); + + return scm_from_bool (result == 0); +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_char_locale_lt, "char-locale<?", 2, 1, 0, + (SCM c1, SCM c2, SCM locale), + "Return true if character @var{c1} is lower than @var{c2} " + "according to @var{locale} or to the current locale.") +#define FUNC_NAME s_scm_char_locale_lt +{ + char c_c1[2], c_c2[2]; + + SCM_VALIDATE_CHAR (1, c1); + SCM_VALIDATE_CHAR (2, c2); + + c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0'; + c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0'; + + return scm_from_bool (compare_strings (c_c1, c_c2, locale, FUNC_NAME) < 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_char_locale_gt, "char-locale>?", 2, 1, 0, + (SCM c1, SCM c2, SCM locale), + "Return true if character @var{c1} is greater than @var{c2} " + "according to @var{locale} or to the current locale.") +#define FUNC_NAME s_scm_char_locale_gt +{ + char c_c1[2], c_c2[2]; + + SCM_VALIDATE_CHAR (1, c1); + SCM_VALIDATE_CHAR (2, c2); + + c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0'; + c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0'; + + return scm_from_bool (compare_strings (c_c1, c_c2, locale, FUNC_NAME) > 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_char_locale_ci_lt, "char-locale-ci<?", 2, 1, 0, + (SCM c1, SCM c2, SCM locale), + "Return true if character @var{c1} is lower than @var{c2}, " + "in a case insensitive way according to @var{locale} or to " + "the current locale.") +#define FUNC_NAME s_scm_char_locale_ci_lt +{ + int result; + char c_c1[2], c_c2[2]; + + SCM_VALIDATE_CHAR (1, c1); + SCM_VALIDATE_CHAR (2, c2); + + c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0'; + c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0'; + + result = compare_strings_ci (c_c1, c_c2, locale, FUNC_NAME); + + return scm_from_bool (result < 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_char_locale_ci_gt, "char-locale-ci>?", 2, 1, 0, + (SCM c1, SCM c2, SCM locale), + "Return true if character @var{c1} is greater than @var{c2}, " + "in a case insensitive way according to @var{locale} or to " + "the current locale.") +#define FUNC_NAME s_scm_char_locale_ci_gt +{ + int result; + char c_c1[2], c_c2[2]; + + SCM_VALIDATE_CHAR (1, c1); + SCM_VALIDATE_CHAR (2, c2); + + c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0'; + c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0'; + + result = compare_strings_ci (c_c1, c_c2, locale, FUNC_NAME); + + return scm_from_bool (result > 0); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_char_locale_ci_eq, "char-locale-ci=?", 2, 1, 0, + (SCM c1, SCM c2, SCM locale), + "Return true if character @var{c1} is equal to @var{c2}, " + "in a case insensitive way according to @var{locale} or to " + "the current locale.") +#define FUNC_NAME s_scm_char_locale_ci_eq +{ + int result; + char c_c1[2], c_c2[2]; + + SCM_VALIDATE_CHAR (1, c1); + SCM_VALIDATE_CHAR (2, c2); + + c_c1[0] = (char)SCM_CHAR (c1); c_c1[1] = '\0'; + c_c2[0] = (char)SCM_CHAR (c2); c_c2[1] = '\0'; + + result = compare_strings_ci (c_c1, c_c2, locale, FUNC_NAME); + + return scm_from_bool (result == 0); +} +#undef FUNC_NAME + + + +/* Locale-dependent alphabetic character mapping. */ + +SCM_DEFINE (scm_char_locale_downcase, "char-locale-downcase", 1, 1, 0, + (SCM chr, SCM locale), + "Return the lowercase character that corresponds to @var{chr} " + "according to either @var{locale} or the current locale.") +#define FUNC_NAME s_scm_char_locale_downcase +{ + char c_chr; + int c_result; + scm_t_locale c_locale; + + SCM_VALIDATE_CHAR (1, chr); + c_chr = SCM_CHAR (chr); + + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale); + + if (c_locale != NULL) { - c_domain = scm_to_locale_string (domainname); - scm_dynwind_free (c_domain); +#ifdef USE_GNU_LOCALE_API + c_result = tolower_l (c_chr, c_locale); +#else + RUN_IN_LOCALE_SECTION (c_locale, c_result = tolower (c_chr)); +#endif } + else + c_result = tolower (c_chr); - c_result = textdomain (c_domain); - if (c_result != NULL) - result = scm_from_locale_string (c_result); - else if (!SCM_UNBNDP (domainname)) - SCM_SYSERROR; - - scm_dynwind_end (); - return result; + return (SCM_MAKE_CHAR (c_result)); } #undef FUNC_NAME -SCM_DEFINE (scm_bindtextdomain, "bindtextdomain", 1, 1, 0, - (SCM domainname, SCM directory), - "If optional parameter @var{directory} is supplied, " - "set message catalogs to directory @var{directory}. " - "Return the directory bound to @var{domainname}.") -#define FUNC_NAME s_scm_bindtextdomain +SCM_DEFINE (scm_char_locale_upcase, "char-locale-upcase", 1, 1, 0, + (SCM chr, SCM locale), + "Return the uppercase character that corresponds to @var{chr} " + "according to either @var{locale} or the current locale.") +#define FUNC_NAME s_scm_char_locale_upcase { - char *c_domain; - char *c_directory; - char const *c_result; - SCM result; + char c_chr; + int c_result; + scm_t_locale c_locale; + + SCM_VALIDATE_CHAR (1, chr); + c_chr = SCM_CHAR (chr); - scm_dynwind_begin (0); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale); - if (SCM_UNBNDP (directory)) - c_directory = NULL; + if (c_locale != NULL) + { +#ifdef USE_GNU_LOCALE_API + c_result = toupper_l (c_chr, c_locale); +#else + RUN_IN_LOCALE_SECTION (c_locale, c_result = toupper (c_chr)); +#endif + } else + c_result = toupper (c_chr); + + return (SCM_MAKE_CHAR (c_result)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_string_locale_upcase, "string-locale-upcase", 1, 1, 0, + (SCM str, SCM locale), + "Return a new string that is the uppercase version of " + "@var{str} according to either @var{locale} or the current " + "locale.") +#define FUNC_NAME s_scm_string_locale_upcase +{ + const char *c_str; + char *c_ustr; + scm_t_locale c_locale; + + SCM_VALIDATE_STRING (1, str); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale); + + c_str = scm_i_string_chars (str); + c_ustr = (char *) alloca (strlen (c_str) + 1); + + if (c_locale) { - c_directory = scm_to_locale_string (directory); - scm_dynwind_free (c_directory); +#ifdef USE_GNU_LOCALE_API + str_upcase_l (c_ustr, c_str, c_locale); +#else + RUN_IN_LOCALE_SECTION (c_locale, str_upcase (c_ustr, c_str)); +#endif } + else + str_upcase (c_ustr, c_str); + + scm_remember_upto_here (str); + + return (scm_from_locale_string (c_ustr)); +} +#undef FUNC_NAME - c_domain = scm_to_locale_string (domainname); - scm_dynwind_free (c_domain); +SCM_DEFINE (scm_string_locale_downcase, "string-locale-downcase", 1, 1, 0, + (SCM str, SCM locale), + "Return a new string that is the down-case version of " + "@var{str} according to either @var{locale} or the current " + "locale.") +#define FUNC_NAME s_scm_string_locale_downcase +{ + const char *c_str; + char *c_lstr; + scm_t_locale c_locale; + + SCM_VALIDATE_STRING (1, str); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale); - c_result = bindtextdomain (c_domain, c_directory); + c_str = scm_i_string_chars (str); + c_lstr = (char *) alloca (strlen (c_str) + 1); - if (c_result != NULL) - result = scm_from_locale_string (c_result); - else if (!SCM_UNBNDP (directory)) - SCM_SYSERROR; + if (c_locale) + { +#ifdef USE_GNU_LOCALE_API + str_downcase_l (c_lstr, c_str, c_locale); +#else + RUN_IN_LOCALE_SECTION (c_locale, str_downcase (c_lstr, c_str)); +#endif + } else - result = SCM_BOOL_F; + str_downcase (c_lstr, c_str); - scm_dynwind_end (); - return result; + scm_remember_upto_here (str); + + return (scm_from_locale_string (c_lstr)); } #undef FUNC_NAME -SCM_DEFINE (scm_bind_textdomain_codeset, "bind-textdomain-codeset", 1, 1, 0, - (SCM domainname, SCM encoding), - "If optional parameter @var{encoding} is supplied, " - "set encoding for message catalogs of @var{domainname}. " - "Return the encoding of @var{domainname}.") -#define FUNC_NAME s_scm_bind_textdomain_codeset +/* Note: We don't provide mutative versions of `string-locale-(up|down)case' + because, in some languages, a single downcase character maps to a couple + of uppercase characters. Read the SRFI-13 document for a detailed + discussion about this. */ + + + +/* Locale-dependent number parsing. */ + +SCM_DEFINE (scm_locale_string_to_integer, "locale-string->integer", + 1, 2, 0, (SCM str, SCM base, SCM locale), + "Convert string @var{str} into an integer according to either " + "@var{locale} (a locale object as returned by @code{make-locale}) " + "or the current process locale. Return two values: an integer " + "(on success) or @code{#f}, and the number of characters read " + "from @var{str} (@code{0} on failure).") +#define FUNC_NAME s_scm_locale_string_to_integer { - char *c_domain; - char *c_encoding; - char const *c_result; SCM result; + long c_result; + int c_base; + const char *c_str; + char *c_endptr; + scm_t_locale c_locale; - scm_dynwind_begin (0); + SCM_VALIDATE_STRING (1, str); + c_str = scm_i_string_chars (str); - if (SCM_UNBNDP (encoding)) - c_encoding = NULL; + if (base != SCM_UNDEFINED) + SCM_VALIDATE_INT_COPY (2, base, c_base); else + c_base = 10; + + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale); + + if (c_locale != NULL) { - c_encoding = scm_to_locale_string (encoding); - scm_dynwind_free (c_encoding); +#ifdef USE_GNU_LOCALE_API + c_result = strtol_l (c_str, &c_endptr, c_base, c_locale); +#else + RUN_IN_LOCALE_SECTION (c_locale, + c_result = strtol (c_str, &c_endptr, c_base)); +#endif } + else + c_result = strtol (c_str, &c_endptr, c_base); + + scm_remember_upto_here (str); + + if (c_endptr == c_str) + result = SCM_BOOL_F; + else + result = scm_from_long (c_result); + + return (scm_values (scm_list_2 (result, scm_from_long (c_endptr - c_str)))); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_locale_string_to_inexact, "locale-string->inexact", + 1, 1, 0, (SCM str, SCM locale), + "Convert string @var{str} into an inexact number according to " + "either @var{locale} (a locale object as returned by " + "@code{make-locale}) or the current process locale. Return " + "two values: an inexact number (on success) or @code{#f}, and " + "the number of characters read from @var{str} (@code{0} on " + "failure).") +#define FUNC_NAME s_scm_locale_string_to_inexact +{ + SCM result; + double c_result; + const char *c_str; + char *c_endptr; + scm_t_locale c_locale; - c_domain = scm_to_locale_string (domainname); - scm_dynwind_free (c_domain); + SCM_VALIDATE_STRING (1, str); + c_str = scm_i_string_chars (str); - c_result = bind_textdomain_codeset (c_domain, c_encoding); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale); - if (c_result != NULL) - result = scm_from_locale_string (c_result); - else if (!SCM_UNBNDP (encoding)) - SCM_SYSERROR; + if (c_locale != NULL) + { +#ifdef USE_GNU_LOCALE_API + c_result = strtod_l (c_str, &c_endptr, c_locale); +#else + RUN_IN_LOCALE_SECTION (c_locale, + c_result = strtod (c_str, &c_endptr)); +#endif + } else + c_result = strtod (c_str, &c_endptr); + + scm_remember_upto_here (str); + + if (c_endptr == c_str) result = SCM_BOOL_F; + else + result = scm_from_double (c_result); - scm_dynwind_end (); - return result; + return (scm_values (scm_list_2 (result, scm_from_long (c_endptr - c_str)))); } #undef FUNC_NAME -void + + +void scm_init_i18n () { - scm_add_feature ("i18n"); + scm_add_feature ("ice-9-i18n"); + +#define _SCM_STRINGIFY_LC(_name) # _name +#define SCM_STRINGIFY_LC(_name) _SCM_STRINGIFY_LC (_name) + + /* Define all the relevant `_MASK' variables. */ +#define SCM_DEFINE_LOCALE_CATEGORY(_name) \ + scm_c_define ("LC_" SCM_STRINGIFY_LC (_name) "_MASK", \ + SCM_I_MAKINUM (LC_ ## _name ## _MASK)); +#include "locale-categories.h" + +#undef SCM_DEFINE_LOCALE_CATEGORY +#undef SCM_STRINGIFY_LC +#undef _SCM_STRINGIFY_LC + + scm_c_define ("LC_ALL_MASK", SCM_I_MAKINUM (LC_ALL_MASK)); + #include "libguile/i18n.x" + +#ifndef USE_GNU_LOCALE_API + scm_set_smob_mark (scm_tc16_locale_smob_type, smob_locale_mark); +#endif } diff --git a/libguile/i18n.h b/libguile/i18n.h index 1f0cb0852..7d5d9baa9 100644 --- a/libguile/i18n.h +++ b/libguile/i18n.h @@ -3,7 +3,7 @@ #ifndef SCM_I18N_H #define SCM_I18N_H -/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2006 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -22,13 +22,24 @@ #include "libguile/__scm.h" -SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category); -SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category); -SCM_API SCM scm_textdomain (SCM domainname); -SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory); -SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding); - -SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all); +SCM_API SCM scm_make_locale (SCM category_mask, SCM locale_name, SCM base_locale); +SCM_API SCM scm_locale_p (SCM obj); +SCM_API SCM scm_string_locale_lt (SCM s1, SCM s2, SCM locale); +SCM_API SCM scm_string_locale_gt (SCM s1, SCM s2, SCM locale); +SCM_API SCM scm_string_locale_ci_lt (SCM s1, SCM s2, SCM locale); +SCM_API SCM scm_string_locale_ci_gt (SCM s1, SCM s2, SCM locale); +SCM_API SCM scm_string_locale_ci_eq (SCM s1, SCM s2, SCM locale); +SCM_API SCM scm_char_locale_lt (SCM c1, SCM c2, SCM locale); +SCM_API SCM scm_char_locale_gt (SCM c1, SCM c2, SCM locale); +SCM_API SCM scm_char_locale_ci_lt (SCM c1, SCM c2, SCM locale); +SCM_API SCM scm_char_locale_ci_gt (SCM c1, SCM c2, SCM locale); +SCM_API SCM scm_char_locale_ci_eq (SCM c1, SCM c2, SCM locale); +SCM_API SCM scm_char_locale_upcase (SCM chr, SCM locale); +SCM_API SCM scm_char_locale_downcase (SCM chr, SCM locale); +SCM_API SCM scm_string_locale_upcase (SCM chr, SCM locale); +SCM_API SCM scm_string_locale_downcase (SCM chr, SCM locale); +SCM_API SCM scm_locale_string_to_integer (SCM str, SCM base, SCM locale); +SCM_API SCM scm_locale_string_to_inexact (SCM str, SCM locale); SCM_API void scm_init_i18n (void); diff --git a/libguile/init.c b/libguile/init.c index e3a0bc41a..219ef620d 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -65,7 +65,7 @@ #include "libguile/hash.h" #include "libguile/hashtab.h" #include "libguile/hooks.h" -#include "libguile/i18n.h" +#include "libguile/gettext.h" #include "libguile/iselect.h" #include "libguile/ioext.h" #include "libguile/keywords.h" @@ -479,7 +479,7 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_init_properties (); scm_init_hooks (); /* Requires smob_prehistory */ scm_init_gc (); /* Requires hooks, async */ - scm_init_i18n (); + scm_init_gettext (); scm_init_ioext (); scm_init_keywords (); scm_init_list (); diff --git a/libguile/posix.c b/libguile/posix.c index 8a83a1e7e..8129c6413 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -40,7 +40,7 @@ #include "libguile/validate.h" #include "libguile/posix.h" -#include "libguile/i18n.h" +#include "libguile/gettext.h" #include "libguile/threads.h" @@ -115,6 +115,10 @@ extern char ** environ; #include <locale.h> #endif +#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L) +# define USE_GNU_LOCALE_API +#endif + #if HAVE_CRYPT_H # include <crypt.h> #endif @@ -1380,7 +1384,15 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0, } #undef FUNC_NAME +#ifndef USE_GNU_LOCALE_API +/* This mutex is used to serialize invocations of `setlocale ()' on non-GNU + systems (i.e., systems where a reentrant locale API is not available). + See `i18n.c' for details. */ +scm_i_pthread_mutex_t scm_i_locale_mutex; +#endif + #ifdef HAVE_SETLOCALE + SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, (SCM category, SCM locale), "If @var{locale} is omitted, return the current value of the\n" @@ -1409,7 +1421,14 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, scm_dynwind_free (clocale); } +#ifndef USE_GNU_LOCALE_API + scm_i_pthread_mutex_lock (&scm_i_locale_mutex); +#endif rv = setlocale (scm_i_to_lc_category (category, 1), clocale); +#ifndef USE_GNU_LOCALE_API + scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); +#endif + if (rv == NULL) { /* POSIX and C99 don't say anything about setlocale setting errno, so @@ -1943,9 +1962,13 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, #endif /* HAVE_GETHOSTNAME */ -void +void scm_init_posix () { +#ifndef USE_GNU_LOCALE_API + scm_i_pthread_mutex_init (&scm_i_locale_mutex, NULL); +#endif + scm_add_feature ("posix"); #ifdef HAVE_GETEUID scm_add_feature ("EIDs"); diff --git a/libguile/posix.h b/libguile/posix.h index 3bef9f96d..871bba850 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -23,8 +23,7 @@ #include "libguile/__scm.h" - - +#include "libguile/threads.h" @@ -87,6 +86,8 @@ SCM_API SCM scm_sethostname (SCM name); SCM_API SCM scm_gethostname (void); SCM_API void scm_init_posix (void); +SCM_API scm_i_pthread_mutex_t scm_i_locale_mutex; + #endif /* SCM_POSIX_H */ /* diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 799f2ee4a..f0384d15a 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr> + + * Makefile.am (SCM_TESTS): Added `tests/i18n.test'. + + * tests/i18n.test: New file. + 2006-11-17 Neil Jerram <neil@ossau.uklinux.net> * README: Note need for subscription to bug-guile@gnu.org. @@ -6,7 +12,7 @@ * tests/environments.test: Comment out all tests in this file. -2006-10-26 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-10-26 Ludovic Courtès <ludovic.courtes@laas.fr> * tests/srfi-14.test (Latin-1)[char-set:punctuation]: Fixed a typo: `thrown' instead of `throw'. @@ -37,7 +43,7 @@ the error+thread tests seem ok now (previously were upset by something leaking out of syntax.test). -2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr> * tests/srfi-14.test: Use `define-module'. Use modules `(srfi srfi-1)' and `(test-suite lib)'. @@ -82,7 +88,7 @@ * tests/time.test (localtime, mktime, strptime): More tests. -2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr> * Makefile.am (SCM_TESTS): Added `tests/structs.test'. * tests/structs.test: New file. @@ -145,7 +151,7 @@ * tests/unif.test (make-shared-array): Add example usages from the manual, two of which currently fail. -2006-03-04 Ludovic Courtès <ludovic.courtes@laas.fr> +2006-03-04 Ludovic Courtès <ludovic.courtes@laas.fr> * test-suite/tests/modules.test: New file. * test-suite/Makefile.am (SCM_TESTS): Added it. @@ -193,7 +199,7 @@ * tests/srfi-1.test (lset-difference!): More tests. -2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr> +2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr> * tests/socket.test (make-socket-address): New tests. (connect, bind, sendto): Exercise sockaddr object. @@ -724,7 +730,7 @@ * lib.scm (exception:numerical-overflow): New define. * tests/numbers.test (modulo-expt): Use it and exception:wrong-type-arg, avoiding empty "" regexp which is invalid on - BSD. Reported by Andreas Vögele. + BSD. Reported by Andreas Vögele. 2004-05-29 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> @@ -749,12 +755,12 @@ * tests/srfi-19.test (test-dst, string->date local DST): Test with "EST5EDT" instead of "CET", since HP-UX doesn't know CET. Reported by - Andreas Vögele. + Andreas Vögele. 2004-05-03 Kevin Ryde <user42@zip.com.au> * tests/time.test (strftime): Force tm:isdst to 0 for the test, for - the benefit of HP-UX. Reported by Andreas Vögele. + the benefit of HP-UX. Reported by Andreas Vögele. Use set-tm:zone rather than a hard coded vector offset. 2004-04-29 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> @@ -1695,7 +1701,7 @@ 2001-06-16 Marius Vollmer <mvo@zagadka.ping.de> - Thanks to Matthias Köppe! + Thanks to Matthias Köppe! * tests/ports.test: New test for output port line counts. * tests/format.test, tests/optargs.test, tests/srfi-19.test: New @@ -2289,3 +2295,7 @@ Fri Dec 17 12:14:10 1999 Greg J. Badros <gjb@cs.washington.edu> * lib.scm, guile-test, paths.scm: Log begins. + +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 2714eeb1e..c7ec21520 100644 --- a/test-suite/Makefile.am +++ b/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 \ |