1 /* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25 #include "libguile/_scm.h"
26 #include "libguile/extensions.h"
27 #include "libguile/feature.h"
28 #include "libguile/i18n.h"
29 #include "libguile/strings.h"
30 #include "libguile/chars.h"
31 #include "libguile/dynwind.h"
32 #include "libguile/validate.h"
33 #include "libguile/values.h"
34 #include "libguile/threads.h"
37 #include <string.h> /* `strcoll ()' */
38 #include <ctype.h> /* `toupper ()' et al. */
43 #if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
44 /* The GNU thread-aware locale API is documented in ``Thread-Aware Locale
45 Model, a Proposal'', by Ulrich Drepper:
47 http://people.redhat.com/drepper/tllocale.ps.gz
49 It is now also implemented by Darwin:
51 http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/newlocale.3.html
53 The whole API was eventually standardized in the ``Open Group Base
54 Specifications Issue 7'' (aka. "POSIX 2008"):
56 http://www.opengroup.org/onlinepubs/9699919799/basedefs/locale.h.html */
57 # define USE_GNU_LOCALE_API
60 #include "libguile/posix.h" /* for `scm_i_locale_mutex' */
62 #ifdef HAVE_LANGINFO_H
63 # include <langinfo.h>
65 #ifdef HAVE_NL_TYPES_H
66 # include <nl_types.h>
69 /* Cygwin has <langinfo.h> but lacks <nl_types.h> and `nl_item'. */
73 #ifndef HAVE_SETLOCALE
75 setlocale (int category
, const char *name
)
82 /* Helper stringification macro. */
83 #define SCM_I18N_STRINGIFY(_name) # _name
87 /* Locale objects, string and character collation, and other locale-dependent
90 A large part of the code here deals with emulating glibc's reentrant
91 locale API on non-GNU systems. The emulation is a bit "brute-force":
92 Whenever a `-locale<?' procedure is passed a locale object, then:
94 1. The `scm_i_locale_mutex' is locked.
95 2. A series of `setlocale ()' call is performed to store the current
96 locale for each category in an `scm_t_locale' object.
97 3. A series of `setlocale ()' call is made to install each of the locale
98 categories of each of the base locales of each locale object,
99 recursively, starting from the last locale object of the chain.
100 4. The settings captured in step (2) are restored.
101 5. The `scm_i_locale_mutex' is released.
103 Hopefully, the X/Open standard will eventually make this hack useless.
105 Note: We don't wrap glibc's `uselocale ()' call because it sets the locale
106 of the current _thread_ (unlike `setlocale ()') and doing so would require
107 maintaining per-thread locale information on non-GNU systems and always
108 re-installing this locale upon locale-dependent calls. */
111 /* Return the category mask corresponding to CAT. */
112 #define SCM_LOCALE_CATEGORY_MASK(_cat) LC_ ## _cat ## _MASK
115 #ifndef USE_GNU_LOCALE_API
117 /* Provide the locale category masks as found in glibc. This must be kept in
118 sync with `locale-categories.h'. */
120 # define LC_CTYPE_MASK 1
121 # define LC_COLLATE_MASK 2
122 # define LC_MESSAGES_MASK 4
123 # define LC_MONETARY_MASK 8
124 # define LC_NUMERIC_MASK 16
125 # define LC_TIME_MASK 32
128 # define LC_PAPER_MASK 64
130 # define LC_PAPER_MASK 0
133 # define LC_NAME_MASK 128
135 # define LC_NAME_MASK 0
138 # define LC_ADDRESS_MASK 256
140 # define LC_ADDRESS_MASK 0
143 # define LC_TELEPHONE_MASK 512
145 # define LC_TELEPHONE_MASK 0
147 # ifdef LC_MEASUREMENT
148 # define LC_MEASUREMENT_MASK 1024
150 # define LC_MEASUREMENT_MASK 0
152 # ifdef LC_IDENTIFICATION
153 # define LC_IDENTIFICATION_MASK 2048
155 # define LC_IDENTIFICATION_MASK 0
158 # define LC_ALL_MASK (LC_CTYPE_MASK \
167 | LC_TELEPHONE_MASK \
168 | LC_MEASUREMENT_MASK \
169 | LC_IDENTIFICATION_MASK \
172 /* Locale objects as returned by `make-locale' on non-GNU systems. */
173 typedef struct scm_locale
175 SCM base_locale
; /* a `locale' object */
181 /* Free the resources used by LOCALE. */
183 scm_i_locale_free (scm_t_locale locale
)
185 free (locale
->locale_name
);
186 locale
->locale_name
= NULL
;
189 #else /* USE_GNU_LOCALE_API */
191 /* Alias for glibc's locale type. */
192 typedef locale_t scm_t_locale
;
194 #define scm_i_locale_free freelocale
196 #endif /* USE_GNU_LOCALE_API */
199 /* A locale object denoting the global locale. */
200 SCM_GLOBAL_VARIABLE (scm_global_locale
, "%global-locale");
203 /* Validate parameter ARG as a locale object and set C_LOCALE to the
204 corresponding C locale object. */
205 #define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale) \
208 SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type); \
209 (_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg); \
213 /* Validate optional parameter ARG as either undefined or bound to a locale
214 object. Set C_LOCALE to the corresponding C locale object or NULL. */
215 #define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \
218 if ((_arg) != SCM_UNDEFINED) \
219 SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \
221 (_c_locale) = NULL; \
226 SCM_SMOB (scm_tc16_locale_smob_type
, "locale", 0);
228 SCM_SMOB_FREE (scm_tc16_locale_smob_type
, smob_locale_free
, locale
)
230 scm_t_locale c_locale
;
232 c_locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
);
233 scm_i_locale_free (c_locale
);
239 static void inline scm_locale_error (const char *, int) SCM_NORETURN
;
241 /* Throw an exception corresponding to error ERR. */
243 scm_locale_error (const char *func_name
, int err
)
245 scm_syserror_msg (func_name
,
246 "Failed to install locale",
252 /* Emulating GNU's reentrant locale API. */
253 #ifndef USE_GNU_LOCALE_API
256 /* Maximum number of chained locales (via `base_locale'). */
257 #define LOCALE_STACK_SIZE_MAX 256
261 #define SCM_DEFINE_LOCALE_CATEGORY(_name) char * _name;
262 #include "locale-categories.h"
263 #undef SCM_DEFINE_LOCALE_CATEGORY
264 } scm_t_locale_settings
;
266 /* Fill out SETTINGS according to the current locale settings. On success
267 zero is returned and SETTINGS is properly initialized. */
269 get_current_locale_settings (scm_t_locale_settings
*settings
)
271 const char *locale_name
;
273 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
275 SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \
276 if (locale_name == NULL) \
279 settings-> _name = strdup (locale_name); \
280 if (settings-> _name == NULL) \
284 #include "locale-categories.h"
285 #undef SCM_DEFINE_LOCALE_CATEGORY
296 /* Restore locale settings SETTINGS. On success, return zero. */
298 restore_locale_settings (const scm_t_locale_settings
*settings
)
302 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
303 SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name)); \
304 if (result == NULL) \
307 #include "locale-categories.h"
308 #undef SCM_DEFINE_LOCALE_CATEGORY
316 /* Free memory associated with SETTINGS. */
318 free_locale_settings (scm_t_locale_settings
*settings
)
320 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
321 free (settings-> _name); \
322 settings->_name = NULL;
323 #include "locale-categories.h"
324 #undef SCM_DEFINE_LOCALE_CATEGORY
327 /* Install the locale named LOCALE_NAME for all the categories listed in
330 install_locale_categories (const char *locale_name
, int category_mask
)
334 if (category_mask
== LC_ALL_MASK
)
336 SCM_SYSCALL (result
= setlocale (LC_ALL
, locale_name
));
342 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
343 if (category_mask & SCM_LOCALE_CATEGORY_MASK (_name)) \
345 SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \
346 if (result == NULL) \
349 #include "locale-categories.h"
350 #undef SCM_DEFINE_LOCALE_CATEGORY
359 /* Install LOCALE, recursively installing its base locales first. On
360 success, zero is returned. */
362 install_locale (scm_t_locale locale
)
364 scm_t_locale stack
[LOCALE_STACK_SIZE_MAX
];
365 int category_mask
= 0;
366 size_t stack_size
= 0;
367 int stack_offset
= 0;
368 const char *result
= NULL
;
370 /* Build up a locale stack by traversing the `base_locale' link. */
373 if (stack_size
>= LOCALE_STACK_SIZE_MAX
)
374 /* We cannot use `scm_error ()' here because otherwise the locale
375 mutex may remain locked. */
378 stack
[stack_size
++] = locale
;
380 /* Keep track of which categories have already been taken into
382 category_mask
|= locale
->category_mask
;
384 if (locale
->base_locale
!= SCM_UNDEFINED
)
385 locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
->base_locale
);
389 while ((locale
!= NULL
) && (category_mask
!= LC_ALL_MASK
));
391 /* Install the C locale to start from a pristine state. */
392 SCM_SYSCALL (result
= setlocale (LC_ALL
, "C"));
396 /* Install the locales in reverse order. */
397 for (stack_offset
= stack_size
- 1;
404 locale
= stack
[stack_offset
];
405 err
= install_locale_categories (locale
->locale_name
,
406 locale
->category_mask
);
417 /* Leave the locked locale section. */
419 leave_locale_section (const scm_t_locale_settings
*settings
)
421 /* Restore the previous locale settings. */
422 (void)restore_locale_settings (settings
);
424 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
427 /* Enter a locked locale section. */
429 enter_locale_section (scm_t_locale locale
,
430 scm_t_locale_settings
*prev_locale
)
434 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
436 err
= get_current_locale_settings (prev_locale
);
439 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
443 err
= install_locale (locale
);
446 leave_locale_section (prev_locale
);
447 free_locale_settings (prev_locale
);
453 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
454 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
458 scm_t_locale_settings lsec_prev_locale; \
460 lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale); \
462 scm_locale_error (FUNC_NAME, lsec_err); \
467 leave_locale_section (&lsec_prev_locale); \
468 free_locale_settings (&lsec_prev_locale); \
473 /* Convert the current locale settings into a locale SMOB. On success, zero
474 is returned and RESULT points to the new SMOB. Otherwise, an error is
477 get_current_locale (SCM
*result
)
480 scm_t_locale c_locale
;
481 const char *current_locale
;
483 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
486 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
488 c_locale
->category_mask
= LC_ALL_MASK
;
489 c_locale
->base_locale
= SCM_UNDEFINED
;
491 current_locale
= setlocale (LC_ALL
, NULL
);
492 if (current_locale
!= NULL
)
494 c_locale
->locale_name
= strdup (current_locale
);
495 if (c_locale
->locale_name
== NULL
)
501 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
504 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
506 SCM_NEWSMOB (*result
, scm_tc16_locale_smob_type
, c_locale
);
511 #else /* USE_GNU_LOCALE_API */
513 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
514 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
517 scm_t_locale old_loc; \
519 old_loc = uselocale (_c_locale); \
521 uselocale (old_loc); \
526 #endif /* USE_GNU_LOCALE_API */
530 /* `make-locale' can take either category lists or single categories (the
531 `LC_*' integer constants). */
532 #define SCM_LIST_OR_INTEGER_P(arg) \
533 (scm_is_integer (arg) || scm_is_true (scm_list_p (arg)))
536 /* Return the category mask corresponding to CATEGORY (an `LC_' integer
539 category_to_category_mask (SCM category
,
540 const char *func_name
, int pos
)
545 c_category
= scm_to_int (category
);
547 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
549 c_category_mask = SCM_LOCALE_CATEGORY_MASK (_name); \
554 #include "locale-categories.h"
557 c_category_mask
= LC_ALL_MASK
;
561 scm_wrong_type_arg_msg (func_name
, pos
, category
,
565 #undef SCM_DEFINE_LOCALE_CATEGORY
567 return c_category_mask
;
570 /* Convert CATEGORIES, a list of locale categories or a single category (an
571 integer), into a category mask. */
573 category_list_to_category_mask (SCM categories
,
574 const char *func_name
, int pos
)
576 int c_category_mask
= 0;
578 if (scm_is_integer (categories
))
579 c_category_mask
= category_to_category_mask (categories
,
582 for (; !scm_is_null (categories
); categories
= SCM_CDR (categories
))
584 SCM category
= SCM_CAR (categories
);
587 category_to_category_mask (category
, func_name
, pos
);
590 return c_category_mask
;
594 SCM_DEFINE (scm_make_locale
, "make-locale", 2, 1, 0,
595 (SCM category_list
, SCM locale_name
, SCM base_locale
),
596 "Return a reference to a data structure representing a set of "
597 "locale datasets. @var{category_list} should be either a list "
598 "of locale categories or a single category as used with "
599 "@code{setlocale} (@pxref{Locales, @code{setlocale}}) and "
600 "@var{locale_name} should be the name of the locale considered "
601 "(e.g., @code{\"sl_SI\"}). Optionally, if @code{base_locale} is "
602 "passed, it should be a locale object denoting settings for "
603 "categories not listed in @var{category_list}.")
604 #define FUNC_NAME s_scm_make_locale
606 SCM locale
= SCM_BOOL_F
;
610 scm_t_locale c_base_locale
, c_locale
;
612 SCM_MAKE_VALIDATE (1, category_list
, LIST_OR_INTEGER_P
);
613 SCM_VALIDATE_STRING (2, locale_name
);
614 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, base_locale
, c_base_locale
);
616 c_category_mask
= category_list_to_category_mask (category_list
,
618 c_locale_name
= scm_to_locale_string (locale_name
);
620 #ifdef USE_GNU_LOCALE_API
622 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
623 c_base_locale
= LC_GLOBAL_LOCALE
;
625 if (c_base_locale
!= (locale_t
) 0)
627 /* C_BASE_LOCALE is to be consumed by `newlocale ()' so it needs to be
628 duplicated before. */
629 c_base_locale
= duplocale (c_base_locale
);
631 if (c_base_locale
== (locale_t
) 0)
638 c_locale
= newlocale (c_category_mask
, c_locale_name
, c_base_locale
);
640 free (c_locale_name
);
642 if (c_locale
== (locale_t
) 0)
644 if (c_base_locale
!= (locale_t
) 0)
645 freelocale (c_base_locale
);
646 scm_locale_error (FUNC_NAME
, errno
);
649 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
653 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
655 c_locale
->category_mask
= c_category_mask
;
656 c_locale
->locale_name
= c_locale_name
;
658 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
660 /* Get the current locale settings and turn them into a locale
662 err
= get_current_locale (&base_locale
);
667 c_locale
->base_locale
= base_locale
;
670 /* Try out the new locale and raise an exception if it doesn't work. */
672 scm_t_locale_settings prev_locale
;
674 err
= enter_locale_section (c_locale
, &prev_locale
);
680 leave_locale_section (&prev_locale
);
681 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
690 #ifndef USE_GNU_LOCALE_API
691 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
693 free (c_locale_name
);
694 scm_locale_error (FUNC_NAME
, err
);
700 SCM_DEFINE (scm_locale_p
, "locale?", 1, 0, 0,
702 "Return true if @var{obj} is a locale object.")
703 #define FUNC_NAME s_scm_locale_p
705 return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type
, obj
));
711 /* Locale-dependent string comparison.
713 A similar API can be found in MzScheme starting from version 200:
714 http://download.plt-scheme.org/chronology/mzmr200alpha14.html . */
716 #define SCM_STRING_TO_U32_BUF(s1, c_s1) \
719 if (scm_i_is_narrow_string (s1)) \
722 const char *buf = scm_i_string_chars (s1); \
724 len = scm_i_string_length (s1); \
725 c_s1 = alloca (sizeof (scm_t_wchar) * (len + 1)); \
727 for (i = 0; i < len; i ++) \
728 c_s1[i] = (unsigned char ) buf[i]; \
732 c_s1 = (scm_t_wchar *) scm_i_string_wide_chars (s1); \
736 /* Compare UTF-32 strings according to LOCALE. Returns a negative value if
737 S1 compares smaller than S2, a positive value if S1 compares larger than
738 S2, or 0 if they compare equal. */
740 compare_u32_strings (SCM s1
, SCM s2
, SCM locale
, const char *func_name
)
741 #define FUNC_NAME func_name
744 scm_t_locale c_locale
;
745 scm_t_wchar
*c_s1
, *c_s2
;
746 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
748 SCM_STRING_TO_U32_BUF (s1
, c_s1
);
749 SCM_STRING_TO_U32_BUF (s2
, c_s2
);
752 RUN_IN_LOCALE_SECTION (c_locale
,
753 result
= u32_strcoll ((const scm_t_uint32
*) c_s1
,
754 (const scm_t_uint32
*) c_s2
));
756 result
= u32_strcoll ((const scm_t_uint32
*) c_s1
,
757 (const scm_t_uint32
*) c_s2
);
759 scm_remember_upto_here_2 (s1
, s2
);
760 scm_remember_upto_here (locale
);
765 /* Return the current language of the locale. */
769 /* Note: If the locale has been set with 'uselocale', uc_locale_language
770 from libunistring versions 0.9.1 and older will return the incorrect
771 (non-thread-specific) locale. This is fixed in versions 0.9.2 and
773 return uc_locale_language ();
777 u32_locale_casecoll (const char *func_name
, const scm_t_uint32
*c_s1
,
778 const scm_t_uint32
*c_s2
,
781 /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must note
782 make any non-local exit. */
785 const char *loc
= locale_language ();
787 ret
= u32_casecoll (c_s1
, u32_strlen (c_s1
),
788 c_s2
, u32_strlen (c_s2
),
789 loc
, UNINORM_NFC
, result
);
791 return ret
== 0 ? ret
: errno
;
795 compare_u32_strings_ci (SCM s1
, SCM s2
, SCM locale
, const char *func_name
)
796 #define FUNC_NAME func_name
799 scm_t_locale c_locale
;
800 scm_t_wchar
*c_s1
, *c_s2
;
801 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
803 SCM_STRING_TO_U32_BUF (s1
, c_s1
);
804 SCM_STRING_TO_U32_BUF (s2
, c_s2
);
807 RUN_IN_LOCALE_SECTION
809 ret
= u32_locale_casecoll (func_name
,
810 (const scm_t_uint32
*) c_s1
,
811 (const scm_t_uint32
*) c_s2
,
814 ret
= u32_locale_casecoll (func_name
,
815 (const scm_t_uint32
*) c_s1
,
816 (const scm_t_uint32
*) c_s2
,
819 if (SCM_UNLIKELY (ret
!= 0))
822 scm_syserror (FUNC_NAME
);
825 scm_remember_upto_here_2 (s1
, s2
);
826 scm_remember_upto_here (locale
);
832 /* Store into DST an upper-case version of SRC. */
834 str_upcase (register char *dst
, register const char *src
)
836 for (; *src
!= '\0'; src
++, dst
++)
837 *dst
= toupper ((int) *src
);
842 str_downcase (register char *dst
, register const char *src
)
844 for (; *src
!= '\0'; src
++, dst
++)
845 *dst
= tolower ((int) *src
);
849 #ifdef USE_GNU_LOCALE_API
851 str_upcase_l (register char *dst
, register const char *src
,
854 for (; *src
!= '\0'; src
++, dst
++)
855 *dst
= toupper_l (*src
, locale
);
860 str_downcase_l (register char *dst
, register const char *src
,
863 for (; *src
!= '\0'; src
++, dst
++)
864 *dst
= tolower_l (*src
, locale
);
870 SCM_DEFINE (scm_string_locale_lt
, "string-locale<?", 2, 1, 0,
871 (SCM s1
, SCM s2
, SCM locale
),
872 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
873 "If @var{locale} is provided, it should be locale object (as "
874 "returned by @code{make-locale}) and will be used to perform the "
875 "comparison; otherwise, the current system locale is used.")
876 #define FUNC_NAME s_scm_string_locale_lt
880 SCM_VALIDATE_STRING (1, s1
);
881 SCM_VALIDATE_STRING (2, s2
);
883 result
= compare_u32_strings (s1
, s2
, locale
, FUNC_NAME
);
885 return scm_from_bool (result
< 0);
889 SCM_DEFINE (scm_string_locale_gt
, "string-locale>?", 2, 1, 0,
890 (SCM s1
, SCM s2
, SCM locale
),
891 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
892 "If @var{locale} is provided, it should be locale object (as "
893 "returned by @code{make-locale}) and will be used to perform the "
894 "comparison; otherwise, the current system locale is used.")
895 #define FUNC_NAME s_scm_string_locale_gt
899 SCM_VALIDATE_STRING (1, s1
);
900 SCM_VALIDATE_STRING (2, s2
);
902 result
= compare_u32_strings (s1
, s2
, locale
, FUNC_NAME
);
904 return scm_from_bool (result
> 0);
908 SCM_DEFINE (scm_string_locale_ci_lt
, "string-locale-ci<?", 2, 1, 0,
909 (SCM s1
, SCM s2
, SCM locale
),
910 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
911 "and locale-dependent way. If @var{locale} is provided, it "
912 "should be locale object (as returned by @code{make-locale}) "
913 "and will be used to perform the comparison; otherwise, the "
914 "current system locale is used.")
915 #define FUNC_NAME s_scm_string_locale_ci_lt
919 SCM_VALIDATE_STRING (1, s1
);
920 SCM_VALIDATE_STRING (2, s2
);
922 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
924 return scm_from_bool (result
< 0);
928 SCM_DEFINE (scm_string_locale_ci_gt
, "string-locale-ci>?", 2, 1, 0,
929 (SCM s1
, SCM s2
, SCM locale
),
930 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
931 "and locale-dependent way. If @var{locale} is provided, it "
932 "should be locale object (as returned by @code{make-locale}) "
933 "and will be used to perform the comparison; otherwise, the "
934 "current system locale is used.")
935 #define FUNC_NAME s_scm_string_locale_ci_gt
939 SCM_VALIDATE_STRING (1, s1
);
940 SCM_VALIDATE_STRING (2, s2
);
942 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
944 return scm_from_bool (result
> 0);
948 SCM_DEFINE (scm_string_locale_ci_eq
, "string-locale-ci=?", 2, 1, 0,
949 (SCM s1
, SCM s2
, SCM locale
),
950 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
951 "and locale-dependent way. If @var{locale} is provided, it "
952 "should be locale object (as returned by @code{make-locale}) "
953 "and will be used to perform the comparison; otherwise, the "
954 "current system locale is used.")
955 #define FUNC_NAME s_scm_string_locale_ci_eq
959 SCM_VALIDATE_STRING (1, s1
);
960 SCM_VALIDATE_STRING (2, s2
);
962 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
964 return scm_from_bool (result
== 0);
969 SCM_DEFINE (scm_char_locale_lt
, "char-locale<?", 2, 1, 0,
970 (SCM c1
, SCM c2
, SCM locale
),
971 "Return true if character @var{c1} is lower than @var{c2} "
972 "according to @var{locale} or to the current locale.")
973 #define FUNC_NAME s_scm_char_locale_lt
977 SCM_VALIDATE_CHAR (1, c1
);
978 SCM_VALIDATE_CHAR (2, c2
);
980 result
= compare_u32_strings (scm_string (scm_list_1 (c1
)),
981 scm_string (scm_list_1 (c2
)),
984 return scm_from_bool (result
< 0);
988 SCM_DEFINE (scm_char_locale_gt
, "char-locale>?", 2, 1, 0,
989 (SCM c1
, SCM c2
, SCM locale
),
990 "Return true if character @var{c1} is greater than @var{c2} "
991 "according to @var{locale} or to the current locale.")
992 #define FUNC_NAME s_scm_char_locale_gt
996 SCM_VALIDATE_CHAR (1, c1
);
997 SCM_VALIDATE_CHAR (2, c2
);
999 result
= compare_u32_strings (scm_string (scm_list_1 (c1
)),
1000 scm_string (scm_list_1 (c2
)),
1003 return scm_from_bool (result
> 0);
1007 SCM_DEFINE (scm_char_locale_ci_lt
, "char-locale-ci<?", 2, 1, 0,
1008 (SCM c1
, SCM c2
, SCM locale
),
1009 "Return true if character @var{c1} is lower than @var{c2}, "
1010 "in a case insensitive way according to @var{locale} or to "
1011 "the current locale.")
1012 #define FUNC_NAME s_scm_char_locale_ci_lt
1016 SCM_VALIDATE_CHAR (1, c1
);
1017 SCM_VALIDATE_CHAR (2, c2
);
1019 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1020 scm_string (scm_list_1 (c2
)),
1023 return scm_from_bool (result
< 0);
1027 SCM_DEFINE (scm_char_locale_ci_gt
, "char-locale-ci>?", 2, 1, 0,
1028 (SCM c1
, SCM c2
, SCM locale
),
1029 "Return true if character @var{c1} is greater than @var{c2}, "
1030 "in a case insensitive way according to @var{locale} or to "
1031 "the current locale.")
1032 #define FUNC_NAME s_scm_char_locale_ci_gt
1036 SCM_VALIDATE_CHAR (1, c1
);
1037 SCM_VALIDATE_CHAR (2, c2
);
1039 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1040 scm_string (scm_list_1 (c2
)),
1043 return scm_from_bool (result
> 0);
1047 SCM_DEFINE (scm_char_locale_ci_eq
, "char-locale-ci=?", 2, 1, 0,
1048 (SCM c1
, SCM c2
, SCM locale
),
1049 "Return true if character @var{c1} is equal to @var{c2}, "
1050 "in a case insensitive way according to @var{locale} or to "
1051 "the current locale.")
1052 #define FUNC_NAME s_scm_char_locale_ci_eq
1056 SCM_VALIDATE_CHAR (1, c1
);
1057 SCM_VALIDATE_CHAR (2, c2
);
1059 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1060 scm_string (scm_list_1 (c2
)),
1063 return scm_from_bool (result
== 0);
1069 /* Locale-dependent alphabetic character mapping. */
1072 u32_locale_tocase (const scm_t_uint32
*c_s1
, size_t len
,
1073 scm_t_uint32
**p_c_s2
, size_t * p_len2
,
1074 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t,
1075 const char *, uninorm_t
,
1076 scm_t_uint32
*, size_t *))
1078 /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must not
1079 make any non-local exit. */
1082 const char *loc
= locale_language ();
1084 /* The first NULL here indicates that no NFC or NFKC normalization
1085 is done. The second NULL means the return buffer is
1087 ret
= func (c_s1
, len
, loc
, NULL
, NULL
, p_len2
);
1091 *p_c_s2
= (scm_t_uint32
*) NULL
;
1102 chr_to_case (SCM chr
, scm_t_locale c_locale
,
1103 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t, const char *,
1104 uninorm_t
, scm_t_uint32
*, size_t *),
1105 const char *func_name
,
1107 #define FUNC_NAME func_name
1111 scm_t_uint32
*convbuf
;
1117 if (c_locale
!= NULL
)
1118 RUN_IN_LOCALE_SECTION (c_locale
, ret
=
1119 u32_locale_tocase (&c
, 1, &convbuf
, &convlen
, func
));
1122 u32_locale_tocase (&c
, 1, &convbuf
, &convlen
, func
);
1124 if (SCM_UNLIKELY (ret
!= 0))
1131 convchar
= SCM_MAKE_CHAR ((scm_t_wchar
) convbuf
[0]);
1140 SCM_DEFINE (scm_char_locale_downcase
, "char-locale-downcase", 1, 1, 0,
1141 (SCM chr
, SCM locale
),
1142 "Return the lowercase character that corresponds to @var{chr} "
1143 "according to either @var{locale} or the current locale.")
1144 #define FUNC_NAME s_scm_char_locale_downcase
1146 scm_t_locale c_locale
;
1150 SCM_VALIDATE_CHAR (1, chr
);
1151 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1153 ret
= chr_to_case (chr
, c_locale
, u32_tolower
, FUNC_NAME
, &err
);
1158 scm_syserror (FUNC_NAME
);
1164 SCM_DEFINE (scm_char_locale_upcase
, "char-locale-upcase", 1, 1, 0,
1165 (SCM chr
, SCM locale
),
1166 "Return the uppercase character that corresponds to @var{chr} "
1167 "according to either @var{locale} or the current locale.")
1168 #define FUNC_NAME s_scm_char_locale_upcase
1170 scm_t_locale c_locale
;
1174 SCM_VALIDATE_CHAR (1, chr
);
1175 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1177 ret
= chr_to_case (chr
, c_locale
, u32_toupper
, FUNC_NAME
, &err
);
1182 scm_syserror (FUNC_NAME
);
1188 SCM_DEFINE (scm_char_locale_titlecase
, "char-locale-titlecase", 1, 1, 0,
1189 (SCM chr
, SCM locale
),
1190 "Return the titlecase character that corresponds to @var{chr} "
1191 "according to either @var{locale} or the current locale.")
1192 #define FUNC_NAME s_scm_char_locale_titlecase
1194 scm_t_locale c_locale
;
1198 SCM_VALIDATE_CHAR (1, chr
);
1199 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1201 ret
= chr_to_case (chr
, c_locale
, u32_totitle
, FUNC_NAME
, &err
);
1206 scm_syserror (FUNC_NAME
);
1213 str_to_case (SCM str
, scm_t_locale c_locale
,
1214 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t, const char *,
1215 uninorm_t
, scm_t_uint32
*, size_t *),
1216 const char *func_name
,
1218 #define FUNC_NAME func_name
1220 scm_t_wchar
*c_str
, *c_buf
;
1221 scm_t_uint32
*c_convstr
;
1222 size_t len
, convlen
;
1226 len
= scm_i_string_length (str
);
1229 SCM_STRING_TO_U32_BUF (str
, c_str
);
1232 RUN_IN_LOCALE_SECTION (c_locale
, ret
=
1233 u32_locale_tocase ((scm_t_uint32
*) c_str
, len
,
1238 u32_locale_tocase ((scm_t_uint32
*) c_str
, len
,
1239 &c_convstr
, &convlen
, func
);
1241 scm_remember_upto_here (str
);
1243 if (SCM_UNLIKELY (ret
!= 0))
1249 convstr
= scm_i_make_wide_string (convlen
, &c_buf
, 0);
1250 memcpy (c_buf
, c_convstr
, convlen
* sizeof (scm_t_wchar
));
1253 scm_i_try_narrow_string (convstr
);
1259 SCM_DEFINE (scm_string_locale_upcase
, "string-locale-upcase", 1, 1, 0,
1260 (SCM str
, SCM locale
),
1261 "Return a new string that is the uppercase version of "
1262 "@var{str} according to either @var{locale} or the current "
1264 #define FUNC_NAME s_scm_string_locale_upcase
1266 scm_t_locale c_locale
;
1270 SCM_VALIDATE_STRING (1, str
);
1271 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1273 ret
= str_to_case (str
, c_locale
, u32_toupper
, FUNC_NAME
, &err
);
1278 scm_syserror (FUNC_NAME
);
1284 SCM_DEFINE (scm_string_locale_downcase
, "string-locale-downcase", 1, 1, 0,
1285 (SCM str
, SCM locale
),
1286 "Return a new string that is the down-case version of "
1287 "@var{str} according to either @var{locale} or the current "
1289 #define FUNC_NAME s_scm_string_locale_downcase
1291 scm_t_locale c_locale
;
1295 SCM_VALIDATE_STRING (1, str
);
1296 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1298 ret
= str_to_case (str
, c_locale
, u32_tolower
, FUNC_NAME
, &err
);
1303 scm_syserror (FUNC_NAME
);
1309 SCM_DEFINE (scm_string_locale_titlecase
, "string-locale-titlecase", 1, 1, 0,
1310 (SCM str
, SCM locale
),
1311 "Return a new string that is the title-case version of "
1312 "@var{str} according to either @var{locale} or the current "
1314 #define FUNC_NAME s_scm_string_locale_titlecase
1316 scm_t_locale c_locale
;
1320 SCM_VALIDATE_STRING (1, str
);
1321 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1323 ret
= str_to_case (str
, c_locale
, u32_totitle
, FUNC_NAME
, &err
);
1328 scm_syserror (FUNC_NAME
);
1334 /* Note: We don't provide mutative versions of `string-locale-(up|down)case'
1335 because, in some languages, a single downcase character maps to a couple
1336 of uppercase characters. Read the SRFI-13 document for a detailed
1337 discussion about this. */
1341 /* Locale-dependent number parsing. */
1343 SCM_DEFINE (scm_locale_string_to_integer
, "locale-string->integer",
1344 1, 2, 0, (SCM str
, SCM base
, SCM locale
),
1345 "Convert string @var{str} into an integer according to either "
1346 "@var{locale} (a locale object as returned by @code{make-locale}) "
1347 "or the current process locale. Return two values: an integer "
1348 "(on success) or @code{#f}, and the number of characters read "
1349 "from @var{str} (@code{0} on failure).")
1350 #define FUNC_NAME s_scm_locale_string_to_integer
1357 scm_t_locale c_locale
;
1359 SCM_VALIDATE_STRING (1, str
);
1360 c_str
= scm_i_string_chars (str
);
1362 if (base
!= SCM_UNDEFINED
)
1363 SCM_VALIDATE_INT_COPY (2, base
, c_base
);
1367 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
1369 if (c_locale
!= NULL
)
1371 #ifdef USE_GNU_LOCALE_API
1372 c_result
= strtol_l (c_str
, &c_endptr
, c_base
, c_locale
);
1374 RUN_IN_LOCALE_SECTION (c_locale
,
1375 c_result
= strtol (c_str
, &c_endptr
, c_base
));
1379 c_result
= strtol (c_str
, &c_endptr
, c_base
);
1381 scm_remember_upto_here (str
);
1383 if (c_endptr
== c_str
)
1384 result
= SCM_BOOL_F
;
1386 result
= scm_from_long (c_result
);
1388 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1392 SCM_DEFINE (scm_locale_string_to_inexact
, "locale-string->inexact",
1393 1, 1, 0, (SCM str
, SCM locale
),
1394 "Convert string @var{str} into an inexact number according to "
1395 "either @var{locale} (a locale object as returned by "
1396 "@code{make-locale}) or the current process locale. Return "
1397 "two values: an inexact number (on success) or @code{#f}, and "
1398 "the number of characters read from @var{str} (@code{0} on "
1400 #define FUNC_NAME s_scm_locale_string_to_inexact
1406 scm_t_locale c_locale
;
1408 SCM_VALIDATE_STRING (1, str
);
1409 c_str
= scm_i_string_chars (str
);
1411 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1413 if (c_locale
!= NULL
)
1415 #ifdef USE_GNU_LOCALE_API
1416 c_result
= strtod_l (c_str
, &c_endptr
, c_locale
);
1418 RUN_IN_LOCALE_SECTION (c_locale
,
1419 c_result
= strtod (c_str
, &c_endptr
));
1423 c_result
= strtod (c_str
, &c_endptr
);
1425 scm_remember_upto_here (str
);
1427 if (c_endptr
== c_str
)
1428 result
= SCM_BOOL_F
;
1430 result
= scm_from_double (c_result
);
1432 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1437 /* Language information, aka. `nl_langinfo ()'. */
1439 /* FIXME: Issues related to `nl-langinfo'.
1441 1. The `CODESET' value is not normalized. This is a secondary issue, but
1442 still a practical issue. See
1443 http://www.cl.cam.ac.uk/~mgk25/ucs/norm_charmap.c for codeset
1446 2. `nl_langinfo ()' is not available on Windows.
1448 3. `nl_langinfo ()' may return strings encoded in a locale different from
1452 (nl-langinfo DAY_1 (make-locale LC_ALL "eo_EO.UTF-8"))
1454 returns a result that is a UTF-8 string, regardless of the
1455 setting of the current locale. If nl_langinfo supports CODESET,
1456 we can convert the string properly using scm_from_stringn. If
1457 CODESET is not supported, we won't be able to make much sense of
1458 the returned string.
1460 Note: We don't use Gnulib's `nl_langinfo' module because it's currently not
1461 as complete as the compatibility hacks in `i18n.scm'. */
1464 SCM_DEFINE (scm_nl_langinfo
, "nl-langinfo", 1, 1, 0,
1465 (SCM item
, SCM locale
),
1466 "Return a string denoting locale information for @var{item} "
1467 "in the current locale or that specified by @var{locale}. "
1468 "The semantics and arguments are the same as those of the "
1469 "X/Open @code{nl_langinfo} function (@pxref{The Elegant and "
1470 "Fast Way, @code{nl_langinfo},, libc, The GNU C Library "
1471 "Reference Manual}).")
1472 #define FUNC_NAME s_scm_nl_langinfo
1474 #ifdef HAVE_NL_LANGINFO
1478 scm_t_locale c_locale
;
1479 #ifdef HAVE_LANGINFO_CODESET
1483 SCM_VALIDATE_INT_COPY (2, item
, c_item
);
1484 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1486 /* Sadly, `nl_langinfo ()' returns a pointer to a static string. According
1487 to SuS v2, that static string may be modified by subsequent calls to
1488 `nl_langinfo ()' as well as by calls to `setlocale ()'. Thus, we must
1489 acquire the locale mutex before doing invoking `nl_langinfo ()'. See
1490 http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for
1493 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
1494 if (c_locale
!= NULL
)
1496 #ifdef USE_GNU_LOCALE_API
1497 c_result
= nl_langinfo_l (c_item
, c_locale
);
1498 #ifdef HAVE_LANGINFO_CODESET
1499 codeset
= nl_langinfo_l (CODESET
, c_locale
);
1500 #endif /* HAVE_LANGINFO_CODESET */
1501 #else /* !USE_GNU_LOCALE_API */
1502 /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
1503 mutex is already taken. */
1505 scm_t_locale_settings lsec_prev_locale
;
1507 lsec_err
= get_current_locale_settings (&lsec_prev_locale
);
1509 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1512 lsec_err
= install_locale (c_locale
);
1515 leave_locale_section (&lsec_prev_locale
);
1516 free_locale_settings (&lsec_prev_locale
);
1521 scm_locale_error (FUNC_NAME
, lsec_err
);
1524 c_result
= nl_langinfo (c_item
);
1525 #ifdef HAVE_LANGINFO_CODESET
1526 codeset
= nl_langinfo (CODESET
);
1527 #endif /* HAVE_LANGINFO_CODESET */
1529 restore_locale_settings (&lsec_prev_locale
);
1530 free_locale_settings (&lsec_prev_locale
);
1536 c_result
= nl_langinfo (c_item
);
1537 #ifdef HAVE_LANGINFO_CODESET
1538 codeset
= nl_langinfo (CODESET
);
1539 #endif /* HAVE_LANGINFO_CODESET */
1542 c_result
= strdup (c_result
);
1543 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1545 if (c_result
== NULL
)
1546 result
= SCM_BOOL_F
;
1551 #if (defined GROUPING) && (defined MON_GROUPING)
1557 /* In this cases, the result is to be interpreted as a list
1558 of numbers. If the last item is `CHAR_MAX' or a negative
1559 number, it has the special meaning "no more grouping"
1560 (negative numbers aren't specified in POSIX but can be
1562 <http://lists.gnu.org/archive/html/bug-guile/2011-02/msg00159.html>). */
1564 for (p
= c_result
; (*p
> 0) && (*p
!= CHAR_MAX
); p
++)
1565 result
= scm_cons (SCM_I_MAKINUM ((int) *p
), result
);
1568 SCM last_pair
= result
;
1570 result
= scm_reverse_x (result
, SCM_EOL
);
1574 /* Cyclic grouping information. */
1575 if (last_pair
!= SCM_EOL
)
1576 SCM_SETCDR (last_pair
, result
);
1585 #if (defined FRAC_DIGITS) && (defined INT_FRAC_DIGITS)
1587 case INT_FRAC_DIGITS
:
1588 /* This is to be interpreted as a single integer. */
1589 if (*c_result
== CHAR_MAX
)
1591 result
= SCM_BOOL_F
;
1593 result
= SCM_I_MAKINUM (*c_result
);
1599 #if (defined P_CS_PRECEDES) && (defined INT_N_CS_PRECEDES)
1602 case INT_P_CS_PRECEDES
:
1603 case INT_N_CS_PRECEDES
:
1604 #if (defined P_SEP_BY_SPACE) && (defined N_SEP_BY_SPACE)
1605 case P_SEP_BY_SPACE
:
1606 case N_SEP_BY_SPACE
:
1608 /* This is to be interpreted as a boolean. */
1609 result
= scm_from_bool (*c_result
);
1615 #if (defined P_SIGN_POSN) && (defined INT_N_SIGN_POSN)
1618 case INT_P_SIGN_POSN
:
1619 case INT_N_SIGN_POSN
:
1620 /* See `(libc) Sign of Money Amount' for the interpretation of the
1621 return value here. */
1625 result
= scm_from_latin1_symbol ("parenthesize");
1629 result
= scm_from_latin1_symbol ("sign-before");
1633 result
= scm_from_latin1_symbol ("sign-after");
1637 result
= scm_from_latin1_symbol ("sign-before-currency-symbol");
1641 result
= scm_from_latin1_symbol ("sign-after-currency-symbol");
1645 result
= scm_from_latin1_symbol ("unspecified");
1651 #ifdef HAVE_LANGINFO_CODESET
1652 result
= scm_from_stringn (c_result
, strlen (c_result
),
1654 SCM_FAILED_CONVERSION_QUESTION_MARK
);
1655 #else /* !HAVE_LANGINFO_CODESET */
1656 /* This may be incorrectly encoded if the locale differs
1657 from the c_locale. */
1658 result
= scm_from_locale_string (c_result
);
1659 #endif /* !HAVE_LANGINFO_CODESET */
1666 scm_syserror_msg (FUNC_NAME
, "`nl-langinfo' not supported on your system",
1674 /* Define the `nl_item' constants. */
1676 define_langinfo_items (void)
1678 #ifdef HAVE_LANGINFO_H
1680 #define DEFINE_NLITEM_CONSTANT(_item) \
1681 scm_c_define (# _item, scm_from_int (_item))
1683 DEFINE_NLITEM_CONSTANT (CODESET
);
1685 /* Abbreviated days of the week. */
1686 DEFINE_NLITEM_CONSTANT (ABDAY_1
);
1687 DEFINE_NLITEM_CONSTANT (ABDAY_2
);
1688 DEFINE_NLITEM_CONSTANT (ABDAY_3
);
1689 DEFINE_NLITEM_CONSTANT (ABDAY_4
);
1690 DEFINE_NLITEM_CONSTANT (ABDAY_5
);
1691 DEFINE_NLITEM_CONSTANT (ABDAY_6
);
1692 DEFINE_NLITEM_CONSTANT (ABDAY_7
);
1694 /* Long-named days of the week. */
1695 DEFINE_NLITEM_CONSTANT (DAY_1
); /* Sunday */
1696 DEFINE_NLITEM_CONSTANT (DAY_2
); /* Monday */
1697 DEFINE_NLITEM_CONSTANT (DAY_3
); /* Tuesday */
1698 DEFINE_NLITEM_CONSTANT (DAY_4
); /* Wednesday */
1699 DEFINE_NLITEM_CONSTANT (DAY_5
); /* Thursday */
1700 DEFINE_NLITEM_CONSTANT (DAY_6
); /* Friday */
1701 DEFINE_NLITEM_CONSTANT (DAY_7
); /* Saturday */
1703 /* Abbreviated month names. */
1704 DEFINE_NLITEM_CONSTANT (ABMON_1
); /* Jan */
1705 DEFINE_NLITEM_CONSTANT (ABMON_2
);
1706 DEFINE_NLITEM_CONSTANT (ABMON_3
);
1707 DEFINE_NLITEM_CONSTANT (ABMON_4
);
1708 DEFINE_NLITEM_CONSTANT (ABMON_5
);
1709 DEFINE_NLITEM_CONSTANT (ABMON_6
);
1710 DEFINE_NLITEM_CONSTANT (ABMON_7
);
1711 DEFINE_NLITEM_CONSTANT (ABMON_8
);
1712 DEFINE_NLITEM_CONSTANT (ABMON_9
);
1713 DEFINE_NLITEM_CONSTANT (ABMON_10
);
1714 DEFINE_NLITEM_CONSTANT (ABMON_11
);
1715 DEFINE_NLITEM_CONSTANT (ABMON_12
);
1717 /* Long month names. */
1718 DEFINE_NLITEM_CONSTANT (MON_1
); /* January */
1719 DEFINE_NLITEM_CONSTANT (MON_2
);
1720 DEFINE_NLITEM_CONSTANT (MON_3
);
1721 DEFINE_NLITEM_CONSTANT (MON_4
);
1722 DEFINE_NLITEM_CONSTANT (MON_5
);
1723 DEFINE_NLITEM_CONSTANT (MON_6
);
1724 DEFINE_NLITEM_CONSTANT (MON_7
);
1725 DEFINE_NLITEM_CONSTANT (MON_8
);
1726 DEFINE_NLITEM_CONSTANT (MON_9
);
1727 DEFINE_NLITEM_CONSTANT (MON_10
);
1728 DEFINE_NLITEM_CONSTANT (MON_11
);
1729 DEFINE_NLITEM_CONSTANT (MON_12
);
1731 DEFINE_NLITEM_CONSTANT (AM_STR
); /* Ante meridiem string. */
1732 DEFINE_NLITEM_CONSTANT (PM_STR
); /* Post meridiem string. */
1734 DEFINE_NLITEM_CONSTANT (D_T_FMT
); /* Date and time format for strftime. */
1735 DEFINE_NLITEM_CONSTANT (D_FMT
); /* Date format for strftime. */
1736 DEFINE_NLITEM_CONSTANT (T_FMT
); /* Time format for strftime. */
1737 DEFINE_NLITEM_CONSTANT (T_FMT_AMPM
);/* 12-hour time format for strftime. */
1739 DEFINE_NLITEM_CONSTANT (ERA
); /* Alternate era. */
1740 DEFINE_NLITEM_CONSTANT (ERA_D_FMT
); /* Date in alternate era format. */
1741 DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT
); /* Date and time in alternate era
1743 DEFINE_NLITEM_CONSTANT (ERA_T_FMT
); /* Time in alternate era format. */
1745 DEFINE_NLITEM_CONSTANT (ALT_DIGITS
); /* Alternate symbols for digits. */
1746 DEFINE_NLITEM_CONSTANT (RADIXCHAR
);
1747 DEFINE_NLITEM_CONSTANT (THOUSEP
);
1750 DEFINE_NLITEM_CONSTANT (YESEXPR
);
1753 DEFINE_NLITEM_CONSTANT (NOEXPR
);
1756 #ifdef CRNCYSTR /* currency symbol */
1757 DEFINE_NLITEM_CONSTANT (CRNCYSTR
);
1760 /* GNU extensions. */
1763 DEFINE_NLITEM_CONSTANT (ERA_YEAR
); /* Year in alternate era format. */
1766 /* LC_MONETARY category: formatting of monetary quantities.
1767 These items each correspond to a member of `struct lconv',
1768 defined in <locale.h>. */
1769 #ifdef INT_CURR_SYMBOL
1770 DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL
);
1772 #ifdef MON_DECIMAL_POINT
1773 DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT
);
1775 #ifdef MON_THOUSANDS_SEP
1776 DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP
);
1779 DEFINE_NLITEM_CONSTANT (MON_GROUPING
);
1781 #ifdef POSITIVE_SIGN
1782 DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN
);
1784 #ifdef NEGATIVE_SIGN
1785 DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN
);
1788 DEFINE_NLITEM_CONSTANT (GROUPING
);
1790 #ifdef INT_FRAC_DIGITS
1791 DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS
);
1794 DEFINE_NLITEM_CONSTANT (FRAC_DIGITS
);
1796 #ifdef P_CS_PRECEDES
1797 DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES
);
1799 #ifdef P_SEP_BY_SPACE
1800 DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE
);
1802 #ifdef N_CS_PRECEDES
1803 DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES
);
1805 #ifdef N_SEP_BY_SPACE
1806 DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE
);
1809 DEFINE_NLITEM_CONSTANT (P_SIGN_POSN
);
1812 DEFINE_NLITEM_CONSTANT (N_SIGN_POSN
);
1814 #ifdef INT_P_CS_PRECEDES
1815 DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES
);
1817 #ifdef INT_P_SEP_BY_SPACE
1818 DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE
);
1820 #ifdef INT_N_CS_PRECEDES
1821 DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES
);
1823 #ifdef INT_N_SEP_BY_SPACE
1824 DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE
);
1826 #ifdef INT_P_SIGN_POSN
1827 DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN
);
1829 #ifdef INT_N_SIGN_POSN
1830 DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN
);
1833 #undef DEFINE_NLITEM_CONSTANT
1835 #endif /* HAVE_NL_TYPES_H */
1842 SCM global_locale_smob
;
1844 #ifdef HAVE_NL_LANGINFO
1845 scm_add_feature ("nl-langinfo");
1846 define_langinfo_items ();
1849 #include "libguile/i18n.x"
1851 /* Initialize the global locale object with a special `locale' SMOB. */
1852 /* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
1853 glibc <= 2.11 not (yet) worked around by Gnulib. See
1854 http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details. */
1855 SCM_NEWSMOB (global_locale_smob
, scm_tc16_locale_smob_type
, NULL
);
1856 SCM_VARIABLE_SET (scm_global_locale
, global_locale_smob
);
1860 scm_bootstrap_i18n ()
1862 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
1864 (scm_t_extension_init_func
) scm_init_i18n
,