From a2f00b9b36930797bf9e19c4a00fd089b0be3c9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 31 Jan 2007 20:58:20 +0000 Subject: [PATCH] Changes from arch/CVS synchronization --- ChangeLog | 5 + configure.in | 11 +- doc/ref/ChangeLog | 15 + doc/ref/api-data.texi | 4 +- doc/ref/api-i18n.texi | 441 +++++++++++------ doc/ref/posix.texi | 2 +- doc/ref/srfi-modules.texi | 15 +- ice-9/ChangeLog | 57 ++- ice-9/i18n.scm | 378 ++++++++++++++- libguile/ChangeLog | 35 ++ libguile/i18n.c | 864 ++++++++++++++++++++++++++++------ libguile/i18n.h | 2 + libguile/posix.c | 26 +- srfi/ChangeLog | 29 +- srfi/srfi-19.scm | 95 +--- test-suite/ChangeLog | 15 + test-suite/tests/i18n.test | 141 +++++- test-suite/tests/srfi-19.test | 16 + 18 files changed, 1732 insertions(+), 419 deletions(-) diff --git a/ChangeLog b/ChangeLog index ab33f7db7..47bc98d40 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2007-01-31 Ludovic Courtès + + * configure.in: Look for `langinfo.h', `nl_types.h', `xlocale.h' + and `nl_langinfo'. + 2007-01-28 Neil Jerram * configure.in: Do AM_GNU_GETTEXT_VERSION, so that autoreconf will diff --git a/configure.in b/configure.in index 7ac933132..2d45f5f1c 100644 --- a/configure.in +++ b/configure.in @@ -530,12 +530,13 @@ AC_HEADER_SYS_WAIT # complex.h - new in C99 # fenv.h - available in C99, but not older systems # process.h - mingw specific +# langinfo.h, nl_types.h - SuS v2 # AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h malloc.h memory.h process.h string.h \ regex.h rxposix.h rx/rxposix.h sys/dir.h sys/ioctl.h sys/select.h \ sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \ sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \ -direct.h]) +direct.h langinfo.h nl_types.h]) # "complex double" is new in C99, and "complex" is only a keyword if # is included @@ -624,9 +625,10 @@ 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) +# strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin +# nl_langinfo - X/Open, not available on Windows. # -AC_CHECK_FUNCS([DINFINITY DQNAN chsize clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe 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]) +AC_CHECK_FUNCS([DINFINITY DQNAN chsize clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe 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 nl_langinfo]) # Reasons for testing: # netdb.h - not in mingw @@ -635,8 +637,9 @@ AC_CHECK_FUNCS([DINFINITY DQNAN chsize clog10 ctermid fesetround ftime ftruncate # check this specifically, we need it for the timespec test below. # sethostname - the function itself check because it's not in mingw, # the DECL is checked because Solaris 10 doens't have in any header +# xlocale.h - needed on Darwin for the `locale_t' API # -AC_CHECK_HEADERS(crypt.h netdb.h pthread.h sys/param.h sys/resource.h sys/file.h) +AC_CHECK_HEADERS(crypt.h netdb.h pthread.h sys/param.h sys/resource.h sys/file.h xlocale.h) AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname) AC_CHECK_DECLS([sethostname]) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 880772f17..c09bc96d0 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,18 @@ +2007-01-31 Ludovic Courtès + + * api-data.texi (Conversion): Made cross refs point to `Number + Input and Output' rather than `The ice-9 i18n Module'. + (String Comparison): Likewise for `Text Collation'. + * api-i18n.texi (Internationalization): Re-organized the whole + section, documented new i18n features. Added the following + subsections: `i18n Introduction', `Text Collation', `Character + Case Mapping', `Number Input and Output', `Accessing Locale + Information'. Removed `The ice-9 i18n Module'. + * posix.texi (Locales): Updated cross-ref formerly pointing to + `The ice-9 i18n Module'. + * srfi-modules.texi (SRFI-19 String to date): Mention the + internationalization of `string->date'. + 2007-01-19 Han-Wen Nienhuys * api-options.texi (Evaluator trap options): document diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 0b31b15e3..df913b2cd 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1015,7 +1015,7 @@ zero. 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 +Language Scheme}). @xref{Number Input and Output, the @code{(ice-9 i18n)} module}, for locale-dependent number parsing. @deffn {Scheme Procedure} number->string n [radix] @@ -2949,7 +2949,7 @@ 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. @xref{The ice-9 i18n Module, the @code{(ice-9 +when comparing strings. @xref{Text Collation, the @code{(ice-9 i18n)} module}, for locale-dependent string comparison. @rnindex string=? diff --git a/doc/ref/api-i18n.texi b/doc/ref/api-i18n.texi index 1927a755b..be5afe4f9 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, 2006 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -11,24 +11,29 @@ @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. +Guile provides internationalization@footnote{For concision and style, +programmers often like to refer to internationalization as ``i18n''.} +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. +* i18n Introduction:: Introduction to Guile's i18n support. +* Text Collation:: Sorting strings and characters. +* Character Case Mapping:: Case mapping. +* Number Input and Output:: Parsing and printing numbers. +* Accessing Locale Information:: Detailed locale information. +* Gettext Support:: Translating message strings. @end menu -@node The ice-9 i18n Module -@subsection The @code{(ice-9 i18n)} Module +@node i18n Introduction, Text Collation, Internationalization, Internationalization +@subsection Internationalization with Guile -In order to make use of the following functions, one must import the -@code{(ice-9 i18n)} module in the usual way: +In order to make use of the functions described thereafter, the +@code{(ice-9 i18n)} module must be imported in the usual way: @example (use-modules (ice-9 i18n)) @@ -64,83 +69,41 @@ the user is defined by the @code{LC_MESSAGES} category 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}}). +see later, many of these procedures 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) +@deffn {Scheme Procedure} make-locale category-list locale-name [base-locale] +@deffnx {C Function} scm_make_locale (category_list, 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. +locale (e.g., @code{"aa_DJ"}) and @var{category-list} should be either +a list of locale categories or a single category as used with +@code{setlocale} (@pxref{Locales, @code{setlocale}}). Optionally, if +@code{base-locale} is passed, it should be a locale object denoting +settings for categories not listed in @var{category-list}. -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): +The following invocation creates a locale object that combines the use +of Swedish 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") +(make-locale (list LC_MESSAGE LC_CTYPE) "sv_SE") @end example -The following example combines the use of Swedish conventions with -monetary conventions from Croatia: +The following example combines the use of Esperanto messages and +conventions with monetary conventions from Croatia: @example -(make-locale LC_MONETARY_MASK "hr_HR" - (make-locale LC_ALL_MASK "sv_SE")) +(make-locale LC_MONETARY "hr_HR" + (make-locale LC_ALL "eo_EO")) @end example A @code{system-error} exception (@pxref{Handling Errors}) is raised by @@ -155,70 +118,56 @@ error may be raised later, when the locale object is actually used. Return true if @var{obj} is a locale object. @end deffn -The following procedures provide support for text collation. +@defvr {Scheme Variable} %global-locale +@defvrx {C Variable} scm_global_locale +This variable is bound to a locale object denoting the current process +locale as installed using @code{setlocale ()} (@pxref{Locales}). It +may be used like any other locale object, including as a third +argument to @code{make-locale}, for instance. +@end defvr + + +@node Text Collation, Character Case Mapping, i18n Introduction, Internationalization +@subsection Text Collation + +The following procedures provide support for text collation, i.e., +locale-dependent string and character sorting. @deffn {Scheme Procedure} string-locale? s1 s2 [locale] +@deffnx {Scheme Procedure} string-locale>? s1 s2 [locale] @deffnx {C Function} scm_string_locale_gt (s1, s2, locale) +@deffnx {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 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. +otherwise, the current system locale is used. For the @code{-ci} +variants, the comparison is made in a case-insensitive way. @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 +a 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 {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 {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. +Compare characters @var{c1} and @var{c2} according to either +@var{locale} (a locale object as returned by @code{make-locale}) or +the current locale. For the @code{-ci} variants, the comparison is +made in a case-insensitive way. @end deffn @deffn {Scheme Procedure} char-locale-ci=? c1 c2 [locale] @@ -227,6 +176,9 @@ 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 +@node Character Case Mapping, Number Input and Output, Text Collation, Internationalization +@subsection Character Case Mapping + 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 @@ -236,8 +188,8 @@ 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. +above''. The following procedures allow programmers to provide +idiomatic character mapping. @deffn {Scheme Procedure} char-locale-downcase chr [locale] @deffnx {C Function} scm_char_locale_upcase (chr, locale) @@ -263,12 +215,20 @@ 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 +Note that in the current implementation Guile has no notion of +multibyte characters and in a multibyte locale characters may not be +converted correctly. + +@node Number Input and Output, Accessing Locale Information, Character Case Mapping, Internationalization +@subsection Number Input and Output + +The following procedures allow programs to read and write 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. +in French it is written @code{10 000,5}. These procedures allow such +differences to be taken into account. +@findex strtod @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 @@ -276,22 +236,239 @@ Convert string @var{str} into an integer according to either 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). +decimal numbers are read. Return two values (@pxref{Multiple +Values}): an integer (on success) or @code{#f}, and the number of +characters read from @var{str} (@code{0} on failure). + +This function is based on the C library's @code{strtol} function +(@pxref{Parsing of Integers, @code{strtol},, libc, The GNU C Library +Reference Manual}). @end deffn +@findex strtod @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). +the current process locale. Return two values (@pxref{Multiple +Values}): an inexact number (on success) or @code{#f}, and the number +of characters read from @var{str} (@code{0} on failure). + +This function is based on the C library's @code{strtod} function +(@pxref{Parsing of Floats, @code{strtod},, libc, The GNU C Library +Reference Manual}). +@end deffn + +@deffn {Scheme Procedure} number->locale-string number [fraction-digits [locale]] +Convert @var{number} (an inexact) into a string according to the +cultural conventions of either @var{locale} (a locale object) or the +current locale. Optionally, @var{fraction-digits} may be bound to an +integer specifying the number of fractional digits to be displayed. +@end deffn + +@deffn {Scheme Procedure} monetary-amount->locale-string amount intl? [locale] +Convert @var{amount} (an inexact denoting a monetary amount) into a +string according to the cultural conventions of either @var{locale} (a +locale object) or the current locale. If @var{intl?} is true, then +the international monetary format for the given locale is used +(@pxref{Currency Symbol, international and locale monetary formats,, +libc, The GNU C Library Reference Manual}). @end deffn -@node Gettext Support +@node Accessing Locale Information, Gettext Support, Number Input and Output, Internationalization +@subsection Accessing Locale Information + +@findex nl_langinfo +@cindex low-level locale information +It is sometimes useful to obtain very specific information about a +locale such as the word it uses for days or months, its format for +representing floating-point figures, etc. The @code{(ice-9 i18n)} +module provides support for this in a way that is similar to the libc +functions @code{nl_langinfo ()} and @code{localeconv ()} +(@pxref{Locale Information, accessing locale information from C,, +libc, The GNU C Library Reference Manual}). The available functions +are listed below. + +@deffn {Scheme Procedure} locale-encoding [locale] +Return the name of the encoding (a string whose interpretation is +system-dependent) of either @var{locale} or the current locale. +@end deffn + +The following functions deal with dates and times. + +@deffn {Scheme Procedure} locale-day day [locale] +@deffnx {Scheme Procedure} locale-day-short day [locale] +@deffnx {Scheme Procedure} locale-month month [locale] +@deffnx {Scheme Procedure} locale-month-short month [locale] +Return the word (a string) used in either @var{locale} or the current +locale to name the day (or month) denoted by @var{day} (or +@var{month}), an integer between 1 and 7 (or 1 and 12). The +@code{-short} variants provide an abbreviation instead of a full name. +@end deffn + +@deffn {Scheme Procedure} locale-am-string [locale] +@deffnx {Scheme Procedure} locale-pm-string [locale] +Return a (potentially empty) string that is used to denote @i{ante +meridiem} (or @i{post meridiem}) hours in 12-hour format. +@end deffn + +@deffn {Scheme Procedure} locale-date+time-format [locale] +@deffnx {Scheme Procedure} locale-date-format [locale] +@deffnx {Scheme Procedure} locale-time-format [locale] +@deffnx {Scheme Procedure} locale-time+am/pm-format [locale] +@deffnx {Scheme Procedure} locale-era-date-format [locale] +@deffnx {Scheme Procedure} locale-era-date+time-format [locale] +@deffnx {Scheme Procedure} locale-era-time-format [locale] +These procedures return format strings suitable to @code{strftime} +(@pxref{Time}) that may be used to display (part of) a date/time +according to certain constraints and to the conventions of either +@var{locale} or the current locale (@pxref{The Elegant and Fast Way, +the @code{nl_langinfo ()} items,, libc, The GNU C Library Reference +Manual}). +@end deffn + +@deffn {Scheme Procedure} locale-era [locale] +@deffnx {Scheme Procedure} locale-era-year [locale] +These functions return, respectively, the era and the year of the +relevant era used in @var{locale} or the current locale. Most locales +do not define this value. In this case, the empty string is returned. +An example of a locale that does define this value is the Japanese +one. +@end deffn + +The following procedures give information about number representation. + +@deffn {Scheme Procedure} locale-decimal-point [locale] +@deffnx {Scheme Procedure} locale-thousands-separator [locale] +These functions return a string denoting the representation of the +decimal point or that of the thousand separator (respectively) for +either @var{locale} or the current locale. +@end deffn + +@deffn {Scheme Procedure} locale-digit-grouping [locale] +Return a (potentially circular) list of integers denoting how digits +of the integer part of a number are to be grouped, starting at the +decimal point and going to the left. The list contains integers +indicating the size of the successive groups, from right to left. If +the list is non-circular, then no grouping occurs for digits beyond +the last group. + +For instance, if the returned list is a circular list that contains +only @code{3} and the thousand separator is @code{","} (as is the case +with English locales), then the number @code{12345678} should be +printed @code{12,345,678}. +@end deffn + +The following procedures deal with the representation of monetary +amounts. Some of them take an additional @var{intl?} argument (a +boolean) that tells whether the international or local monetary +conventions for the given locale are to be used. + +@deffn {Scheme Procedure} locale-monetary-decimal-point [locale] +@deffnx {Scheme Procedure} locale-monetary-thousands-separator [locale] +@deffnx {Scheme Procedure} locale-monetary-grouping [locale] +These are the monetary counterparts of the above procedures. These +procedures apply to monetary amounts. +@end deffn + +@deffn {Scheme Procedure} locale-currency-symbol intl? [locale] +Return the currency symbol (a string) of either @var{locale} or the +current locale. + +The following example illustrates the difference between the local and +international monetary formats: + +@example +(define us (make-locale LC_MONETARY "en_US")) +(locale-currency-symbol #f us) +@result{} "-$" +(locale-currency-symbol #t us) +@result{} "USD " +@end example +@end deffn + +@deffn {Scheme Procedure} locale-monetary-fractional-digits intl? [locale] +Return the number of fractional digits to be used when printing +monetary amounts according to either @var{locale} or the current +locale. If the locale does not specify it, then @code{#f} is +returned. +@end deffn + +@deffn {Scheme Procedure} locale-currency-symbol-precedes-positive? intl? [locale] +@deffnx {Scheme Procedure} locale-currency-symbol-precedes-negative? intl? [locale] +@deffnx {Scheme Procedure} locale-positive-separated-by-space? intl? [locale] +@deffnx {Scheme Procedure} locale-negative-separated-by-space? intl? [locale] +These procedures return a boolean indicating whether the currency +symbol should precede a positive/negative number, and whether a +whitespace should be inserted between the currency symbol and a +positive/negative amount. +@end deffn + +@deffn {Scheme Procedure} locale-monetary-positive-sign [locale] +@deffnx {Scheme Procedure} locale-monetary-negative-sign [locale] +Return a string denoting the positive (respectively negative) sign +that should be used when printing a monetary amount. +@end deffn + +@deffn {Scheme Procedure} locale-positive-sign-position +@deffnx {Scheme Procedure} locale-negative-sign-position +These functions return a symbol telling where a sign of a +positive/negative monetary amount is to appear when printing it. The +possible values are: + +@table @code +@item parenthesize +The currency symbol and quantity should be surrounded by parentheses. +@item sign-before +Print the sign string before the quantity and currency symbol. +@item sign-after +Print the sign string after the quantity and currency symbol. +@item sign-before-currency-symbol +Print the sign string right before the currency symbol. +@item sign-after-currency-symbol +Print the sign string right after the currency symbol. +@item unspecified +Unspecified. We recommend you print the sign after the currency +symbol. +@end table + +@end deffn + +Finally, the two following procedures may be helpful when programming +user interfaces: + +@deffn {Scheme Procedure} locale-yes-regexp [locale] +@deffnx {Scheme Procedure} locale-no-regexp [locale] +Return a string that can be used as a regular expression to recognize +a positive (respectively, negative) response to a yes/no question. +For the C locale, the default values are typically @code{"^[yY]"} and +@code{"^[nN]"}, respectively. + +Here is an example: + +@example +(format #t "Does Guile rock?~%") +(let ((answer (read-line))) + (cond ((string-match (locale-yes-regexp) answer) + "Yes it does.") + ((string-match (locale-no-regexp) answer) + "No it doesn't.") + (else + "What do you mean?"))) +@end example + +For an internationalized yes/no string output, @code{gettext} should +be used (@pxref{Gettext Support}). +@end deffn + +Example uses of some of these functions are the implementation of the +@code{number->locale-string} and @code{monetary-amount->locale-string} +procedures (@pxref{Number Input and Output}), as well as that the +SRFI-19 date and time convertion to/from strings (@pxref{SRFI-19}). + + +@node Gettext Support, , Accessing Locale Information, Internationalization @subsection Gettext Support Guile provides an interface to GNU @code{gettext} for translating diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 31ca20b0d..faf57d6b1 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -3219,7 +3219,7 @@ 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 +process. @xref{i18n Introduction, locale objects and @code{make-locale}}, for a thread-safe alternative. @end deffn diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 61c105c5b..df356cc58 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -2132,10 +2132,10 @@ Conversions @samp{~D}, @samp{~x} and @samp{~X} are not currently described here, since the specification and reference implementation differ. -Currently Guile doesn't implement any localizations for the above, all -outputs are in English, and the @samp{~c} conversion is POSIX -@code{ctime} style @samp{~a ~b ~d ~H:~M:~S~z ~Y}. This may change in -the future. +Conversion is locale-dependent on systems that support it +(@pxref{Accessing Locale Information}). @xref{Locales, +@code{setlocale}}, for information on how to change the current +locale. @node SRFI-19 String to date @@ -2256,9 +2256,10 @@ Notice that the weekday matching forms don't affect the date object returned, instead the weekday will be derived from the day, month and year. -Currently Guile doesn't implement any localizations for the above, -month and weekday names are always expected in English. This may -change in the future. +Conversion is locale-dependent on systems that support it +(@pxref{Accessing Locale Information}). @xref{Locales, +@code{setlocale}}, for information on how to change the current +locale. @end defun diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 574c96b7d..9d03408db 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,31 @@ +2007-01-31 Ludovic Courtès + + * i18n.scm: Use `(ice-9 optargs)'. Don't export `LC_*_MASK' + variables. Added new exports. + (locale-encoding, locale-day-short, locale-day, + locale-month-short, locale-month, locale-am-string, + locale-pm-string, locale-date+time-format, locale-date-format, + locale-time-format, locale-time+am/pm-format, locale-era, + locale-era-year, locale-era-date+time-format, + locale-era-date-format, locale-era-time-format, + locale-currency-symbol, locale-monetary-fractional-digits, + locale-monetary-positive-sign, locale-monetary-negative-sign, + locale-monetary-decimal-point, + locale-monetary-thousands-separator, + locale-monetary-digit-grouping, + locale-currency-symbol-precedes-positive?, + locale-currency-symbol-precedes-negative?, + locale-positive-separated-by-space?, + locale-negative-separated-by-space?, + locale-positive-sign-position, locale-negative-sign-position, + %number-integer-part, add-monetary-sign+currency, + monetary-amount->locale-string, locale-digit-grouping, + locale-decimal-point, locale-thousands-separator, + number->locale-string, locale-yes-regexp, locale-no-regexp): New + procedures. + (define-vector-langinfo-mapping, define-simple-langinfo-mapping, + define-monetary-langinfo-mapping): New macros. + 2007-01-04 Kevin Ryde * boot-9.scm (top-repl): Check (defined? 'SIGBUS) before using that @@ -124,7 +152,7 @@ where `futures' should become `threads' from Marius' change of 2006-01-29. -2006-03-04 Ludovic Courtès +2006-03-04 Ludovic Courtès * ice-9/boot-9.scm (make-autoload-interface): Don't call `set-car!' if the autoload interface has already been removed from MODULE's uses. @@ -146,7 +174,7 @@ * boot-9.scm (try-module-autoload): Make sure that module code is loaded with the default reader (current-reader #f). Thanks to - Ludovic Courtès for pointing this problem out. + Ludovic Courtès for pointing this problem out. * stack-catch.scm (stack-catch): Use catch pre-unwind handler instead of lazy-catch. @@ -154,7 +182,7 @@ * boot-9.scm (error-catching-loop): Use catch pre-unwind handler instead of lazy-catch. -2006-02-01 Ludovic Courtès +2006-02-01 Ludovic Courtès * deprecated.scm (make-uniform-array): Fill the returned vector with PROT, per guile 1.6 behaviour. @@ -170,7 +198,7 @@ 2006-01-13 Neil Jerram * boot-9.scm (repl-reader): Use value of current-reader fluid to - do the read, if set. (Thanks to Ludovic Courtès for the patch.) + do the read, if set. (Thanks to Ludovic Courtès for the patch.) 2005-12-14 Neil Jerram @@ -186,7 +214,7 @@ * boot-9.scm (%cond-expand-features): Add srfi-61. -2005-10-27 Ludovic Courtès +2005-10-27 Ludovic Courtès * networking.scm (sockaddr:flowinfo, sockaddr:scopeid): New functions. @@ -1215,7 +1243,7 @@ 2002-01-12 Marius Vollmer - More options for pretty-print. Thanks to Matthias Köppe! + More options for pretty-print. Thanks to Matthias Köppe! * pretty-print.scm (generic-write): New per-line-prefix argument. (pretty-print): Check whether the new keyword argument style is @@ -1292,7 +1320,7 @@ * session.scm (arity): Use new `arglist' procedure property to present a more detailed argument list. - Thanks to Matthias Köppe! + Thanks to Matthias Köppe! 2001-09-07 Thien-Thi Nguyen @@ -1511,12 +1539,12 @@ * optargs.scm (lambda*): Make sure that BODY is always put into a real body context so that it can contain internal definitions. - Thanks to Matthias Köppe! + Thanks to Matthias Köppe! * format.scm: Use (ice-9 and-let-star). (format:out): Initialize format:output-col with current column of `port', if it has one. Else leave it alone. Thanks to Matthias - Köppe! + Köppe! 2001-06-05 Marius Vollmer @@ -1621,7 +1649,7 @@ * boot-9.scm (define-module): Return the new module. (process-define-module): Use `spec' instead of `module-name' when - getting the syntax transformer. Thanks to Matthias Köppe! + getting the syntax transformer. Thanks to Matthias Köppe! 2001-05-21 Marius Vollmer @@ -1731,7 +1759,7 @@ * boot-9.scm (error-catching-repl): Call the E ("eval'er") procedure via call-with-values and call the P - ("printer") for each produced value. Thanks to Matthias Köppe! + ("printer") for each produced value. Thanks to Matthias Köppe! 2001-05-14 Martin Grabmueller @@ -2252,7 +2280,7 @@ 2000-08-14 Mikael Djurfeldt * format.scm (format:obj->str): Made tail-recursive. (Thanks to - Matthias Köppe.) + Matthias Köppe.) 2000-08-13 Mikael Djurfeldt @@ -2351,7 +2379,7 @@ 2000-06-20 Mikael Djurfeldt * session.scm (make-fold-modules): Detect circular references in - module graph. (Thanks to Matthias Köppe.) + module graph. (Thanks to Matthias Köppe.) 2000-06-20 Mikael Djurfeldt @@ -4813,3 +4841,6 @@ Fri Apr 19 13:53:08 1996 Tom Lord * The more things change... +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/ice-9/i18n.scm b/ice-9/i18n.scm index e782ee21a..e7c116e53 100644 --- a/ice-9/i18n.scm +++ b/ice-9/i18n.scm @@ -1,6 +1,6 @@ ;;;; i18n.scm --- internationalization support -;;;; Copyright (C) 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2006, 2007 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 @@ -29,18 +29,10 @@ ;;; Code: (define-module (ice-9 i18n) + :use-module (ice-9 optargs) :export (;; `locale' type make-locale locale? - - ;; locale category masks (standard) - LC_ALL_MASK - LC_COLLATE_MASK LC_CTYPE_MASK LC_MESSAGES_MASK - LC_MONETARY_MASK LC_NUMERIC_MASK LC_TIME_MASK - - ;; locale category masks (non-standard) - LC_PAPER_MASK LC_NAME_MASK LC_ADDRESS_MASK - LC_TELEPHONE_MASK LC_MEASUREMENT_MASK - LC_IDENTIFICATION_MASK + %global-locale ;; text collation string-locale? @@ -54,11 +46,373 @@ string-locale-downcase string-locale-upcase ;; reading numbers - locale-string->integer locale-string->inexact)) + locale-string->integer locale-string->inexact + + ;; charset/encoding + locale-encoding + + ;; days and months + locale-day-short locale-day locale-month-short locale-month + + ;; date and time + locale-am-string locale-pm-string + locale-date+time-format locale-date-format locale-time-format + locale-time+am/pm-format + locale-era locale-era-year + locale-era-date-format locale-era-date+time-format + locale-era-time-format + + ;; monetary + locale-currency-symbol + locale-monetary-decimal-point locale-monetary-thousands-separator + locale-monetary-grouping locale-monetary-fractional-digits + locale-currency-symbol-precedes-positive? + locale-currency-symbol-precedes-negative? + locale-positive-separated-by-space? + locale-negative-separated-by-space? + locale-monetary-positive-sign locale-monetary-negative-sign + locale-positive-sign-position locale-negative-sign-position + monetary-amount->locale-string + + ;; number formatting + locale-digit-grouping locale-decimal-point + locale-thousands-separator + number->locale-string + + ;; miscellaneous + locale-yes-regexp locale-no-regexp)) (load-extension "libguile-i18n-v-0" "scm_init_i18n") + +;;; +;;; Charset/encoding. +;;; + +(define (locale-encoding . locale) + (apply nl-langinfo CODESET locale)) + + +;;; +;;; Months and days. +;;; + +;; Helper macro: Define a procedure named NAME that maps its argument to +;; NL-ITEMS (when `nl-langinfo' is provided) or DEFAULTS (when `nl-langinfo' +;; is not provided). +(define-macro (define-vector-langinfo-mapping name nl-items defaults) + (let* ((item-count (length nl-items)) + (defines (if (provided? 'nl-langinfo) + `(define %nl-items (vector #f ,@nl-items)) + `(define %defaults (vector #f ,@defaults)))) + (make-body (lambda (result) + `(if (and (integer? item) (exact? item)) + (if (and (>= item 1) (<= item ,item-count)) + ,result + (throw 'out-of-range "out of range" item)) + (throw 'wrong-type-arg "wrong argument type" item))))) + `(define (,name item . locale) + ,defines + ,(make-body (if (provided? 'nl-langinfo) + '(apply nl-langinfo (vector-ref %nl-items item) locale) + '(vector-ref %defaults item)))))) + + +(define-vector-langinfo-mapping locale-day-short + (ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7) + ("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat")) + +(define-vector-langinfo-mapping locale-day + (DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7) + ("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")) + +(define-vector-langinfo-mapping locale-month-short + (ABMON_1 ABMON_2 ABMON_3 ABMON_4 ABMON_5 ABMON_6 + ABMON_7 ABMON_8 ABMON_9 ABMON_10 ABMON_11 ABMON_12) + ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) + +(define-vector-langinfo-mapping locale-month + (MON_1 MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 MON_10 MON_11 MON_12) + ("January" "February" "March" "April" "May" "June" "July" "August" + "September" "October" "November" "December")) + + + +;;; +;;; Date and time. +;;; + +;; Helper macro: Define a procedure NAME that gets langinfo item ITEM. +(define-macro (define-simple-langinfo-mapping name item default) + (let ((body (if (and (provided? 'nl-langinfo) (defined? item)) + `(apply nl-langinfo ,item locale) + default))) + `(define (,name . locale) + ,body))) + +(define-simple-langinfo-mapping locale-am-string + AM_STR "AM") +(define-simple-langinfo-mapping locale-pm-string + PM_STR "PM") +(define-simple-langinfo-mapping locale-date+time-format + D_T_FMT "%a %b %e %H:%M:%S %Y") +(define-simple-langinfo-mapping locale-date-format + D_FMT "%m/%d/%y") +(define-simple-langinfo-mapping locale-time-format + T_FMT "%H:%M:%S") +(define-simple-langinfo-mapping locale-time+am/pm-format + T_FMT_AMPM "%I:%M:%S %p") +(define-simple-langinfo-mapping locale-era + ERA "") +(define-simple-langinfo-mapping locale-era-year + ERA_YEAR "") +(define-simple-langinfo-mapping locale-era-date+time-format + ERA_D_T_FMT "") +(define-simple-langinfo-mapping locale-era-date-format + ERA_D_FMT "") +(define-simple-langinfo-mapping locale-era-time-format + ERA_T_FMT "") + + + +;;; +;;; Monetary information. +;;; + +(define-macro (define-monetary-langinfo-mapping name local-item intl-item + default/local default/intl) + (let ((body + (let ((intl (if (and (provided? 'nl-langinfo) (defined? intl-item)) + `(apply nl-langinfo ,intl-item locale) + default/intl)) + (local (if (and (provided? 'nl-langinfo) (defined? local-item)) + `(apply nl-langinfo ,local-item locale) + default/local))) + `(if intl? ,intl ,local)))) + + `(define (,name intl? . locale) + ,body))) + +;; FIXME: How can we use ALT_DIGITS? +(define-monetary-langinfo-mapping locale-currency-symbol + CRNCYSTR INT_CURR_SYMBOL + "-" "") +(define-monetary-langinfo-mapping locale-monetary-fractional-digits + FRAC_DIGITS INT_FRAC_DIGITS + 2 2) + +(define-simple-langinfo-mapping locale-monetary-positive-sign + POSITIVE_SIGN "+") +(define-simple-langinfo-mapping locale-monetary-negative-sign + NEGATIVE_SIGN "-") +(define-simple-langinfo-mapping locale-monetary-decimal-point + MON_DECIMAL_POINT "") +(define-simple-langinfo-mapping locale-monetary-thousands-separator + MON_THOUSANDS_SEP "") +(define-simple-langinfo-mapping locale-monetary-digit-grouping + MON_GROUPING '()) + +(define-monetary-langinfo-mapping locale-currency-symbol-precedes-positive? + P_CS_PRECEDES INT_P_CS_PRECEDES + #t #t) +(define-monetary-langinfo-mapping locale-currency-symbol-precedes-negative? + N_CS_PRECEDES INT_N_CS_PRECEDES + #t #t) + + +(define-monetary-langinfo-mapping locale-positive-separated-by-space? + ;; Whether a space should be inserted between a positive amount and the + ;; currency symbol. + P_SEP_BY_SPACE INT_P_SEP_BY_SPACE + #t #t) +(define-monetary-langinfo-mapping locale-negative-separated-by-space? + ;; Whether a space should be inserted between a negative amount and the + ;; currency symbol. + N_SEP_BY_SPACE INT_N_SEP_BY_SPACE + #t #t) + +(define-monetary-langinfo-mapping locale-positive-sign-position + ;; Position of the positive sign wrt. currency symbol and quantity in a + ;; monetary amount. + P_SIGN_POSN INT_P_SIGN_POSN + 'unspecified 'unspecified) +(define-monetary-langinfo-mapping locale-negative-sign-position + ;; Position of the negative sign wrt. currency symbol and quantity in a + ;; monetary amount. + N_SIGN_POSN INT_N_SIGN_POSN + 'unspecified 'unspecified) + + +(define (%number-integer-part int grouping separator) + ;; Process INT (a string denoting a number's integer part) and return a new + ;; string with digit grouping and separators according to GROUPING (a list, + ;; potentially circular) and SEPARATOR (a string). + + ;; Process INT from right to left. + (let loop ((int int) + (grouping grouping) + (result '())) + (cond ((string=? int "") (apply string-append result)) + ((null? grouping) (apply string-append int result)) + (else + (let* ((len (string-length int)) + (cut (min (car grouping) len))) + (loop (substring int 0 (- len cut)) + (cdr grouping) + (let ((sub (substring int (- len cut) len))) + (if (> len cut) + (cons* separator sub result) + (cons sub result))))))))) + +(define (add-monetary-sign+currency amount figure intl? locale) + ;; Add a sign and currency symbol around FIGURE. FIGURE should be a + ;; formatted unsigned amount (a string) representing AMOUNT. + (let* ((positive? (> amount 0)) + (sign + (cond ((> amount 0) (locale-monetary-positive-sign locale)) + ((< amount 0) (locale-monetary-negative-sign locale)) + (else ""))) + (currency (locale-currency-symbol intl? locale)) + (currency-precedes? + (if positive? + locale-currency-symbol-precedes-positive? + locale-currency-symbol-precedes-negative?)) + (separated? + (if positive? + locale-positive-separated-by-space? + locale-negative-separated-by-space?)) + (sign-position + (if positive? + locale-positive-sign-position + locale-negative-sign-position)) + (currency-space + (if (separated? intl? locale) " " "")) + (append-currency + (lambda (amt) + (if (currency-precedes? intl? locale) + (string-append currency currency-space amt) + (string-append amt currency-space currency))))) + + (case (sign-position intl? locale) + ((parenthesize) + (string-append "(" (append-currency figure) ")")) + ((sign-before) + (string-append sign (append-currency figure))) + ((sign-after unspecified) + ;; following glibc's recommendation for `unspecified'. + (if (currency-precedes? intl? locale) + (string-append currency currency-space sign figure) + (string-append figure currency-space currency sign))) + ((sign-before-currency-symbol) + (if (currency-precedes? intl? locale) + (string-append sign currency currency-space figure) + (string-append figure currency-space sign currency))) ;; unlikely + ((sign-after-currency-symbol) + (if (currency-precedes? intl? locale) + (string-append currency sign currency-space figure) + (string-append figure currency-space currency sign))) + (else + (error "unsupported sign position" (sign-position intl? locale)))))) + + +(define* (monetary-amount->locale-string amount intl? + #:optional (locale %global-locale)) + "Convert @var{amount} (an inexact) into a string according to the cultural +conventions of either @var{locale} (a locale object) or the current locale. +If @var{intl?} is true, then the international monetary format for the given +locale is used." + + (let* ((fraction-digits + (or (locale-monetary-fractional-digits intl? locale) 2)) + (decimal-part + (lambda (dec) + (if (or (string=? dec "") (eq? 0 fraction-digits)) + "" + (string-append (locale-monetary-decimal-point locale) + (if (< fraction-digits (string-length dec)) + (substring dec 0 fraction-digits) + dec))))) + + (external-repr (number->string (if (> amount 0) amount (- amount)))) + (int+dec (string-split external-repr #\.)) + (int (car int+dec)) + (dec (decimal-part (if (null? (cdr int+dec)) + "" + (cadr int+dec)))) + (grouping (locale-monetary-digit-grouping locale)) + (separator (locale-monetary-thousands-separator locale))) + + (add-monetary-sign+currency amount + (string-append + (%number-integer-part int grouping + separator) + dec) + intl? locale))) + + + +;;; +;;; Number formatting. +;;; + +(define-simple-langinfo-mapping locale-digit-grouping + GROUPING '()) +(define-simple-langinfo-mapping locale-decimal-point + RADIXCHAR ".") +(define-simple-langinfo-mapping locale-thousands-separator + THOUSEP "") + +(define* (number->locale-string number + #:optional (fraction-digits #t) + (locale %global-locale)) + "Convert @var{number} (an inexact) into a string according to the cultural +conventions of either @var{locale} (a locale object) or the current locale. +Optionally, @var{fraction-digits} may be bound to an integer specifying the +number of fractional digits to be displayed." + + (let* ((sign + (cond ((> number 0) "") + ((< number 0) "-") + (else ""))) + (decimal-part + (lambda (dec) + (if (or (string=? dec "") (eq? 0 fraction-digits)) + "" + (string-append (locale-decimal-point locale) + (if (and (integer? fraction-digits) + (< fraction-digits + (string-length dec))) + (substring dec 0 fraction-digits) + dec)))))) + + (let* ((external-repr (number->string (if (> number 0) + number + (- number)))) + (int+dec (string-split external-repr #\.)) + (int (car int+dec)) + (dec (decimal-part (if (null? (cdr int+dec)) + "" + (cadr int+dec)))) + (grouping (locale-digit-grouping locale)) + (separator (locale-thousands-separator locale))) + + (string-append sign + (%number-integer-part int grouping separator) + dec)))) + + +;;; +;;; Miscellaneous. +;;; + +(define-simple-langinfo-mapping locale-yes-regexp + YESEXPR "^[yY]") +(define-simple-langinfo-mapping locale-no-regexp + NOEXPR "^[nN]") + +;; `YESSTR' and `NOSTR' are considered deprecated so we don't provide them. + ;;; Local Variables: ;;; coding: latin-1 diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2b764f9cb..29124f9b6 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,38 @@ +2007-01-31 Ludovic Courtès + + * i18n.c: Include "libguile/threads.h" and "libguile/posix.h" + unconditionally. Include and when + available. + (SCM_I18N_STRINGIFY, SCM_LOCALE_CATEGORY_MASK, + SCM_LIST_OR_INTEGER_P): New macros. + (LC_*_MASK): When `USE_GNU_LOCALE_API' is undefined, define them + as powers of two instead of `(1 << LC_*)'. + (scm_i_locale_free): New function/macro. + (scm_global_locale): New global variable. + (smob_locale_free): Use `scm_i_locale_free ()'. + (smob_locale_mark): Check whether the SMOB is `%global-locale'. + (get_current_locale_settings): Return `EINVAL' instead of `errno' + when `setlocale' fails. + (restore_locale_settings): Likewise. + (install_locale_categories): Likewise. + (install_locale): Likewise. Stop the locale stack traversal when + all categories have been handled. + (get_current_locale, category_to_category_mask, + category_list_to_category_mask): New function. + (scm_make_locale): Use them. Accept both lists of `LC_*' values + and single `LC_*' values as the first argument. Handle the case + where BASE_LOCALE is `%global-locale'. When `USE_GNU_LOCALE_API', + duplicate C_BASE_LOCALE before using it. + (scm_nl_langinfo, define_langinfo_items): New functions. + (scm_init_i18n): When `HAVE_NL_LANGINFO', add feature + `nl-langinfo' and invoke `define_langinfo_items ()'. + * i18n.h (scm_global_locale, scm_nl_langinfo): New declarations. + * posix.c: Include when available. + (scm_i_locale_mutex): Always define it. Statically initialized. + (scm_set_locale): Invoke `scm_i_to_lc_category ()' before + acquiring the locale mutex. + (scm_init_posix): No longer initialize SCM_I_LOCALE_MUTEX here. + 2007-01-25 Han-Wen Nienhuys * vector.c: remove comment as per kryde's request. diff --git a/libguile/i18n.c b/libguile/i18n.c index 76dd9a514..e23f79072 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2006 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2007 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 @@ -46,6 +46,7 @@ void *alloca (size_t); #include "libguile/dynwind.h" #include "libguile/validate.h" #include "libguile/values.h" +#include "libguile/threads.h" #include #include /* `strcoll ()' */ @@ -53,11 +54,29 @@ void *alloca (size_t); #include #if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L) +/* The GNU thread-aware locale API is documented in ``Thread-Aware Locale + Model, a Proposal'', by Ulrich Drepper: + + http://people.redhat.com/drepper/tllocale.ps.gz + + It is now also implemented by Darwin: + + http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/newlocale.3.html + + The whole API is being standardized by the X/Open Group (as of Jan. 2007) + following Drepper's proposal. */ # define USE_GNU_LOCALE_API #endif -#ifndef USE_GNU_LOCALE_API -# include "libguile/posix.h" /* for `scm_i_locale_mutex' */ +#if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H) +# include +#endif + +#include "libguile/posix.h" /* for `scm_i_locale_mutex' */ + +#if (defined HAVE_LANGINFO_H) && (defined HAVE_NL_TYPES_H) +# include +# include #endif #ifndef HAVE_SETLOCALE @@ -69,6 +88,9 @@ setlocale (int category, const char *name) } #endif +/* Helper stringification macro. */ +#define SCM_I18N_STRINGIFY(_name) # _name + /* Locale objects, string and character collation, and other locale-dependent @@ -78,18 +100,16 @@ setlocale (int category, const char *name) 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'. */ +/* Provide the locale category masks as found in glibc. 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) +# define LC_CTYPE_MASK 1 +# define LC_COLLATE_MASK 2 +# define LC_MESSAGES_MASK 4 +# define LC_MONETARY_MASK 8 +# define LC_NUMERIC_MASK 16 +# define LC_TIME_MASK 32 # ifdef LC_PAPER -# define LC_PAPER_MASK (1 << LC_PAPER) +# define LC_PAPER_MASK 64 # else # define LC_PAPER_MASK 0 # endif # ifdef LC_NAME -# define LC_NAME_MASK (1 << LC_NAME) +# define LC_NAME_MASK 128 # else # define LC_NAME_MASK 0 # endif # ifdef LC_ADDRESS -# define LC_ADDRESS_MASK (1 << LC_ADDRESS) +# define LC_ADDRESS_MASK 256 # else # define LC_ADDRESS_MASK 0 # endif # ifdef LC_TELEPHONE -# define LC_TELEPHONE_MASK (1 << LC_TELEPHONE) +# define LC_TELEPHONE_MASK 512 # else # define LC_TELEPHONE_MASK 0 # endif # ifdef LC_MEASUREMENT -# define LC_MEASUREMENT_MASK (1 << LC_MEASUREMENT) +# define LC_MEASUREMENT_MASK 1024 # else # define LC_MEASUREMENT_MASK 0 # endif # ifdef LC_IDENTIFICATION -# define LC_IDENTIFICATION_MASK (1 << LC_IDENTIFICATION) +# define LC_IDENTIFICATION_MASK 2048 # 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 \ +# 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. */ @@ -163,12 +186,28 @@ typedef struct scm_locale int category_mask; } *scm_t_locale; -#else + +/* Free the resources used by LOCALE. */ +static inline void +scm_i_locale_free (scm_t_locale locale) +{ + free (locale->locale_name); + locale->locale_name = NULL; +} + +#else /* USE_GNU_LOCALE_API */ /* Alias for glibc's locale type. */ typedef locale_t scm_t_locale; -#endif +#define scm_i_locale_free freelocale + +#endif /* USE_GNU_LOCALE_API */ + + +/* A locale object denoting the global locale. */ +SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale"); + /* Validate parameter ARG as a locale object and set C_LOCALE to the corresponding C locale object. */ @@ -199,16 +238,8 @@ 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 + c_locale = (scm_t_locale) SCM_SMOB_DATA (locale); + scm_i_locale_free (c_locale); return 0; } @@ -217,76 +248,38 @@ SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale) static SCM smob_locale_mark (SCM locale) { - scm_t_locale c_locale; + register SCM dependency; - c_locale = (scm_t_locale)SCM_SMOB_DATA (locale); - return (c_locale->base_locale); -} -#endif + if (!scm_is_eq (locale, SCM_VARIABLE_REF (scm_global_locale))) + { + scm_t_locale c_locale; - -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; + c_locale = (scm_t_locale) SCM_SMOB_DATA (locale); + dependency = (c_locale->base_locale); + } 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); + dependency = SCM_BOOL_F; + return dependency; +} #endif - return locale; -} -#undef FUNC_NAME -SCM_DEFINE (scm_locale_p, "locale?", 1, 0, 0, - (SCM obj), - "Return true if @var{obj} is a locale object.") -#define FUNC_NAME s_scm_locale_p +static void inline scm_locale_error (const char *, int) SCM_NORETURN; + +/* Throw an exception corresponding to error ERR. */ +static void inline +scm_locale_error (const char *func_name, int err) { - if (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type, obj)) - return SCM_BOOL_T; - - return SCM_BOOL_F; + scm_syserror_msg (func_name, + "Failed to install locale", + SCM_EOL, err); } -#undef FUNC_NAME -#ifndef USE_GNU_LOCALE_API /* Emulate GNU's reentrant locale API. */ +/* Emulating GNU's reentrant locale API. */ +#ifndef USE_GNU_LOCALE_API /* Maximum number of chained locales (via `base_locale'). */ @@ -309,7 +302,7 @@ get_current_locale_settings (scm_t_locale_settings *settings) #define SCM_DEFINE_LOCALE_CATEGORY(_name) \ { \ SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \ - if (!locale_name) \ + if (locale_name == NULL) \ goto handle_error; \ \ settings-> _name = strdup (locale_name); \ @@ -323,7 +316,7 @@ get_current_locale_settings (scm_t_locale_settings *settings) return 0; handle_error: - return errno; + return EINVAL; handle_oom: return ENOMEM; @@ -346,7 +339,7 @@ restore_locale_settings (const scm_t_locale_settings *settings) return 0; handle_error: - return errno; + return EINVAL; } /* Free memory associated with SETTINGS. */ @@ -376,7 +369,7 @@ install_locale_categories (const char *locale_name, int category_mask) else { #define SCM_DEFINE_LOCALE_CATEGORY(_name) \ - if (category_mask & LC_ ## _name ## _MASK) \ + if (category_mask & SCM_LOCALE_CATEGORY_MASK (_name)) \ { \ SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \ if (result == NULL) \ @@ -389,7 +382,7 @@ install_locale_categories (const char *locale_name, int category_mask) return 0; handle_error: - return errno; + return EINVAL; } /* Install LOCALE, recursively installing its base locales first. On @@ -398,6 +391,7 @@ static int install_locale (scm_t_locale locale) { scm_t_locale stack[LOCALE_STACK_SIZE_MAX]; + int category_mask = 0; size_t stack_size = 0; int stack_offset = 0; const char *result = NULL; @@ -412,12 +406,16 @@ install_locale (scm_t_locale locale) stack[stack_size++] = locale; + /* Keep track of which categories have already been taken into + account. */ + category_mask |= locale->category_mask; + if (locale->base_locale != SCM_UNDEFINED) - locale = (scm_t_locale)SCM_SMOB_DATA (locale->base_locale); + locale = (scm_t_locale) SCM_SMOB_DATA (locale->base_locale); else locale = NULL; } - while (locale != NULL); + while ((locale != NULL) && (category_mask != LC_ALL_MASK)); /* Install the C locale to start from a pristine state. */ SCM_SYSCALL (result = setlocale (LC_ALL, "C")); @@ -442,7 +440,7 @@ install_locale (scm_t_locale locale) return 0; handle_error: - return errno; + return EINVAL; } /* Leave the locked locale section. */ @@ -481,19 +479,6 @@ enter_locale_section (scm_t_locale 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 \ @@ -514,10 +499,248 @@ scm_locale_error (const char *func_name, int err) } \ while (0) +/* Convert the current locale settings into a locale SMOB. On success, zero + is returned and RESULT points to the new SMOB. Otherwise, an error is + returned. */ +static int +get_current_locale (SCM *result) +{ + int err = 0; + scm_t_locale c_locale; + const char *current_locale; + + c_locale = scm_gc_malloc (sizeof (* c_locale), "locale"); + + + scm_i_pthread_mutex_lock (&scm_i_locale_mutex); + + c_locale->category_mask = LC_ALL_MASK; + c_locale->base_locale = SCM_UNDEFINED; + + current_locale = setlocale (LC_ALL, NULL); + if (current_locale != NULL) + { + c_locale->locale_name = strdup (current_locale); + if (c_locale->locale_name == NULL) + err = ENOMEM; + } + else + err = EINVAL; + + scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); + + if (err) + scm_gc_free (c_locale, sizeof (* c_locale), "locale"); + else + SCM_NEWSMOB (*result, scm_tc16_locale_smob_type, c_locale); + + return err; +} + + #endif /* !USE_GNU_LOCALE_API */ + -/* Locale-dependent string comparison. */ +/* `make-locale' can take either category lists or single categories (the + `LC_*' integer constants). */ +#define SCM_LIST_OR_INTEGER_P(arg) \ + (scm_is_integer (arg) || scm_is_true (scm_list_p (arg))) + + +/* Return the category mask corresponding to CATEGORY (an `LC_' integer + constant). */ +static inline int +category_to_category_mask (SCM category, + const char *func_name, int pos) +{ + int c_category; + int c_category_mask; + + c_category = scm_to_int (category); + +#define SCM_DEFINE_LOCALE_CATEGORY(_name) \ + case LC_ ## _name: \ + c_category_mask = SCM_LOCALE_CATEGORY_MASK (_name); \ + break; + + switch (c_category) + { +#include "locale-categories.h" + + case LC_ALL: + c_category_mask = LC_ALL_MASK; + break; + + default: + scm_wrong_type_arg_msg (func_name, pos, category, + "locale category"); + } + +#undef SCM_DEFINE_LOCALE_CATEGORY + + return c_category_mask; +} + +/* Convert CATEGORIES, a list of locale categories or a single category (an + integer), into a category mask. */ +static int +category_list_to_category_mask (SCM categories, + const char *func_name, int pos) +{ + int c_category_mask = 0; + + if (scm_is_integer (categories)) + c_category_mask = category_to_category_mask (categories, + func_name, pos); + else + for (; !scm_is_null (categories); categories = SCM_CDR (categories)) + { + SCM category = SCM_CAR (categories); + + c_category_mask |= + category_to_category_mask (category, func_name, pos); + } + + return c_category_mask; +} + + +SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0, + (SCM category_list, SCM locale_name, SCM base_locale), + "Return a reference to a data structure representing a set of " + "locale datasets. @var{category_list} should be either a list " + "of locale categories or a single category as used with " + "@code{setlocale} (@pxref{Locales, @code{setlocale}}) and " + "@var{locale_name} should be the name of the locale considered " + "(e.g., @code{\"sl_SI\"}). Optionally, if @code{base_locale} is " + "passed, it should be a locale object denoting settings for " + "categories not listed in @var{category_list}.") +#define FUNC_NAME s_scm_make_locale +{ + SCM locale = SCM_BOOL_F; + int err = 0; + int c_category_mask; + char *c_locale_name; + scm_t_locale c_base_locale, c_locale; + + SCM_MAKE_VALIDATE (1, category_list, LIST_OR_INTEGER_P); + SCM_VALIDATE_STRING (2, locale_name); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, base_locale, c_base_locale); + + c_category_mask = category_list_to_category_mask (category_list, + FUNC_NAME, 1); + c_locale_name = scm_to_locale_string (locale_name); + +#ifdef USE_GNU_LOCALE_API + + if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale))) + { + /* Fetch the current locale and turn in into a `locale_t'. Don't + duplicate the resulting `locale_t' because we want it to be consumed + by `newlocale ()'. */ + char *current_locale; + + scm_i_pthread_mutex_lock (&scm_i_locale_mutex); + + current_locale = setlocale (LC_ALL, NULL); + c_base_locale = newlocale (LC_ALL_MASK, current_locale, NULL); + + scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); + + if (c_base_locale == (locale_t) 0) + scm_locale_error (FUNC_NAME, errno); + } + else if (c_base_locale != (locale_t) 0) + { + /* C_BASE_LOCALE is to be consumed by `newlocale ()' so it needs to be + duplicated before. */ + c_base_locale = duplocale (c_base_locale); + if (c_base_locale == (locale_t) 0) + { + err = errno; + goto fail; + } + } + + c_locale = newlocale (c_category_mask, c_locale_name, c_base_locale); + + free (c_locale_name); + + if (c_locale == (locale_t) 0) + { + if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale))) + /* The base locale object was created lazily and must be freed. */ + freelocale (c_base_locale); + + scm_locale_error (FUNC_NAME, errno); + } + else + SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale); + +#else + + c_locale = scm_gc_malloc (sizeof (* c_locale), "locale"); + + c_locale->category_mask = c_category_mask; + c_locale->locale_name = c_locale_name; + + if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale))) + { + /* Get the current locale settings and turn them into a locale + object. */ + err = get_current_locale (&base_locale); + if (err) + goto fail; + } + + c_locale->base_locale = base_locale; + + { + /* Try out the new locale and raise an exception if it doesn't work. */ + int err; + scm_t_locale_settings prev_locale; + + err = enter_locale_section (c_locale, &prev_locale); + leave_locale_section (&prev_locale); + + if (err) + goto fail; + else + SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale); + } + +#endif + + return locale; + + fail: +#ifndef USE_GNU_LOCALE_API + scm_gc_free (c_locale, sizeof (* c_locale), "locale"); +#endif + free (c_locale_name); + scm_locale_error (FUNC_NAME, err); + + return SCM_BOOL_F; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_locale_p, "locale?", 1, 0, 0, + (SCM obj), + "Return true if @var{obj} is a locale object.") +#define FUNC_NAME s_scm_locale_p +{ + return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type, obj)); +} +#undef FUNC_NAME + + + +/* Locale-dependent string comparison. + + A similar API can be found in MzScheme starting from version 200: + http://download.plt-scheme.org/chronology/mzmr200alpha14.html . */ + /* 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 @@ -1124,33 +1347,388 @@ SCM_DEFINE (scm_locale_string_to_inexact, "locale-string->inexact", } #undef FUNC_NAME + +/* Language information, aka. `nl_langinfo ()'. */ + +/* FIXME: Issues related to `nl-langinfo'. + + 1. The `CODESET' value is not normalized. This is a secondary issue, but + still a practical issue. See + http://www.cl.cam.ac.uk/~mgk25/ucs/norm_charmap.c for codeset + normalization. + + 2. `nl_langinfo ()' is not available on Windows. + + 3. `nl_langinfo ()' may return strings encoded in a locale different from + the current one, thereby defeating `scm_from_locale_string ()'. + Example: support the current locale is "Latin-1" and one asks: + + (nl-langinfo DAY_1 (make-locale LC_ALL "eo_EO.UTF-8")) + + The result will be a UTF-8 string. However, `scm_from_locale_string', + which expects a Latin-1 string, won't be able to make much sense of the + returned string. Thus, we'd need an `scm_from_string ()' variant where + the locale (or charset) is explicitly passed. */ + + +SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0, + (SCM item, SCM locale), + "Return a string denoting locale information for @var{item} " + "in the current locale or that specified by @var{locale}. " + "The semantics and arguments are the same as those of the " + "X/Open @code{nl_langinfo} function (@pxref{The Elegant and " + "Fast Way, @code{nl_langinfo},, libc, The GNU C Library " + "Reference Manual}).") +#define FUNC_NAME s_scm_nl_langinfo +{ +#ifdef HAVE_NL_LANGINFO + SCM result; + nl_item c_item; + char *c_result; + scm_t_locale c_locale; + + SCM_VALIDATE_INT_COPY (2, item, c_item); + SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale); + + /* Sadly, `nl_langinfo ()' returns a pointer to a static string. According + to SuS v2, that static string may be modified by subsequent calls to + `nl_langinfo ()' as well as by calls to `setlocale ()'. Thus, we must + acquire the locale mutex before doing invoking `nl_langinfo ()'. See + http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for + details. */ + + scm_i_pthread_mutex_lock (&scm_i_locale_mutex); + if (c_locale != NULL) + { +#ifdef USE_GNU_LOCALE_API + c_result = nl_langinfo_l (c_item, c_locale); +#else + /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale + mutex is already taken. */ + int lsec_err; + scm_t_locale_settings lsec_prev_locale; + + lsec_err = get_current_locale_settings (&lsec_prev_locale); + if (lsec_err) + scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); + else + { + lsec_err = install_locale (c_locale); + if (lsec_err) + { + leave_locale_section (&lsec_prev_locale); + free_locale_settings (&lsec_prev_locale); + } + } + + if (lsec_err) + scm_locale_error (FUNC_NAME, lsec_err); + else + { + c_result = nl_langinfo (c_item); + + leave_locale_section (&lsec_prev_locale); + free_locale_settings (&lsec_prev_locale); + } +#endif + } + else + c_result = nl_langinfo (c_item); + + c_result = strdup (c_result); + scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); + + if (c_result == NULL) + result = SCM_BOOL_F; + else + { + char *p; + + switch (c_item) + { + case GROUPING: + case MON_GROUPING: + /* In this cases, the result is to be interpreted as a list of + numbers. If the last item is `CHARS_MAX', it has the special + meaning "no more grouping". */ + result = SCM_EOL; + for (p = c_result; (*p != '\0') && (*p != CHAR_MAX); p++) + result = scm_cons (SCM_I_MAKINUM ((int) *p), result); + + { + SCM last_pair = result; + + result = scm_reverse_x (result, SCM_EOL); + + if (*p != CHAR_MAX) + { + /* Cyclic grouping information. */ + if (last_pair != SCM_EOL) + SCM_SETCDR (last_pair, result); + } + } + + free (c_result); + break; + + case FRAC_DIGITS: + case INT_FRAC_DIGITS: + /* This is to be interpreted as a single integer. */ + if (*c_result == CHAR_MAX) + /* Unspecified. */ + result = SCM_BOOL_F; + else + result = SCM_I_MAKINUM (*c_result); + + free (c_result); + break; + + case P_CS_PRECEDES: + case N_CS_PRECEDES: + case INT_P_CS_PRECEDES: + case INT_N_CS_PRECEDES: + case P_SEP_BY_SPACE: + case N_SEP_BY_SPACE: + /* This is to be interpreted as a boolean. */ + result = scm_from_bool (*c_result); + + free (c_result); + break; + + case P_SIGN_POSN: + case N_SIGN_POSN: + case INT_P_SIGN_POSN: + case INT_N_SIGN_POSN: + /* See `(libc) Sign of Money Amount' for the interpretation of the + return value here. */ + switch (*c_result) + { + case 0: + result = scm_from_locale_symbol ("parenthesize"); + break; + + case 1: + result = scm_from_locale_symbol ("sign-before"); + break; + + case 2: + result = scm_from_locale_symbol ("sign-after"); + break; + + case 3: + result = scm_from_locale_symbol ("sign-before-currency-symbol"); + break; + + case 4: + result = scm_from_locale_symbol ("sign-after-currency-symbol"); + break; + + default: + result = scm_from_locale_symbol ("unspecified"); + } + break; + + default: + /* FIXME: `locale_string ()' is not appropriate here because of + encoding issues (see comment above). */ + result = scm_take_locale_string (c_result); + } + } + + return result; +#else + scm_syserror_msg (FUNC_NAME, "`nl-langinfo' not supported on your system", + SCM_EOL, ENOSYS); + + return SCM_BOOL_F; +#endif +} +#undef FUNC_NAME + +/* Define the `nl_item' constants. */ +static inline void +define_langinfo_items (void) +{ +#if (defined HAVE_NL_TYPES_H) && (defined HAVE_LANGINFO_H) + +#define DEFINE_NLITEM_CONSTANT(_item) \ + scm_c_define (# _item, scm_from_int (_item)) + + DEFINE_NLITEM_CONSTANT (CODESET); + + /* Abbreviated days of the week. */ + DEFINE_NLITEM_CONSTANT (ABDAY_1); + DEFINE_NLITEM_CONSTANT (ABDAY_2); + DEFINE_NLITEM_CONSTANT (ABDAY_3); + DEFINE_NLITEM_CONSTANT (ABDAY_4); + DEFINE_NLITEM_CONSTANT (ABDAY_5); + DEFINE_NLITEM_CONSTANT (ABDAY_6); + DEFINE_NLITEM_CONSTANT (ABDAY_7); + + /* Long-named days of the week. */ + DEFINE_NLITEM_CONSTANT (DAY_1); /* Sunday */ + DEFINE_NLITEM_CONSTANT (DAY_2); /* Monday */ + DEFINE_NLITEM_CONSTANT (DAY_3); /* Tuesday */ + DEFINE_NLITEM_CONSTANT (DAY_4); /* Wednesday */ + DEFINE_NLITEM_CONSTANT (DAY_5); /* Thursday */ + DEFINE_NLITEM_CONSTANT (DAY_6); /* Friday */ + DEFINE_NLITEM_CONSTANT (DAY_7); /* Saturday */ + + /* Abbreviated month names. */ + DEFINE_NLITEM_CONSTANT (ABMON_1); /* Jan */ + DEFINE_NLITEM_CONSTANT (ABMON_2); + DEFINE_NLITEM_CONSTANT (ABMON_3); + DEFINE_NLITEM_CONSTANT (ABMON_4); + DEFINE_NLITEM_CONSTANT (ABMON_5); + DEFINE_NLITEM_CONSTANT (ABMON_6); + DEFINE_NLITEM_CONSTANT (ABMON_7); + DEFINE_NLITEM_CONSTANT (ABMON_8); + DEFINE_NLITEM_CONSTANT (ABMON_9); + DEFINE_NLITEM_CONSTANT (ABMON_10); + DEFINE_NLITEM_CONSTANT (ABMON_11); + DEFINE_NLITEM_CONSTANT (ABMON_12); + + /* Long month names. */ + DEFINE_NLITEM_CONSTANT (MON_1); /* January */ + DEFINE_NLITEM_CONSTANT (MON_2); + DEFINE_NLITEM_CONSTANT (MON_3); + DEFINE_NLITEM_CONSTANT (MON_4); + DEFINE_NLITEM_CONSTANT (MON_5); + DEFINE_NLITEM_CONSTANT (MON_6); + DEFINE_NLITEM_CONSTANT (MON_7); + DEFINE_NLITEM_CONSTANT (MON_8); + DEFINE_NLITEM_CONSTANT (MON_9); + DEFINE_NLITEM_CONSTANT (MON_10); + DEFINE_NLITEM_CONSTANT (MON_11); + DEFINE_NLITEM_CONSTANT (MON_12); + + DEFINE_NLITEM_CONSTANT (AM_STR); /* Ante meridiem string. */ + DEFINE_NLITEM_CONSTANT (PM_STR); /* Post meridiem string. */ + + DEFINE_NLITEM_CONSTANT (D_T_FMT); /* Date and time format for strftime. */ + DEFINE_NLITEM_CONSTANT (D_FMT); /* Date format for strftime. */ + DEFINE_NLITEM_CONSTANT (T_FMT); /* Time format for strftime. */ + DEFINE_NLITEM_CONSTANT (T_FMT_AMPM);/* 12-hour time format for strftime. */ + + DEFINE_NLITEM_CONSTANT (ERA); /* Alternate era. */ + DEFINE_NLITEM_CONSTANT (ERA_D_FMT); /* Date in alternate era format. */ + DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT); /* Date and time in alternate era + format. */ + DEFINE_NLITEM_CONSTANT (ERA_T_FMT); /* Time in alternate era format. */ + + DEFINE_NLITEM_CONSTANT (ALT_DIGITS); /* Alternate symbols for digits. */ + DEFINE_NLITEM_CONSTANT (RADIXCHAR); + DEFINE_NLITEM_CONSTANT (THOUSEP); + +#ifdef YESEXPR + DEFINE_NLITEM_CONSTANT (YESEXPR); +#endif +#ifdef NOEXPR + DEFINE_NLITEM_CONSTANT (NOEXPR); +#endif + +#ifdef CRNCYSTR /* currency symbol */ + DEFINE_NLITEM_CONSTANT (CRNCYSTR); +#endif + + /* GNU extensions. */ + +#ifdef ERA_YEAR + DEFINE_NLITEM_CONSTANT (ERA_YEAR); /* Year in alternate era format. */ +#endif + + /* LC_MONETARY category: formatting of monetary quantities. + These items each correspond to a member of `struct lconv', + defined in . */ +#ifdef INT_CURR_SYMBOL + DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL); +#endif +#ifdef MON_DECIMAL_POINT + DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT); +#endif +#ifdef MON_THOUSANDS_SEP + DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP); +#endif +#ifdef MON_GROUPING + DEFINE_NLITEM_CONSTANT (MON_GROUPING); +#endif +#ifdef POSITIVE_SIGN + DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN); +#endif +#ifdef NEGATIVE_SIGN + DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN); +#endif +#ifdef GROUPING + DEFINE_NLITEM_CONSTANT (GROUPING); +#endif +#ifdef INT_FRAC_DIGITS + DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS); +#endif +#ifdef FRAC_DIGITS + DEFINE_NLITEM_CONSTANT (FRAC_DIGITS); +#endif +#ifdef P_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES); +#endif +#ifdef P_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE); +#endif +#ifdef N_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES); +#endif +#ifdef N_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE); +#endif +#ifdef P_SIGN_POSN + DEFINE_NLITEM_CONSTANT (P_SIGN_POSN); +#endif +#ifdef N_SIGN_POSN + DEFINE_NLITEM_CONSTANT (N_SIGN_POSN); +#endif +#ifdef INT_P_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES); +#endif +#ifdef INT_P_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE); +#endif +#ifdef INT_N_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES); +#endif +#ifdef INT_N_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE); +#endif +#ifdef INT_P_SIGN_POSN + DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN); +#endif +#ifdef INT_N_SIGN_POSN + DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN); +#endif + +#undef DEFINE_NLITEM_CONSTANT + +#endif /* HAVE_NL_TYPES_H */ +} void scm_init_i18n () { - scm_add_feature ("ice-9-i18n"); + SCM global_locale_smob; -#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)); +#ifdef HAVE_NL_LANGINFO + scm_add_feature ("nl-langinfo"); + define_langinfo_items (); +#endif #include "libguile/i18n.x" #ifndef USE_GNU_LOCALE_API scm_set_smob_mark (scm_tc16_locale_smob_type, smob_locale_mark); #endif + + /* Initialize the global locale object with a special `locale' SMOB. */ + SCM_NEWSMOB (global_locale_smob, scm_tc16_locale_smob_type, NULL); + SCM_VARIABLE_SET (scm_global_locale, global_locale_smob); } diff --git a/libguile/i18n.h b/libguile/i18n.h index 7d5d9baa9..17dc240d8 100644 --- a/libguile/i18n.h +++ b/libguile/i18n.h @@ -22,6 +22,7 @@ #include "libguile/__scm.h" +SCM_API SCM scm_global_locale; 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); @@ -40,6 +41,7 @@ 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 SCM scm_nl_langinfo (SCM item, SCM locale); SCM_API void scm_init_i18n (void); diff --git a/libguile/posix.c b/libguile/posix.c index dda20e8e1..81539baf2 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -119,6 +119,10 @@ extern char ** environ; # define USE_GNU_LOCALE_API #endif +#if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H) +# include +#endif + #if HAVE_CRYPT_H # include #endif @@ -1399,12 +1403,11 @@ 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 + systems (i.e., systems where a reentrant locale API is not available). It + is also acquired before calls to `nl_langinfo ()'. See `i18n.c' for + details. */ +scm_i_pthread_mutex_t scm_i_locale_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; #ifdef HAVE_SETLOCALE @@ -1421,6 +1424,7 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, "the locale will be set using environment variables.") #define FUNC_NAME s_scm_setlocale { + int c_category; char *clocale; char *rv; @@ -1436,13 +1440,11 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, scm_dynwind_free (clocale); } -#ifndef USE_GNU_LOCALE_API + c_category = scm_i_to_lc_category (category, 1); + 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 + rv = setlocale (c_category, clocale); scm_i_pthread_mutex_unlock (&scm_i_locale_mutex); -#endif if (rv == NULL) { @@ -1986,10 +1988,6 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, 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/srfi/ChangeLog b/srfi/ChangeLog index e662163fb..40e306902 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,20 @@ +2007-01-31 Ludovic Courtès + + * srfi-19.scm: Use `(ice-9 i18n)'. + (priv:locale-abbr-weekday-vector, priv:locale-long-weekday-vector, + priv:locale-abbr-month-vector, priv:locale-long-month-vector): + Removed. + (priv:locale-number-separator, priv:locale-pm, priv:locale-am, + priv:locale-abbr-weekday, priv:locale-long-weekday, + priv:locale-abbr-month, priv:locale-long-month): Aliases for their + respective `(ice-9 i18n)' equivalent. + (priv:vector-find): Removed, replaced by... + (priv:date-reverse-lookup): New procedure. Updated callers. + (priv:locale-am/pm): Use `priv:locale-pm' and `priv:locale-am' as + procedures. + (priv:directives): Use `priv:locale-number-separator' as a + procedure. + 2006-12-02 Kevin Ryde * srfi-60.c (scm_srfi60_copy_bit): Should be long not int for fixnum @@ -288,7 +305,7 @@ 2004-08-02 Kevin Ryde * srfi-13.c (scm_string_every): Correction to initial "res" value, - return should be #t for an empty string. Reported by Andreas Vögele. + return should be #t for an empty string. Reported by Andreas Vögele. 2004-07-10 Marius Vollmer @@ -511,7 +528,7 @@ * srfi-14.h (SCM_CHARSET_GET): Cast IDX to unsigned char so that it works for 8-bit characters. Thanks to Matthias Koeppe! No, - make that "Köppe". + make that "Köppe". 2002-04-24 Marius Vollmer @@ -564,7 +581,7 @@ 2002-02-22 Neil Jerram * srfi-19.scm (priv:year-day): Index into priv:month-assoc using - month number, not day number. (Thanks to Sébastien de Menten de + month number, not day number. (Thanks to Sébastien de Menten de Horne for reporting the problem.) 2002-02-11 Marius Vollmer @@ -983,7 +1000,7 @@ 2001-05-28 Michael Livshin * srfi-19.scm: removed a stray open parenthesis. (thanks to - Matthias Köppe for the report). + Matthias Köppe for the report). 2001-05-23 Rob Browning @@ -1239,3 +1256,7 @@ * Started guile-srfi-13 package. Files are copied from the guile-gdbm and slightly modified. + +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/srfi/srfi-19.scm b/srfi/srfi-19.scm index 896dd035f..a8daa26d1 100644 --- a/srfi/srfi-19.scm +++ b/srfi/srfi-19.scm @@ -41,7 +41,8 @@ (define-module (srfi srfi-19) :use-module (srfi srfi-6) :use-module (srfi srfi-8) - :use-module (srfi srfi-9)) + :use-module (srfi srfi-9) + :use-module (ice-9 i18n)) (begin-deprecated ;; Prevent `export' from re-exporting core bindings. This behaviour @@ -150,48 +151,9 @@ ;;-- LOCALE dependent constants -(define priv:locale-number-separator ".") - -(define priv:locale-abbr-weekday-vector - (vector "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat")) - -(define priv:locale-long-weekday-vector - (vector - "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")) - -;; note empty string in 0th place. -(define priv:locale-abbr-month-vector - (vector "" - "Jan" - "Feb" - "Mar" - "Apr" - "May" - "Jun" - "Jul" - "Aug" - "Sep" - "Oct" - "Nov" - "Dec")) - -(define priv:locale-long-month-vector - (vector "" - "January" - "February" - "March" - "April" - "May" - "June" - "July" - "August" - "September" - "October" - "November" - "December")) - -(define priv:locale-pm "PM") -(define priv:locale-am "AM") +(define priv:locale-number-separator locale-decimal-point) +(define priv:locale-pm locale-pm-string) +(define priv:locale-am locale-am-string) ;; See date->string (define priv:locale-date-time-format "~a ~b ~d ~H:~M:~S~z ~Y") @@ -964,38 +926,33 @@ (define (priv:last-n-digits i n) (abs (remainder i (expt 10 n)))) -(define (priv:locale-abbr-weekday n) - (vector-ref priv:locale-abbr-weekday-vector n)) +(define priv:locale-abbr-weekday locale-day-short) +(define priv:locale-long-weekday locale-day) +(define priv:locale-abbr-month locale-month-short) +(define priv:locale-long-month locale-month) -(define (priv:locale-long-weekday n) - (vector-ref priv:locale-long-weekday-vector n)) - -(define (priv:locale-abbr-month n) - (vector-ref priv:locale-abbr-month-vector n)) - -(define (priv:locale-long-month n) - (vector-ref priv:locale-long-month-vector n)) - -(define (priv:vector-find needle haystack comparator) - (let ((len (vector-length haystack))) - (define (priv:vector-find-int index) - (cond - ((>= index len) #f) - ((comparator needle (vector-ref haystack index)) index) - (else (priv:vector-find-int (+ index 1))))) - (priv:vector-find-int 0))) +(define (priv:date-reverse-lookup needle haystack-ref haystack-len + same?) + ;; Lookup NEEDLE (a string) using HAYSTACK-REF (a one argument procedure + ;; that returns a string corresponding to the given index) by passing it + ;; indices lower than HAYSTACK-LEN. + (let loop ((index 1)) + (cond ((> index haystack-len) #f) + ((same? needle (haystack-ref index)) + index) + (else (loop (+ index 1)))))) (define (priv:locale-abbr-weekday->index string) - (priv:vector-find string priv:locale-abbr-weekday-vector string=?)) + (priv:date-reverse-lookup string priv:locale-abbr-weekday 7 string=?)) (define (priv:locale-long-weekday->index string) - (priv:vector-find string priv:locale-long-weekday-vector string=?)) + (priv:date-reverse-lookup string priv:locale-long-weekday 7 string=?)) (define (priv:locale-abbr-month->index string) - (priv:vector-find string priv:locale-abbr-month-vector string=?)) + (priv:date-reverse-lookup string priv:locale-abbr-month 12 string=?)) (define (priv:locale-long-month->index string) - (priv:vector-find string priv:locale-long-month-vector string=?)) + (priv:date-reverse-lookup string priv:locale-long-month 12 string=?)) ;; FIXME: mkoeppe: Put a symbolic time zone in the date structs. @@ -1003,10 +960,8 @@ (define (priv:locale-print-time-zone date port) (priv:tz-printer (date-zone-offset date) port)) -;; FIXME: we should use strftime to determine this dynamically if possible. -;; Again, locale specific. (define (priv:locale-am/pm hr) - (if (> hr 11) priv:locale-pm priv:locale-am)) + (if (> hr 11) (priv:locale-pm) (priv:locale-am))) (define (priv:tz-printer offset port) (cond @@ -1069,7 +1024,7 @@ (le (string-length ns))) (if (> le 2) (begin - (display priv:locale-number-separator port) + (display (priv:locale-number-separator) port) (display (substring ns 2 le) port))))))) (cons #\h (lambda (date pad-with port) (display (date->string date "~b") port))) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 4688477fc..999c0c7d8 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,18 @@ +2007-01-31 Ludovic Courtès + + * tests/i18n.test: Use `(srfi srfi-1)'. + (exception:locale-error): New. + (locale objects): Test `make-locale' with both lists of `LC_*' + values and single `LC_*' values (instead of `LC_*_MASK' values). + [%global-locale]: New test. + (number parsing)[locale-string->inexact (French)]: New test. + (%c-locale, %english-days, every?): New top-level variables. + (nl-langinfo et al.): New test prefix. + + * tests/srfi-19.test: Install the C locale. + (SRFI date/time library)[string->date understands days and + months]: New test. + 2007-01-19 Ludovic Courtès * tests/eval.test (values): New test prefix. Values are structs, diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test index fca99c768..78d7e54fb 100644 --- a/test-suite/tests/i18n.test +++ b/test-suite/tests/i18n.test @@ -1,6 +1,6 @@ ;;;; i18n.test --- Exercise the i18n API. ;;;; -;;;; Copyright (C) 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. ;;;; Ludovic Courtès ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -19,25 +19,41 @@ (define-module (test-suite i18n) :use-module (ice-9 i18n) + :use-module (srfi srfi-1) :use-module (test-suite lib)) ;; Start from a pristine locale state. (setlocale LC_ALL "C") +(define exception:locale-error + (cons 'system-error "Failed to install locale")) + + (with-test-prefix "locale objects" (pass-if "make-locale (2 args)" - (not (not (make-locale LC_ALL_MASK "C")))) + (not (not (make-locale LC_ALL "C")))) + + (pass-if "make-locale (2 args, list)" + (not (not (make-locale (list LC_COLLATE LC_MESSAGES) "C")))) (pass-if "make-locale (3 args)" - (not (not (make-locale LC_COLLATE_MASK "C" - (make-locale LC_MESSAGES_MASK "C"))))) + (not (not (make-locale (list LC_COLLATE) "C" + (make-locale (list LC_MESSAGES) "C"))))) + + (pass-if-exception "make-locale with unknown locale" exception:locale-error + (make-locale LC_ALL "does-not-exist")) (pass-if "locale?" - (and (locale? (make-locale LC_ALL_MASK "C")) - (locale? (make-locale (logior LC_MESSAGES_MASK LC_NUMERIC_MASK) "C" - (make-locale LC_CTYPE_MASK "C")))))) + (and (locale? (make-locale (list LC_ALL) "C")) + (locale? (make-locale (list LC_MESSAGES LC_NUMERIC) "C" + (make-locale (list LC_CTYPE) "C"))))) + + (pass-if "%global-locale" + (and (locale? %global-locale)) + (locale? (make-locale (list LC_MONETARY) "C" + %global-locale)))) @@ -46,27 +62,30 @@ (pass-if "string-localeinexact "123.456" - (make-locale LC_NUMERIC_MASK "C"))) + (make-locale (list LC_NUMERIC) "C"))) (lambda (result char-count) (and (equal? result 123.456) - (equal? char-count 7)))))) + (equal? char-count 7))))) + + (pass-if "locale-string->inexact (French)" + (under-french-locale-or-unresolved + (lambda () + (call-with-values + (lambda () + (locale-string->inexact "123,456" %french-locale)) + (lambda (result char-count) + (and (equal? result 123.456) + (equal? char-count 7)))))))) + + +;;; +;;; `nl-langinfo' +;;; + +(setlocale LC_ALL "C") +(define %c-locale (make-locale LC_ALL "C")) + +(define %english-days + '("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")) + +(define (every? . args) + (not (not (apply every args)))) + + +(with-test-prefix "nl-langinfo et al." + + (pass-if "locale-day (1 arg)" + (every? equal? + %english-days + (map locale-day (map 1+ (iota 7))))) + + (pass-if "locale-day (2 args)" + (every? equal? + %english-days + (map (lambda (day) + (locale-day day %c-locale)) + (map 1+ (iota 7))))) + + (pass-if "locale-day (2 args, using `%global-locale')" + (every? equal? + %english-days + (map (lambda (day) + (locale-day day %global-locale)) + (map 1+ (iota 7))))) + + (pass-if "locale-day (French)" + (under-french-locale-or-unresolved + (lambda () + (let ((result (locale-day 3 %french-locale))) + (and (string? result) + (string-ci=? result "mardi")))))) + + (pass-if "locale-day (French, using `%global-locale')" + ;; Make sure `%global-locale' captures the current locale settings as + ;; installed using `setlocale'. + (under-french-locale-or-unresolved + (lambda () + (dynamic-wind + (lambda () + (setlocale LC_TIME %french-locale-name)) + (lambda () + (let* ((fr (make-locale (list LC_MONETARY) "C" %global-locale)) + (result (locale-day 3 fr))) + (setlocale LC_ALL "C") + (and (string? result) + (string-ci=? result "mardi")))) + (lambda () + (setlocale LC_ALL "C")))))) + + (pass-if "default locale" + ;; Make sure the default locale does not capture the current locale + ;; settings as installed using `setlocale'. The default locale should be + ;; "C". + (under-french-locale-or-unresolved + (lambda () + (dynamic-wind + (lambda () + (setlocale LC_ALL %french-locale-name)) + (lambda () + (let* ((locale (make-locale (list LC_MONETARY) "C")) + (result (locale-day 3 locale))) + (setlocale LC_ALL "C") + (and (string? result) + (string-ci=? result "Tuesday")))) + (lambda () + (setlocale LC_ALL "C"))))))) ;;; Local Variables: diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test index 126198afa..33e667cfc 100644 --- a/test-suite/tests/srfi-19.test +++ b/test-suite/tests/srfi-19.test @@ -27,6 +27,9 @@ :use-module (srfi srfi-19) :use-module (ice-9 format)) +;; Make sure we use the default locale. +(setlocale LC_ALL "C") + (define (with-tz* tz thunk) "Temporarily set the TZ environment variable to the passed string value and call THUNK." @@ -142,6 +145,19 @@ incomplete numerical tower implementation.)" (string->date "2001-06-01@08:00" "~Y-~m-~d@~H:~M"))) (date->time-utc (make-date 0 0 0 12 1 6 2001 0)))) + (pass-if "string->date understands days and months" + (time=? (let ((d (string->date "Saturday, December 9, 2006" + "~A, ~B ~d, ~Y"))) + (date->time-utc (make-date (date-nanosecond d) + (date-second d) + (date-minute d) + (date-hour d) + (date-day d) + (date-month d) + (date-year d) + 0))) + (date->time-utc + (make-date 0 0 0 0 9 12 2006 0)))) ;; check time comparison procedures (let* ((time1 (make-time time-monotonic 0 0)) (time2 (make-time time-monotonic 0 0))