diff options
author | Ludovic Courtès <ludo@gnu.org> | 2007-01-31 20:58:20 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2007-01-31 20:58:20 +0000 |
commit | a2f00b9b36930797bf9e19c4a00fd089b0be3c9b (patch) | |
tree | 3a38874b96f73d7b1bedcbabf92fac1aa52ccd86 | |
parent | 0bdb025f7bc89222f0759f39a87c2369faec407d (diff) | |
download | guile-a2f00b9b36930797bf9e19c4a00fd089b0be3c9b.tar.gz |
Changes from arch/CVS synchronization
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | configure.in | 11 | ||||
-rw-r--r-- | doc/ref/ChangeLog | 15 | ||||
-rwxr-xr-x | doc/ref/api-data.texi | 4 | ||||
-rw-r--r-- | doc/ref/api-i18n.texi | 443 | ||||
-rw-r--r-- | doc/ref/posix.texi | 2 | ||||
-rw-r--r-- | doc/ref/srfi-modules.texi | 15 | ||||
-rw-r--r-- | ice-9/ChangeLog | 57 | ||||
-rw-r--r-- | ice-9/i18n.scm | 378 | ||||
-rw-r--r-- | libguile/ChangeLog | 35 | ||||
-rw-r--r-- | libguile/i18n.c | 864 | ||||
-rw-r--r-- | libguile/i18n.h | 2 | ||||
-rw-r--r-- | libguile/posix.c | 26 | ||||
-rw-r--r-- | srfi/ChangeLog | 29 | ||||
-rw-r--r-- | srfi/srfi-19.scm | 97 | ||||
-rw-r--r-- | test-suite/ChangeLog | 15 | ||||
-rw-r--r-- | test-suite/tests/i18n.test | 141 | ||||
-rw-r--r-- | test-suite/tests/srfi-19.test | 16 |
18 files changed, 1734 insertions, 421 deletions
@@ -1,3 +1,8 @@ +2007-01-31 Ludovic Courtès <ludovic.courtes@laas.fr> + + * configure.in: Look for `langinfo.h', `nl_types.h', `xlocale.h' + and `nl_langinfo'. + 2007-01-28 Neil Jerram <neil@ossau.uklinux.net> * 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 # <complex.h> 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 <ludovic.courtes@laas.fr> + + * 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 <hanwen@lilypond.org> * 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. - -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): +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 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 {C Function} scm_string_locale_lt (s1, s2, locale) -Compare strings @var{s1} and @var{s2} in a locale-dependent way. If -@var{locale} is provided, it should be locale object (as returned by -@code{make-locale}) and will be used to perform the comparison; -otherwise, the current system locale is used. -@end deffn - -@deffn {Scheme Procedure} string-locale>? s1 s2 [locale] +@deffnx {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_lt (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_lt (s1, s2, locale) -Compare strings @var{s1} and @var{s2} in a case-insensitive, and -locale-dependent way. If @var{locale} is provided, it should be -locale object (as returned by @code{make-locale}) and will be used to -perform the comparison; otherwise, the current system locale is used. -@end deffn - -@deffn {Scheme Procedure} string-locale-ci>? s1 s2 [locale] -@deffnx {C Function} scm_string_locale_ci_gt (s1, s2, locale) -Compare strings @var{s1} and @var{s2} in a case-insensitive, and -locale-dependent way. If @var{locale} is provided, it should be -locale object (as returned by @code{make-locale}) and will be used to -perform the comparison; otherwise, the current system locale is used. +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 {C Function} scm_char_locale_lt (c1, c2, locale) -Return true if character @var{c1} is lower than @var{c2} according to -@var{locale} or to the current locale. -@end deffn - -@deffn {Scheme Procedure} char-locale>? c1 c2 [locale] +@deffnx {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_lt (c1, c2, locale) -Return true if character @var{c1} is lower than @var{c2}, in a case -insensitive way according to @var{locale} or to the current locale. -@end deffn - -@deffn {Scheme Procedure} char-locale-ci>? c1 c2 [locale] +@deffnx {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 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 +@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 <ludovic.courtes@laas.fr> + + * 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 <user42@zip.com.au> * 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 <ludovic.courtes@laas.fr> +2006-03-04 Ludovic Courtès <ludovic.courtes@laas.fr> * 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 <ludovic.courtes@laas.fr> +2006-02-01 Ludovic Courtès <ludovic.courtes@laas.fr> * 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 <neil@ossau.uklinux.net> * 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 <neil@ossau.uklinux.net> @@ -186,7 +214,7 @@ * boot-9.scm (%cond-expand-features): Add srfi-61. -2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr> +2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr> * networking.scm (sockaddr:flowinfo, sockaddr:scopeid): New functions. @@ -1215,7 +1243,7 @@ 2002-01-12 Marius Vollmer <mvo@zagadka.ping.de> - 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 <ttn@revel.glug.org> @@ -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 <mvo@zagadka.ping.de> @@ -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 <mvo@zagadka.ping.de> @@ -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 <mgrabmue@cs.tu-berlin.de> @@ -2252,7 +2280,7 @@ 2000-08-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se> * format.scm (format:obj->str): Made tail-recursive. (Thanks to - Matthias Köppe.) + Matthias Köppe.) 2000-08-13 Mikael Djurfeldt <mdj@linnaeus.mit.edu> @@ -2351,7 +2379,7 @@ 2000-06-20 Mikael Djurfeldt <mdj@mdj.nada.kth.se> * 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 <mdj@thalamus.nada.kth.se> @@ -4813,3 +4841,6 @@ Fri Apr 19 13:53:08 1996 Tom Lord <lord@beehive> * 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<? 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 <ludovic.courtes@laas.fr> + + * i18n.c: Include "libguile/threads.h" and "libguile/posix.h" + unconditionally. Include <langinfo.h> and <nl_types.h> 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 <xlocale.h> 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 <hanwen@lilypond.org> * 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 <locale.h> #include <string.h> /* `strcoll ()' */ @@ -53,11 +54,29 @@ void *alloca (size_t); #include <errno.h> #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 <xlocale.h> +#endif + +#include "libguile/posix.h" /* for `scm_i_locale_mutex' */ + +#if (defined HAVE_LANGINFO_H) && (defined HAVE_NL_TYPES_H) +# include <langinfo.h> +# include <nl_types.h> #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<?' procedure is passed a locale object, then: - 1. The `scm_t_locale_mutex' is locked. + 1. The `scm_i_locale_mutex' is locked. 2. A series of `setlocale ()' call is performed to store the current - locale for each category in an `scm_t_locale_settings' object. + locale for each category in an `scm_t_locale' object. 3. A series of `setlocale ()' call is made to install each of the locale categories of each of the base locales of each locale object, recursively, starting from the last locale object of the chain. 4. The settings captured in step (2) are restored. - 5. The `scm_t_locale_mutex' is released. + 5. The `scm_i_locale_mutex' is released. - Hopefully, some smart standard will make that hack useless someday... - A similar API can be found in MzScheme starting from version 200: - http://download.plt-scheme.org/chronology/mzmr200alpha14.html . + Hopefully, the X/Open standard will eventually make this hack useless. Note: We don't wrap glibc's `uselocale ()' call because it sets the locale of the current _thread_ (unlike `setlocale ()') and doing so would require @@ -97,62 +117,65 @@ setlocale (int category, const char *name) re-installing this locale upon locale-dependent calls. */ +/* Return the category mask corresponding to CAT. */ +#define SCM_LOCALE_CATEGORY_MASK(_cat) LC_ ## _cat ## _MASK + + #ifndef USE_GNU_LOCALE_API -/* Provide the locale category masks as found in glibc (copied from - <locale.h> as found in glibc 2.3.6). This must be kept in sync with - `locale-categories.h'. */ +/* 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; - - c_locale = (scm_t_locale)SCM_SMOB_DATA (locale); - return (c_locale->base_locale); -} -#endif - + register SCM dependency; -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 (!scm_is_eq (locale, SCM_VARIABLE_REF (scm_global_locale))) + { + scm_t_locale c_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 -{ - if (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type, obj)) - return SCM_BOOL_T; +static void inline scm_locale_error (const char *, int) SCM_NORETURN; - return SCM_BOOL_F; +/* Throw an exception corresponding to error ERR. */ +static void inline +scm_locale_error (const char *func_name, int err) +{ + 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 */ + + +/* `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. */ +/* 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 - -void -scm_init_i18n () +/* 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) { - scm_add_feature ("ice-9-i18n"); +#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 -#define _SCM_STRINGIFY_LC(_name) # _name -#define SCM_STRINGIFY_LC(_name) _SCM_STRINGIFY_LC (_name) +#ifdef CRNCYSTR /* currency symbol */ + DEFINE_NLITEM_CONSTANT (CRNCYSTR); +#endif - /* 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" + /* GNU extensions. */ -#undef SCM_DEFINE_LOCALE_CATEGORY -#undef SCM_STRINGIFY_LC -#undef _SCM_STRINGIFY_LC +#ifdef ERA_YEAR + DEFINE_NLITEM_CONSTANT (ERA_YEAR); /* Year in alternate era format. */ +#endif - scm_c_define ("LC_ALL_MASK", SCM_I_MAKINUM (LC_ALL_MASK)); + /* LC_MONETARY category: formatting of monetary quantities. + These items each correspond to a member of `struct lconv', + defined in <locale.h>. */ +#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 global_locale_smob; + +#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 <xlocale.h> +#endif + #if HAVE_CRYPT_H # include <crypt.h> #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 <ludovic.courtes@laas.fr> + + * 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 <user42@zip.com.au> * srfi-60.c (scm_srfi60_copy_bit): Should be long not int for fixnum @@ -288,7 +305,7 @@ 2004-08-02 Kevin Ryde <user42@zip.com.au> * 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 <marius.vollmer@uni-dortmund.de> @@ -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 <mvo@zagadka.ping.de> @@ -564,7 +581,7 @@ 2002-02-22 Neil Jerram <neil@ossau.uklinux.net> * 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 <marius.vollmer@uni-dortmund.de> @@ -983,7 +1000,7 @@ 2001-05-28 Michael Livshin <mlivshin@bigfoot.com> * 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 <rlb@cs.utexas.edu> @@ -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-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: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: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 <ludovic.courtes@laas.fr> + + * 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 <ludovic.courtes@laas.fr> * 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-locale<?" (and (string-locale<? "hello" "world") (string-locale<? "hello" "world" - (make-locale LC_COLLATE_MASK "C")))) + (make-locale (list LC_COLLATE) "C")))) (pass-if "char-locale<?" (and (char-locale<? #\a #\b) - (char-locale<? #\a #\b (make-locale LC_COLLATE_MASK "C")))) + (char-locale<? #\a #\b (make-locale (list LC_COLLATE) "C")))) (pass-if "string-locale-ci=?" (and (string-locale-ci=? "Hello" "HELLO") (string-locale-ci=? "Hello" "HELLO" - (make-locale LC_COLLATE_MASK "C")))) + (make-locale (list LC_COLLATE) "C")))) (pass-if "string-locale-ci<?" (and (string-locale-ci<? "hello" "WORLD") (string-locale-ci<? "hello" "WORLD" - (make-locale LC_COLLATE_MASK "C"))))) + (make-locale (list LC_COLLATE) "C"))))) +(define %french-locale-name + "fr_FR.ISO-8859-1") + (define %french-locale (false-if-exception - (make-locale (logior LC_CTYPE_MASK LC_COLLATE_MASK) - "fr_FR.ISO-8859-1"))) + (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) + %french-locale-name))) (define (under-french-locale-or-unresolved thunk) ;; On non-GNU systems, an exception may be raised only when the locale is @@ -112,11 +131,11 @@ (pass-if "char-locale-downcase" (and (eq? #\a (char-locale-downcase #\A)) - (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL_MASK "C"))))) + (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL "C"))))) (pass-if "char-locale-upcase" (and (eq? #\Z (char-locale-upcase #\z)) - (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL_MASK "C")))))) + (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))) (with-test-prefix "number parsing" @@ -131,10 +150,98 @@ (call-with-values (lambda () (locale-string->inexact "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)) |