From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: ludo@chbouib.org (Ludovic =?iso-8859-1?Q?Court=E8s?=) Newsgroups: gmane.lisp.guile.devel Subject: Re: More i18n Date: Tue, 16 Jan 2007 22:46:40 +0100 Message-ID: <878xg2tzjz.fsf@chbouib.org> References: <877iwzokpz.fsf@chbouib.org> <87vekg2a7a.fsf@zip.com.au> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1168984081 10222 80.91.229.12 (16 Jan 2007 21:48:01 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 16 Jan 2007 21:48:01 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Jan 16 22:47:57 2007 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1H6w9O-0004eZ-3h for guile-devel@m.gmane.org; Tue, 16 Jan 2007 22:47:53 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1H6w9M-0005DB-SI for guile-devel@m.gmane.org; Tue, 16 Jan 2007 16:47:24 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1H6w9G-0005Cc-6O for guile-devel@gnu.org; Tue, 16 Jan 2007 16:47:18 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1H6w9D-0005CP-VC for guile-devel@gnu.org; Tue, 16 Jan 2007 16:47:17 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1H6w9D-0005CM-Pb for guile-devel@gnu.org; Tue, 16 Jan 2007 16:47:15 -0500 Original-Received: from [80.91.229.2] (helo=ciao.gmane.org) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA:32) (Exim 4.52) id 1H6w9B-00060l-Nc for guile-devel@gnu.org; Tue, 16 Jan 2007 16:47:15 -0500 Original-Received: from list by ciao.gmane.org with local (Exim 4.43) id 1H6w93-0006O8-0O for guile-devel@gnu.org; Tue, 16 Jan 2007 22:47:05 +0100 Original-Received: from adh419.fdn.fr ([80.67.176.9]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 16 Jan 2007 22:47:04 +0100 Original-Received: from ludo by adh419.fdn.fr with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 16 Jan 2007 22:47:04 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-To: guile-devel@gnu.org Original-Lines: 2678 Original-X-Complaints-To: usenet@sea.gmane.org X-Gmane-NNTP-Posting-Host: adh419.fdn.fr X-URL: http://www.laas.fr/~lcourtes/ X-Revolutionary-Date: 27 =?iso-8859-1?Q?Niv=F4se?= an 215 de la =?iso-8859-1?Q?R=E9volution?= X-PGP-Key-ID: 0xEB1F5364 X-PGP-Key: http://www.laas.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 821D 815D 902A 7EAB 5CEE D120 7FBA 3D4F EB1F 5364 X-OS: i486-pc-linux-gnu User-Agent: Gnus/5.110006 (No Gnus v0.6) Emacs/21.4 (gnu/linux) Cancel-Lock: sha1:OhPbXqeoNXCgBcVYpdwm+GOq1mA= X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:6431 Archived-At: --=-=-= Hi, Kevin Ryde writes: > By way of concrete suggestion, something like > > (locale-weekday N) > (locale-weekday-short N) > (locale-month N) > (locale-month-short N) > > or similar names would be much nicer than messing about with > > (... (+ ABDAY_1 N)) > (... (+ MON_1 N -1)) ;; if N is 1 to 12 The patch below (against HEAD) addresses some of the concerns that were raised earlier, notably: 1. The awful, C-ish `nl_langinfo'-based API is now replaced by a shiny Schemey API, following Kevin's suggestion. `nl-langinfo' itself is only used internally and not exported. As a result, most of the `nl-langinfo'-based procedures are written in Scheme. 2. Since `nl-langinfo' is hidden from Scheme programmers, all the `locale-' procedures are guaranteed to work, no matter whether `nl_langinfo ()' is actually available (see the feature-conditional macros in `i18n.scm'). As a consequence, SRFI-19 internationalization is now straightforward as does not require feature-conditional code. 3. Previously uninterpreted `nl_langinfo ()' special return values are now correctly interpreted. For instance, the return value for `GROUPING' should not be interpreted as a string, as was the case with my earlier patch. 4. No attempt is made to convert to a different encoding the strings returned by `nl_langinfo ()'. 5. High-level procedures for locale-dependent number output are provided, namely `number->locale-string' and `monetary-amount->locale-string'. Both of them are implemented in Scheme (which is relieving, really ;-)). 6. Various bugs in the C code base were fixed, a few improvements were made (notably slight optimizations for systems without `locale_t'). 7. The test suite and documentation were augmented. I'm well aware that the patch is hard to read. Perhaps the most important things to start with are the API in `i18n.scm' and the corresponding documentation and test cases. Thanks, Ludovic. --=-=-= Content-Type: text/x-diff; charset=iso-8859-1 Content-Disposition: inline; filename*=us-ascii''%2c%2cnew-diff.diff Content-Transfer-Encoding: 8bit Content-Description: The new i18n patch! --- orig/configure.in +++ mod/configure.in @@ -525,12 +525,13 @@ # Reasons for testing: # complex.h - new in C99 # fenv.h - available in C99, but not older systems +# langinfo.h, nl_types.h - SuS v2 # AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h malloc.h memory.h string.h \ regex.h rxposix.h rx/rxposix.h sys/dir.h sys/ioctl.h sys/select.h \ sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \ sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \ -direct.h]) +direct.h langinfo.h nl_types.h]) # "complex double" is new in C99, and "complex" is only a keyword if # is included @@ -613,17 +614,19 @@ # 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 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 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 # sys/param.h - not in mingw # 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 sys/param.h sys/resource.h sys/file.h) +AC_CHECK_HEADERS(crypt.h netdb.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]) --- orig/doc/ref/api-data.texi +++ mod/doc/ref/api-data.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. @@ -1015,7 +1015,7 @@ 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 @@ 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=? --- orig/doc/ref/api-i18n.texi +++ mod/doc/ref/api-i18n.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 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. @@ -19,16 +19,20 @@ 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 +68,41 @@ 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): - -@example -(make-locale (logior LC_MESSAGE_MASK LC_CTYPE_MASK) "eo_EO") +locale (e.g., @code{"aa_DJ"}) and @var{category-list} should be a list +of locale categories 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 (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 (list LC_MONETARY) "hr_HR" + (make-locale (list LC_ALL) "eo_EO")) @end example A @code{system-error} exception (@pxref{Handling Errors}) is raised by @@ -155,70 +117,56 @@ Return true if @var{obj} is a locale object. @end deffn -The following procedures provide support for text collation. +@defvr {Scheme Variable} %global-locale +@defvrx {C Variable} scm_global_locale +This variable is bound to a locale object denoting the current process +locale as installed using @code{setlocale ()} (@pxref{Locales}). It +may be used like any other locale object, including as a third +argument to @code{make-locale}, for instance. +@end defvr + + +@node Text Collation, Character Case Mapping, i18n Introduction, Internationalization +@subsection Text Collation + +The following procedures provide support for text collation, i.e., +locale-dependent string and character sorting. @deffn {Scheme Procedure} string-locale? s1 s2 [locale] +@deffnx {Scheme Procedure} string-locale>? s1 s2 [locale] @deffnx {C Function} scm_string_locale_gt (s1, s2, locale) +@deffnx {Scheme Procedure} string-locale-ci? s1 s2 [locale] +@deffnx {C Function} scm_string_locale_ci_gt (s1, s2, locale) Compare strings @var{s1} and @var{s2} in a locale-dependent way. If @var{locale} is provided, it should be locale object (as returned by @code{make-locale}) and will be used to perform the comparison; -otherwise, the current system locale is used. -@end deffn - -@deffn {Scheme Procedure} string-locale-ci? s1 s2 [locale] -@deffnx {C Function} scm_string_locale_ci_gt (s1, s2, locale) -Compare strings @var{s1} and @var{s2} in a case-insensitive, and -locale-dependent way. If @var{locale} is provided, it should be -locale object (as returned by @code{make-locale}) and will be used to -perform the comparison; otherwise, the current system locale is used. +otherwise, the current system locale is used. For the @code{-ci} +variants, the comparison is made in a case-insensitive way. @end deffn @deffn {Scheme Procedure} string-locale-ci=? s1 s2 [locale] @deffnx {C Function} scm_string_locale_ci_eq (s1, s2, locale) Compare strings @var{s1} and @var{s2} in a case-insensitive, and locale-dependent way. If @var{locale} is provided, it should be -locale object (as returned by @code{make-locale}) and will be used to +a locale object (as returned by @code{make-locale}) and will be used to perform the comparison; otherwise, the current system locale is used. @end deffn @deffn {Scheme Procedure} char-locale? c1 c2 [locale] +@deffnx {Scheme Procedure} char-locale>? c1 c2 [locale] @deffnx {C Function} scm_char_locale_gt (c1, c2, locale) -Return true if character @var{c1} is greater than @var{c2} according -to @var{locale} or to the current locale. -@end deffn - -@deffn {Scheme Procedure} char-locale-ci? c1 c2 [locale] +@deffnx {Scheme Procedure} char-locale-ci>? c1 c2 [locale] @deffnx {C Function} scm_char_locale_ci_gt (c1, c2, locale) -Return true if character @var{c1} is greater than @var{c2}, in a case -insensitive way according to @var{locale} or to the current locale. +Compare characters @var{c1} and @var{c2} according to either +@var{locale} (a locale object as returned by @code{make-locale}) or +the current locale. For the @code{-ci} variants, the comparison is +made in a case-insensitive way. @end deffn @deffn {Scheme Procedure} char-locale-ci=? c1 c2 [locale] @@ -227,6 +175,9 @@ 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 +187,8 @@ 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 +214,20 @@ 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 +in French it is written @code{10 000,5}. These procedures allow to account for these differences. +@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 +235,232 @@ 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. 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 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 (list 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. + +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 +@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 --- orig/doc/ref/posix.texi +++ mod/doc/ref/posix.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 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. @@ -3162,7 +3162,7 @@ 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 --- orig/doc/ref/srfi-modules.texi +++ mod/doc/ref/srfi-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -2095,10 +2095,10 @@ 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 @@ -2219,9 +2219,10 @@ 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 --- orig/ice-9/i18n.scm +++ mod/ice-9/i18n.scm @@ -1,6 +1,6 @@ ;;;; i18n.scm --- internationalization support -;;;; Copyright (C) 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -29,18 +29,10 @@ ;;; Code: (define-module (ice-9 i18n) + :use-module (ice-9 optargs) :export (;; `locale' type make-locale locale? - - ;; locale category masks (standard) - LC_ALL_MASK - LC_COLLATE_MASK LC_CTYPE_MASK LC_MESSAGES_MASK - LC_MONETARY_MASK LC_NUMERIC_MASK LC_TIME_MASK - - ;; locale category masks (non-standard) - LC_PAPER_MASK LC_NAME_MASK LC_ADDRESS_MASK - LC_TELEPHONE_MASK LC_MEASUREMENT_MASK - LC_IDENTIFICATION_MASK + %global-locale ;; text collation string-locale? @@ -54,11 +46,372 @@ 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 (provided? 'nl-langinfo) + `(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 (if (provided? 'nl-langinfo) + `(if intl? + (apply nl-langinfo ,intl-item locale) + (apply nl-langinfo ,local-item locale)) + `(if intl? ,default/intl ,default/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). + (let ((strlen (string-length int))) + + ;; Process INT from right to left. + (let loop ((index (- strlen 1)) + (grouping grouping) + (since-separator 0) + (result "")) + (if (< index 0) + result + (let ((insert-separator? (and (not (null? grouping)) + (> index 0) + (= (car grouping) + (+ since-separator 1))))) + (loop (- index 1) + (if insert-separator? (cdr grouping) grouping) + (if insert-separator? 0 (+ since-separator 1)) + (string-append (if insert-separator? separator "") + (string (string-ref int index)) + 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 --- orig/libguile/i18n.c +++ mod/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 @@ #include "libguile/dynwind.h" #include "libguile/validate.h" #include "libguile/values.h" +#include "libguile/threads.h" #include #include /* `strcoll ()' */ @@ -53,11 +54,29 @@ #include #if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L) +/* The GNU thread-aware locale API is documented in ``Thread-Aware Locale + Model, a Proposal'', by Ulrich Drepper: + + http://people.redhat.com/drepper/tllocale.ps.gz + + It is now also implemented by Darwin: + + http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/newlocale.3.html + + The whole API is being standardized by the X/Open Group (as of Jan. 2007) + following Drepper's proposal. */ # define USE_GNU_LOCALE_API #endif -#ifndef USE_GNU_LOCALE_API -# include "libguile/posix.h" /* for `scm_i_locale_mutex' */ +#if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H) +# include +#endif + +#include "libguile/posix.h" /* for `scm_i_locale_mutex' */ + +#if (defined HAVE_LANGINFO_H) && (defined HAVE_NL_TYPES_H) +# include +# include #endif #ifndef HAVE_SETLOCALE @@ -69,6 +88,9 @@ } #endif +/* Helper stringification macro. */ +#define SCM_I18N_STRINGIFY(_name) # _name + /* Locale objects, string and character collation, and other locale-dependent @@ -78,14 +100,14 @@ locale API on non-GNU systems. The emulation is a bit "brute-force": Whenever a `-locale as found in glibc 2.3.6). This must be kept in sync with - `locale-categories.h'. */ - -# define LC_CTYPE_MASK (1 << LC_CTYPE) -# define LC_COLLATE_MASK (1 << LC_COLLATE) -# define LC_MESSAGES_MASK (1 << LC_MESSAGES) -# define LC_MONETARY_MASK (1 << LC_MONETARY) -# define LC_NUMERIC_MASK (1 << LC_NUMERIC) -# define LC_TIME_MASK (1 << LC_TIME) +/* Provide the locale category masks as found in glibc. This must be kept in + sync with `locale-categories.h'. */ + +# 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 +188,28 @@ 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 +240,8 @@ { 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 +250,38 @@ 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 +304,7 @@ #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 +318,7 @@ return 0; handle_error: - return errno; + return EINVAL; handle_oom: return ENOMEM; @@ -346,7 +341,7 @@ return 0; handle_error: - return errno; + return EINVAL; } /* Free memory associated with SETTINGS. */ @@ -376,7 +371,7 @@ 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 +384,7 @@ return 0; handle_error: - return errno; + return EINVAL; } /* Install LOCALE, recursively installing its base locales first. On @@ -398,6 +393,7 @@ 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 +408,16 @@ 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 +442,7 @@ return 0; handle_error: - return errno; + return EINVAL; } /* Leave the locked locale section. */ @@ -481,19 +481,6 @@ 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,8 +501,218 @@ } \ 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 */ + + +/* Convert CATEGORIES, a list of locale categories (integers), into a + category mask. */ +static int +category_list_to_category_mask (SCM categories, + const char *func_name, int pos) +{ + int c_category_mask = 0; + + for (; !scm_is_null (categories); categories = SCM_CDR (categories)) + { + int c_category; + SCM category = SCM_CAR (categories); + + 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; +} + + +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 a list " + "of locale categories 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_VALIDATE_LIST (1, category_list); + 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. */ @@ -1124,25 +1321,399 @@ } #undef FUNC_NAME + +/* Language information, aka. `nl_langinfo ()'. */ + +/* FIXME: Issues related to `language-information'. + + 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: + + (language-information DAY_1 (make-locale "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, + "`language-information' not supported on your system", + SCM_EOL, ENOSYS); + + return SCM_BOOL_F; +#endif +} +#undef FUNC_NAME + +/* Define the `nl_item' constants. */ +static inline void +define_langinfo_items (void) +{ +#if (defined HAVE_NL_TYPES_H) && (defined HAVE_LANGINFO_H) + +#define DEFINE_NLITEM_CONSTANT(_item) \ + scm_c_define (# _item, SCM_I_MAKINUM (_item)) + + DEFINE_NLITEM_CONSTANT (CODESET); + + /* Abbreviated days of the week. */ + DEFINE_NLITEM_CONSTANT (ABDAY_1); + DEFINE_NLITEM_CONSTANT (ABDAY_2); + DEFINE_NLITEM_CONSTANT (ABDAY_3); + DEFINE_NLITEM_CONSTANT (ABDAY_4); + DEFINE_NLITEM_CONSTANT (ABDAY_5); + DEFINE_NLITEM_CONSTANT (ABDAY_6); + DEFINE_NLITEM_CONSTANT (ABDAY_7); + + /* Long-named days of the week. */ + DEFINE_NLITEM_CONSTANT (DAY_1); /* Sunday */ + DEFINE_NLITEM_CONSTANT (DAY_2); /* Monday */ + DEFINE_NLITEM_CONSTANT (DAY_3); /* Tuesday */ + DEFINE_NLITEM_CONSTANT (DAY_4); /* Wednesday */ + DEFINE_NLITEM_CONSTANT (DAY_5); /* Thursday */ + DEFINE_NLITEM_CONSTANT (DAY_6); /* Friday */ + DEFINE_NLITEM_CONSTANT (DAY_7); /* Saturday */ + + /* Abbreviated month names. */ + DEFINE_NLITEM_CONSTANT (ABMON_1); /* Jan */ + DEFINE_NLITEM_CONSTANT (ABMON_2); + DEFINE_NLITEM_CONSTANT (ABMON_3); + DEFINE_NLITEM_CONSTANT (ABMON_4); + DEFINE_NLITEM_CONSTANT (ABMON_5); + DEFINE_NLITEM_CONSTANT (ABMON_6); + DEFINE_NLITEM_CONSTANT (ABMON_7); + DEFINE_NLITEM_CONSTANT (ABMON_8); + DEFINE_NLITEM_CONSTANT (ABMON_9); + DEFINE_NLITEM_CONSTANT (ABMON_10); + DEFINE_NLITEM_CONSTANT (ABMON_11); + DEFINE_NLITEM_CONSTANT (ABMON_12); + + /* Long month names. */ + DEFINE_NLITEM_CONSTANT (MON_1); /* January */ + DEFINE_NLITEM_CONSTANT (MON_2); + DEFINE_NLITEM_CONSTANT (MON_3); + DEFINE_NLITEM_CONSTANT (MON_4); + DEFINE_NLITEM_CONSTANT (MON_5); + DEFINE_NLITEM_CONSTANT (MON_6); + DEFINE_NLITEM_CONSTANT (MON_7); + DEFINE_NLITEM_CONSTANT (MON_8); + DEFINE_NLITEM_CONSTANT (MON_9); + DEFINE_NLITEM_CONSTANT (MON_10); + DEFINE_NLITEM_CONSTANT (MON_11); + DEFINE_NLITEM_CONSTANT (MON_12); + + DEFINE_NLITEM_CONSTANT (AM_STR); /* Ante meridiem string. */ + DEFINE_NLITEM_CONSTANT (PM_STR); /* Post meridiem string. */ + + DEFINE_NLITEM_CONSTANT (D_T_FMT); /* Date and time format for strftime. */ + DEFINE_NLITEM_CONSTANT (D_FMT); /* Date format for strftime. */ + DEFINE_NLITEM_CONSTANT (T_FMT); /* Time format for strftime. */ + DEFINE_NLITEM_CONSTANT (T_FMT_AMPM);/* 12-hour time format for strftime. */ + + DEFINE_NLITEM_CONSTANT (ERA); /* Alternate era. */ + DEFINE_NLITEM_CONSTANT (ERA_D_FMT); /* Date in alternate era format. */ + DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT); /* Date and time in alternate era + format. */ + DEFINE_NLITEM_CONSTANT (ERA_T_FMT); /* Time in alternate era format. */ + + DEFINE_NLITEM_CONSTANT (ALT_DIGITS); /* Alternate symbols for digits. */ + DEFINE_NLITEM_CONSTANT (RADIXCHAR); + DEFINE_NLITEM_CONSTANT (THOUSEP); + +#ifdef YESEXPR + DEFINE_NLITEM_CONSTANT (YESEXPR); +#endif +#ifdef NOEXPR + DEFINE_NLITEM_CONSTANT (NOEXPR); +#endif +#ifdef YESSTR + DEFINE_NLITEM_CONSTANT (YESSTR); +#endif +#ifdef NOSTR + DEFINE_NLITEM_CONSTANT (NOSTR); +#endif + + + /* GNU extensions. */ + +#ifdef ERA_YEAR + DEFINE_NLITEM_CONSTANT (ERA_YEAR); /* Year in alternate era format. */ +#endif +#ifdef DECIMAL_POINT + DEFINE_NLITEM_CONSTANT (DECIMAL_POINT); /* Equivalent to `RADIXCHAR'. */ +#endif + + /* LC_MONETARY category: formatting of monetary quantities. + These items each correspond to a member of `struct lconv', + defined in . */ +#ifdef INT_CURR_SYMBOL + DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL); +#endif +#ifdef CURRENCY_SYMBOL + DEFINE_NLITEM_CONSTANT (CURRENCY_SYMBOL); +#endif +#ifdef CRNCYSTR /* legacy symbol */ + DEFINE_NLITEM_CONSTANT (CRNCYSTR); +#endif +#ifdef MON_DECIMAL_POINT + DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT); +#endif +#ifdef MON_THOUSANDS_SEP + DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP); +#endif +#ifdef MON_GROUPING + DEFINE_NLITEM_CONSTANT (MON_GROUPING); +#endif +#ifdef POSITIVE_SIGN + DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN); +#endif +#ifdef NEGATIVE_SIGN + DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN); +#endif +#ifdef GROUPING + DEFINE_NLITEM_CONSTANT (GROUPING); +#endif +#ifdef INT_FRAC_DIGITS + DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS); +#endif +#ifdef FRAC_DIGITS + DEFINE_NLITEM_CONSTANT (FRAC_DIGITS); +#endif +#ifdef P_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES); +#endif +#ifdef P_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE); +#endif +#ifdef N_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES); +#endif +#ifdef N_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE); +#endif +#ifdef P_SIGN_POSN + DEFINE_NLITEM_CONSTANT (P_SIGN_POSN); +#endif +#ifdef N_SIGN_POSN + DEFINE_NLITEM_CONSTANT (N_SIGN_POSN); +#endif +#ifdef INT_P_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES); +#endif +#ifdef INT_P_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE); +#endif +#ifdef INT_N_CS_PRECEDES + DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES); +#endif +#ifdef INT_N_SEP_BY_SPACE + DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE); +#endif +#ifdef INT_P_SIGN_POSN + DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN); +#endif +#ifdef INT_N_SIGN_POSN + DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN); +#endif + +#undef DEFINE_NLITEM_CONSTANT + +#endif /* HAVE_NL_TYPES_H */ +} void scm_init_i18n () { - scm_add_feature ("ice-9-i18n"); + SCM global_locale_smob; -#define _SCM_STRINGIFY_LC(_name) # _name -#define SCM_STRINGIFY_LC(_name) _SCM_STRINGIFY_LC (_name) +#ifdef HAVE_NL_LANGINFO + scm_add_feature ("nl-langinfo"); + define_langinfo_items (); +#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)); +#define SCM_DEFINE_LOCALE_CATEGORY(_name) \ + scm_c_define ("LC_" SCM_I18N_STRINGIFY (_name) "_MASK", \ + scm_from_int (LC_ ## _name ## _MASK)); #include "locale-categories.h" #undef SCM_DEFINE_LOCALE_CATEGORY -#undef SCM_STRINGIFY_LC -#undef _SCM_STRINGIFY_LC scm_c_define ("LC_ALL_MASK", SCM_I_MAKINUM (LC_ALL_MASK)); @@ -1151,6 +1722,10 @@ #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); } --- orig/libguile/i18n.h +++ mod/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_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); --- orig/libguile/posix.c +++ mod/libguile/posix.c @@ -119,6 +119,13 @@ # define USE_GNU_LOCALE_API #endif +#if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H) +/* Darwin now supports the "GNU" thread-safe locale API but one has to + include to get it. See: + http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/newlocale.3.html */ +# include +#endif + #if HAVE_CRYPT_H # include #endif @@ -1384,12 +1391,11 @@ } #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 @@ -1406,6 +1412,7 @@ "the locale will be set using environment variables.") #define FUNC_NAME s_scm_setlocale { + int c_category; char *clocale; char *rv; @@ -1421,13 +1428,11 @@ 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) { @@ -1965,10 +1970,6 @@ void scm_init_posix () { -#ifndef USE_GNU_LOCALE_API - scm_i_pthread_mutex_init (&scm_i_locale_mutex, NULL); -#endif - scm_add_feature ("posix"); #ifdef HAVE_GETEUID scm_add_feature ("EIDs"); --- orig/srfi/srfi-19.scm +++ mod/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) +(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:vector-find needle haystack-ref haystack-len comparator) + (define (priv:vector-find-int index) + (let loop ((index index)) (cond - ((>= index len) #f) - ((comparator needle (vector-ref haystack index)) index) - (else (priv:vector-find-int (+ index 1))))) - (priv:vector-find-int 0))) + ((> index haystack-len) #f) + ((comparator needle (haystack-ref index)) + index) + (else (priv:vector-find-int (+ index 1)))))) + + (priv:vector-find-int 1)) (define (priv:locale-abbr-weekday->index string) - (priv:vector-find string priv:locale-abbr-weekday-vector string=?)) + (priv:vector-find 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:vector-find 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:vector-find 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:vector-find 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))) --- orig/test-suite/tests/i18n.test +++ mod/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,38 @@ (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 (list LC_ALL) "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 (list 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 +59,30 @@ (pass-if "string-localeinexact "123.456" - (make-locale LC_NUMERIC_MASK "C"))) + (make-locale (list LC_NUMERIC) "C"))) (lambda (result char-count) (and (equal? result 123.456) - (equal? char-count 7)))))) + (equal? char-count 7))))) + + (pass-if "locale-string->inexact (French)" + (under-french-locale-or-unresolved + (lambda () + (call-with-values + (lambda () + (locale-string->inexact "123,456" %french-locale)) + (lambda (result char-count) + (and (equal? result 123.456) + (equal? char-count 7)))))))) + + +;;; +;;; `nl-langinfo' +;;; + +(setlocale LC_ALL "C") +(define %c-locale (make-locale (list 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: --- orig/test-suite/tests/srfi-19.test +++ mod/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 @@ (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)) --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://lists.gnu.org/mailman/listinfo/guile-devel --=-=-=--