1 /* Copyright (C) 2006, 2007, 2008, 2009 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 #if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H)
64 #include "libguile/posix.h" /* for `scm_i_locale_mutex' */
66 #if (defined HAVE_LANGINFO_H) && (defined HAVE_NL_TYPES_H)
67 # include <langinfo.h>
68 # include <nl_types.h>
71 #ifndef HAVE_SETLOCALE
73 setlocale (int category
, const char *name
)
80 /* Helper stringification macro. */
81 #define SCM_I18N_STRINGIFY(_name) # _name
85 /* Locale objects, string and character collation, and other locale-dependent
88 A large part of the code here deals with emulating glibc's reentrant
89 locale API on non-GNU systems. The emulation is a bit "brute-force":
90 Whenever a `-locale<?' procedure is passed a locale object, then:
92 1. The `scm_i_locale_mutex' is locked.
93 2. A series of `setlocale ()' call is performed to store the current
94 locale for each category in an `scm_t_locale' object.
95 3. A series of `setlocale ()' call is made to install each of the locale
96 categories of each of the base locales of each locale object,
97 recursively, starting from the last locale object of the chain.
98 4. The settings captured in step (2) are restored.
99 5. The `scm_i_locale_mutex' is released.
101 Hopefully, the X/Open standard will eventually make this hack useless.
103 Note: We don't wrap glibc's `uselocale ()' call because it sets the locale
104 of the current _thread_ (unlike `setlocale ()') and doing so would require
105 maintaining per-thread locale information on non-GNU systems and always
106 re-installing this locale upon locale-dependent calls. */
109 /* Return the category mask corresponding to CAT. */
110 #define SCM_LOCALE_CATEGORY_MASK(_cat) LC_ ## _cat ## _MASK
113 #ifndef USE_GNU_LOCALE_API
115 /* Provide the locale category masks as found in glibc. This must be kept in
116 sync with `locale-categories.h'. */
118 # define LC_CTYPE_MASK 1
119 # define LC_COLLATE_MASK 2
120 # define LC_MESSAGES_MASK 4
121 # define LC_MONETARY_MASK 8
122 # define LC_NUMERIC_MASK 16
123 # define LC_TIME_MASK 32
126 # define LC_PAPER_MASK 64
128 # define LC_PAPER_MASK 0
131 # define LC_NAME_MASK 128
133 # define LC_NAME_MASK 0
136 # define LC_ADDRESS_MASK 256
138 # define LC_ADDRESS_MASK 0
141 # define LC_TELEPHONE_MASK 512
143 # define LC_TELEPHONE_MASK 0
145 # ifdef LC_MEASUREMENT
146 # define LC_MEASUREMENT_MASK 1024
148 # define LC_MEASUREMENT_MASK 0
150 # ifdef LC_IDENTIFICATION
151 # define LC_IDENTIFICATION_MASK 2048
153 # define LC_IDENTIFICATION_MASK 0
156 # define LC_ALL_MASK (LC_CTYPE_MASK \
165 | LC_TELEPHONE_MASK \
166 | LC_MEASUREMENT_MASK \
167 | LC_IDENTIFICATION_MASK \
170 /* Locale objects as returned by `make-locale' on non-GNU systems. */
171 typedef struct scm_locale
173 SCM base_locale
; /* a `locale' object */
179 /* Free the resources used by LOCALE. */
181 scm_i_locale_free (scm_t_locale locale
)
183 free (locale
->locale_name
);
184 locale
->locale_name
= NULL
;
187 #else /* USE_GNU_LOCALE_API */
189 /* Alias for glibc's locale type. */
190 typedef locale_t scm_t_locale
;
192 #define scm_i_locale_free freelocale
194 #endif /* USE_GNU_LOCALE_API */
197 /* A locale object denoting the global locale. */
198 SCM_GLOBAL_VARIABLE (scm_global_locale
, "%global-locale");
201 /* Validate parameter ARG as a locale object and set C_LOCALE to the
202 corresponding C locale object. */
203 #define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale) \
206 SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type); \
207 (_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg); \
211 /* Validate optional parameter ARG as either undefined or bound to a locale
212 object. Set C_LOCALE to the corresponding C locale object or NULL. */
213 #define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \
216 if ((_arg) != SCM_UNDEFINED) \
217 SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \
219 (_c_locale) = NULL; \
224 SCM_SMOB (scm_tc16_locale_smob_type
, "locale", 0);
226 SCM_SMOB_FREE (scm_tc16_locale_smob_type
, smob_locale_free
, locale
)
228 scm_t_locale c_locale
;
230 c_locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
);
231 scm_i_locale_free (c_locale
);
237 static void inline scm_locale_error (const char *, int) SCM_NORETURN
;
239 /* Throw an exception corresponding to error ERR. */
241 scm_locale_error (const char *func_name
, int err
)
243 scm_syserror_msg (func_name
,
244 "Failed to install locale",
250 /* Emulating GNU's reentrant locale API. */
251 #ifndef USE_GNU_LOCALE_API
254 /* Maximum number of chained locales (via `base_locale'). */
255 #define LOCALE_STACK_SIZE_MAX 256
259 #define SCM_DEFINE_LOCALE_CATEGORY(_name) char * _name;
260 #include "locale-categories.h"
261 #undef SCM_DEFINE_LOCALE_CATEGORY
262 } scm_t_locale_settings
;
264 /* Fill out SETTINGS according to the current locale settings. On success
265 zero is returned and SETTINGS is properly initialized. */
267 get_current_locale_settings (scm_t_locale_settings
*settings
)
269 const char *locale_name
;
271 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
273 SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \
274 if (locale_name == NULL) \
277 settings-> _name = strdup (locale_name); \
278 if (settings-> _name == NULL) \
282 #include "locale-categories.h"
283 #undef SCM_DEFINE_LOCALE_CATEGORY
294 /* Restore locale settings SETTINGS. On success, return zero. */
296 restore_locale_settings (const scm_t_locale_settings
*settings
)
300 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
301 SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name)); \
302 if (result == NULL) \
305 #include "locale-categories.h"
306 #undef SCM_DEFINE_LOCALE_CATEGORY
314 /* Free memory associated with SETTINGS. */
316 free_locale_settings (scm_t_locale_settings
*settings
)
318 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
319 free (settings-> _name); \
320 settings->_name = NULL;
321 #include "locale-categories.h"
322 #undef SCM_DEFINE_LOCALE_CATEGORY
325 /* Install the locale named LOCALE_NAME for all the categories listed in
328 install_locale_categories (const char *locale_name
, int category_mask
)
332 if (category_mask
== LC_ALL_MASK
)
334 SCM_SYSCALL (result
= setlocale (LC_ALL
, locale_name
));
340 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
341 if (category_mask & SCM_LOCALE_CATEGORY_MASK (_name)) \
343 SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \
344 if (result == NULL) \
347 #include "locale-categories.h"
348 #undef SCM_DEFINE_LOCALE_CATEGORY
357 /* Install LOCALE, recursively installing its base locales first. On
358 success, zero is returned. */
360 install_locale (scm_t_locale locale
)
362 scm_t_locale stack
[LOCALE_STACK_SIZE_MAX
];
363 int category_mask
= 0;
364 size_t stack_size
= 0;
365 int stack_offset
= 0;
366 const char *result
= NULL
;
368 /* Build up a locale stack by traversing the `base_locale' link. */
371 if (stack_size
>= LOCALE_STACK_SIZE_MAX
)
372 /* We cannot use `scm_error ()' here because otherwise the locale
373 mutex may remain locked. */
376 stack
[stack_size
++] = locale
;
378 /* Keep track of which categories have already been taken into
380 category_mask
|= locale
->category_mask
;
382 if (locale
->base_locale
!= SCM_UNDEFINED
)
383 locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
->base_locale
);
387 while ((locale
!= NULL
) && (category_mask
!= LC_ALL_MASK
));
389 /* Install the C locale to start from a pristine state. */
390 SCM_SYSCALL (result
= setlocale (LC_ALL
, "C"));
394 /* Install the locales in reverse order. */
395 for (stack_offset
= stack_size
- 1;
402 locale
= stack
[stack_offset
];
403 err
= install_locale_categories (locale
->locale_name
,
404 locale
->category_mask
);
415 /* Leave the locked locale section. */
417 leave_locale_section (const scm_t_locale_settings
*settings
)
419 /* Restore the previous locale settings. */
420 (void)restore_locale_settings (settings
);
422 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
425 /* Enter a locked locale section. */
427 enter_locale_section (scm_t_locale locale
,
428 scm_t_locale_settings
*prev_locale
)
432 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
434 err
= get_current_locale_settings (prev_locale
);
437 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
441 err
= install_locale (locale
);
444 leave_locale_section (prev_locale
);
445 free_locale_settings (prev_locale
);
451 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
452 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
456 scm_t_locale_settings lsec_prev_locale; \
458 lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale); \
460 scm_locale_error (FUNC_NAME, lsec_err); \
465 leave_locale_section (&lsec_prev_locale); \
466 free_locale_settings (&lsec_prev_locale); \
471 /* Convert the current locale settings into a locale SMOB. On success, zero
472 is returned and RESULT points to the new SMOB. Otherwise, an error is
475 get_current_locale (SCM
*result
)
478 scm_t_locale c_locale
;
479 const char *current_locale
;
481 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
484 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
486 c_locale
->category_mask
= LC_ALL_MASK
;
487 c_locale
->base_locale
= SCM_UNDEFINED
;
489 current_locale
= setlocale (LC_ALL
, NULL
);
490 if (current_locale
!= NULL
)
492 c_locale
->locale_name
= strdup (current_locale
);
493 if (c_locale
->locale_name
== NULL
)
499 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
502 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
504 SCM_NEWSMOB (*result
, scm_tc16_locale_smob_type
, c_locale
);
509 #else /* USE_GNU_LOCALE_API */
511 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
512 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
515 scm_t_locale old_loc; \
517 old_loc = uselocale (_c_locale); \
519 uselocale (old_loc); \
524 #endif /* USE_GNU_LOCALE_API */
528 /* `make-locale' can take either category lists or single categories (the
529 `LC_*' integer constants). */
530 #define SCM_LIST_OR_INTEGER_P(arg) \
531 (scm_is_integer (arg) || scm_is_true (scm_list_p (arg)))
534 /* Return the category mask corresponding to CATEGORY (an `LC_' integer
537 category_to_category_mask (SCM category
,
538 const char *func_name
, int pos
)
543 c_category
= scm_to_int (category
);
545 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
547 c_category_mask = SCM_LOCALE_CATEGORY_MASK (_name); \
552 #include "locale-categories.h"
555 c_category_mask
= LC_ALL_MASK
;
559 scm_wrong_type_arg_msg (func_name
, pos
, category
,
563 #undef SCM_DEFINE_LOCALE_CATEGORY
565 return c_category_mask
;
568 /* Convert CATEGORIES, a list of locale categories or a single category (an
569 integer), into a category mask. */
571 category_list_to_category_mask (SCM categories
,
572 const char *func_name
, int pos
)
574 int c_category_mask
= 0;
576 if (scm_is_integer (categories
))
577 c_category_mask
= category_to_category_mask (categories
,
580 for (; !scm_is_null (categories
); categories
= SCM_CDR (categories
))
582 SCM category
= SCM_CAR (categories
);
585 category_to_category_mask (category
, func_name
, pos
);
588 return c_category_mask
;
592 SCM_DEFINE (scm_make_locale
, "make-locale", 2, 1, 0,
593 (SCM category_list
, SCM locale_name
, SCM base_locale
),
594 "Return a reference to a data structure representing a set of "
595 "locale datasets. @var{category_list} should be either a list "
596 "of locale categories or a single category as used with "
597 "@code{setlocale} (@pxref{Locales, @code{setlocale}}) and "
598 "@var{locale_name} should be the name of the locale considered "
599 "(e.g., @code{\"sl_SI\"}). Optionally, if @code{base_locale} is "
600 "passed, it should be a locale object denoting settings for "
601 "categories not listed in @var{category_list}.")
602 #define FUNC_NAME s_scm_make_locale
604 SCM locale
= SCM_BOOL_F
;
608 scm_t_locale c_base_locale
, c_locale
;
610 SCM_MAKE_VALIDATE (1, category_list
, LIST_OR_INTEGER_P
);
611 SCM_VALIDATE_STRING (2, locale_name
);
612 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, base_locale
, c_base_locale
);
614 c_category_mask
= category_list_to_category_mask (category_list
,
616 c_locale_name
= scm_to_locale_string (locale_name
);
618 #ifdef USE_GNU_LOCALE_API
620 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
622 /* Fetch the current locale and turn in into a `locale_t'. Don't
623 duplicate the resulting `locale_t' because we want it to be consumed
624 by `newlocale ()'. */
625 char *current_locale
;
627 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
629 current_locale
= setlocale (LC_ALL
, NULL
);
630 c_base_locale
= newlocale (LC_ALL_MASK
, current_locale
, NULL
);
632 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
634 if (c_base_locale
== (locale_t
) 0)
635 scm_locale_error (FUNC_NAME
, errno
);
637 else if (c_base_locale
!= (locale_t
) 0)
639 /* C_BASE_LOCALE is to be consumed by `newlocale ()' so it needs to be
640 duplicated before. */
641 c_base_locale
= duplocale (c_base_locale
);
642 if (c_base_locale
== (locale_t
) 0)
649 c_locale
= newlocale (c_category_mask
, c_locale_name
, c_base_locale
);
651 free (c_locale_name
);
653 if (c_locale
== (locale_t
) 0)
655 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
656 /* The base locale object was created lazily and must be freed. */
657 freelocale (c_base_locale
);
659 scm_locale_error (FUNC_NAME
, errno
);
662 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
666 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
668 c_locale
->category_mask
= c_category_mask
;
669 c_locale
->locale_name
= c_locale_name
;
671 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
673 /* Get the current locale settings and turn them into a locale
675 err
= get_current_locale (&base_locale
);
680 c_locale
->base_locale
= base_locale
;
683 /* Try out the new locale and raise an exception if it doesn't work. */
685 scm_t_locale_settings prev_locale
;
687 err
= enter_locale_section (c_locale
, &prev_locale
);
693 leave_locale_section (&prev_locale
);
694 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
703 #ifndef USE_GNU_LOCALE_API
704 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
706 free (c_locale_name
);
707 scm_locale_error (FUNC_NAME
, err
);
713 SCM_DEFINE (scm_locale_p
, "locale?", 1, 0, 0,
715 "Return true if @var{obj} is a locale object.")
716 #define FUNC_NAME s_scm_locale_p
718 return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type
, obj
));
724 /* Locale-dependent string comparison.
726 A similar API can be found in MzScheme starting from version 200:
727 http://download.plt-scheme.org/chronology/mzmr200alpha14.html . */
729 #define SCM_STRING_TO_U32_BUF(s1, c_s1) \
732 if (scm_i_is_narrow_string (s1)) \
735 const char *buf = scm_i_string_chars (s1); \
737 len = scm_i_string_length (s1); \
738 c_s1 = (scm_t_wchar *) alloca (sizeof (scm_t_wchar) * (len + 1)); \
740 for (i = 0; i < len; i ++) \
741 c_s1[i] = (unsigned char ) buf[i]; \
745 c_s1 = (scm_t_wchar *) scm_i_string_wide_chars (s1); \
749 /* Compare UTF-32 strings according to LOCALE. Returns a negative value if
750 S1 compares smaller than S2, a positive value if S1 compares larger than
751 S2, or 0 if they compare equal. */
753 compare_u32_strings (SCM s1
, SCM s2
, SCM locale
, const char *func_name
)
754 #define FUNC_NAME func_name
757 scm_t_locale c_locale
;
758 scm_t_wchar
*c_s1
, *c_s2
;
759 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
761 SCM_STRING_TO_U32_BUF (s1
, c_s1
);
762 SCM_STRING_TO_U32_BUF (s2
, c_s2
);
765 RUN_IN_LOCALE_SECTION (c_locale
,
766 result
= u32_strcoll ((const scm_t_uint32
*) c_s1
,
767 (const scm_t_uint32
*) c_s2
));
769 result
= u32_strcoll ((const scm_t_uint32
*) c_s1
,
770 (const scm_t_uint32
*) c_s2
);
772 scm_remember_upto_here_2 (s1
, s2
);
773 scm_remember_upto_here (locale
);
779 u32_locale_casecoll (const char *func_name
, const scm_t_uint32
*c_s1
,
780 const scm_t_uint32
*c_s2
,
783 /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must note
784 make any non-local exit. */
787 const char *loc
= uc_locale_language ();
789 ret
= u32_casecoll (c_s1
, u32_strlen (c_s1
),
790 c_s2
, u32_strlen (c_s2
),
791 loc
, UNINORM_NFC
, result
);
793 return ret
== 0 ? ret
: errno
;
797 compare_u32_strings_ci (SCM s1
, SCM s2
, SCM locale
, const char *func_name
)
798 #define FUNC_NAME func_name
801 scm_t_locale c_locale
;
802 scm_t_wchar
*c_s1
, *c_s2
;
803 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
805 SCM_STRING_TO_U32_BUF (s1
, c_s1
);
806 SCM_STRING_TO_U32_BUF (s2
, c_s2
);
809 RUN_IN_LOCALE_SECTION
811 ret
= u32_locale_casecoll (func_name
,
812 (const scm_t_uint32
*) c_s1
,
813 (const scm_t_uint32
*) c_s2
,
816 ret
= u32_locale_casecoll (func_name
,
817 (const scm_t_uint32
*) c_s1
,
818 (const scm_t_uint32
*) c_s2
,
821 if (SCM_UNLIKELY (ret
!= 0))
824 scm_syserror (FUNC_NAME
);
827 scm_remember_upto_here_2 (s1
, s2
);
828 scm_remember_upto_here (locale
);
834 /* Store into DST an upper-case version of SRC. */
836 str_upcase (register char *dst
, register const char *src
)
838 for (; *src
!= '\0'; src
++, dst
++)
839 *dst
= toupper ((int) *src
);
844 str_downcase (register char *dst
, register const char *src
)
846 for (; *src
!= '\0'; src
++, dst
++)
847 *dst
= tolower ((int) *src
);
851 #ifdef USE_GNU_LOCALE_API
853 str_upcase_l (register char *dst
, register const char *src
,
856 for (; *src
!= '\0'; src
++, dst
++)
857 *dst
= toupper_l (*src
, locale
);
862 str_downcase_l (register char *dst
, register const char *src
,
865 for (; *src
!= '\0'; src
++, dst
++)
866 *dst
= tolower_l (*src
, locale
);
872 SCM_DEFINE (scm_string_locale_lt
, "string-locale<?", 2, 1, 0,
873 (SCM s1
, SCM s2
, SCM locale
),
874 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
875 "If @var{locale} is provided, it should be locale object (as "
876 "returned by @code{make-locale}) and will be used to perform the "
877 "comparison; otherwise, the current system locale is used.")
878 #define FUNC_NAME s_scm_string_locale_lt
882 SCM_VALIDATE_STRING (1, s1
);
883 SCM_VALIDATE_STRING (2, s2
);
885 result
= compare_u32_strings (s1
, s2
, locale
, FUNC_NAME
);
887 return scm_from_bool (result
< 0);
891 SCM_DEFINE (scm_string_locale_gt
, "string-locale>?", 2, 1, 0,
892 (SCM s1
, SCM s2
, SCM locale
),
893 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
894 "If @var{locale} is provided, it should be locale object (as "
895 "returned by @code{make-locale}) and will be used to perform the "
896 "comparison; otherwise, the current system locale is used.")
897 #define FUNC_NAME s_scm_string_locale_gt
901 SCM_VALIDATE_STRING (1, s1
);
902 SCM_VALIDATE_STRING (2, s2
);
904 result
= compare_u32_strings (s1
, s2
, locale
, FUNC_NAME
);
906 return scm_from_bool (result
> 0);
910 SCM_DEFINE (scm_string_locale_ci_lt
, "string-locale-ci<?", 2, 1, 0,
911 (SCM s1
, SCM s2
, SCM locale
),
912 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
913 "and locale-dependent way. If @var{locale} is provided, it "
914 "should be locale object (as returned by @code{make-locale}) "
915 "and will be used to perform the comparison; otherwise, the "
916 "current system locale is used.")
917 #define FUNC_NAME s_scm_string_locale_ci_lt
921 SCM_VALIDATE_STRING (1, s1
);
922 SCM_VALIDATE_STRING (2, s2
);
924 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
926 return scm_from_bool (result
< 0);
930 SCM_DEFINE (scm_string_locale_ci_gt
, "string-locale-ci>?", 2, 1, 0,
931 (SCM s1
, SCM s2
, SCM locale
),
932 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
933 "and locale-dependent way. If @var{locale} is provided, it "
934 "should be locale object (as returned by @code{make-locale}) "
935 "and will be used to perform the comparison; otherwise, the "
936 "current system locale is used.")
937 #define FUNC_NAME s_scm_string_locale_ci_gt
941 SCM_VALIDATE_STRING (1, s1
);
942 SCM_VALIDATE_STRING (2, s2
);
944 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
946 return scm_from_bool (result
> 0);
950 SCM_DEFINE (scm_string_locale_ci_eq
, "string-locale-ci=?", 2, 1, 0,
951 (SCM s1
, SCM s2
, SCM locale
),
952 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
953 "and locale-dependent way. If @var{locale} is provided, it "
954 "should be locale object (as returned by @code{make-locale}) "
955 "and will be used to perform the comparison; otherwise, the "
956 "current system locale is used.")
957 #define FUNC_NAME s_scm_string_locale_ci_eq
961 SCM_VALIDATE_STRING (1, s1
);
962 SCM_VALIDATE_STRING (2, s2
);
964 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
966 return scm_from_bool (result
== 0);
971 SCM_DEFINE (scm_char_locale_lt
, "char-locale<?", 2, 1, 0,
972 (SCM c1
, SCM c2
, SCM locale
),
973 "Return true if character @var{c1} is lower than @var{c2} "
974 "according to @var{locale} or to the current locale.")
975 #define FUNC_NAME s_scm_char_locale_lt
979 SCM_VALIDATE_CHAR (1, c1
);
980 SCM_VALIDATE_CHAR (2, c2
);
982 result
= compare_u32_strings (scm_string (scm_list_1 (c1
)),
983 scm_string (scm_list_1 (c2
)),
986 return scm_from_bool (result
< 0);
990 SCM_DEFINE (scm_char_locale_gt
, "char-locale>?", 2, 1, 0,
991 (SCM c1
, SCM c2
, SCM locale
),
992 "Return true if character @var{c1} is greater than @var{c2} "
993 "according to @var{locale} or to the current locale.")
994 #define FUNC_NAME s_scm_char_locale_gt
998 SCM_VALIDATE_CHAR (1, c1
);
999 SCM_VALIDATE_CHAR (2, c2
);
1001 result
= compare_u32_strings (scm_string (scm_list_1 (c1
)),
1002 scm_string (scm_list_1 (c2
)),
1005 return scm_from_bool (result
> 0);
1009 SCM_DEFINE (scm_char_locale_ci_lt
, "char-locale-ci<?", 2, 1, 0,
1010 (SCM c1
, SCM c2
, SCM locale
),
1011 "Return true if character @var{c1} is lower than @var{c2}, "
1012 "in a case insensitive way according to @var{locale} or to "
1013 "the current locale.")
1014 #define FUNC_NAME s_scm_char_locale_ci_lt
1018 SCM_VALIDATE_CHAR (1, c1
);
1019 SCM_VALIDATE_CHAR (2, c2
);
1021 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1022 scm_string (scm_list_1 (c2
)),
1025 return scm_from_bool (result
< 0);
1029 SCM_DEFINE (scm_char_locale_ci_gt
, "char-locale-ci>?", 2, 1, 0,
1030 (SCM c1
, SCM c2
, SCM locale
),
1031 "Return true if character @var{c1} is greater than @var{c2}, "
1032 "in a case insensitive way according to @var{locale} or to "
1033 "the current locale.")
1034 #define FUNC_NAME s_scm_char_locale_ci_gt
1038 SCM_VALIDATE_CHAR (1, c1
);
1039 SCM_VALIDATE_CHAR (2, c2
);
1041 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1042 scm_string (scm_list_1 (c2
)),
1045 return scm_from_bool (result
> 0);
1049 SCM_DEFINE (scm_char_locale_ci_eq
, "char-locale-ci=?", 2, 1, 0,
1050 (SCM c1
, SCM c2
, SCM locale
),
1051 "Return true if character @var{c1} is equal to @var{c2}, "
1052 "in a case insensitive way according to @var{locale} or to "
1053 "the current locale.")
1054 #define FUNC_NAME s_scm_char_locale_ci_eq
1058 SCM_VALIDATE_CHAR (1, c1
);
1059 SCM_VALIDATE_CHAR (2, c2
);
1061 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1062 scm_string (scm_list_1 (c2
)),
1065 return scm_from_bool (result
== 0);
1071 /* Locale-dependent alphabetic character mapping. */
1073 SCM_DEFINE (scm_char_locale_downcase
, "char-locale-downcase", 1, 1, 0,
1074 (SCM chr
, SCM locale
),
1075 "Return the lowercase character that corresponds to @var{chr} "
1076 "according to either @var{locale} or the current locale.")
1077 #define FUNC_NAME s_scm_char_locale_downcase
1081 scm_t_locale c_locale
;
1083 SCM_VALIDATE_CHAR (1, chr
);
1084 c_chr
= SCM_CHAR (chr
);
1086 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1088 if (c_locale
!= NULL
)
1090 #ifdef USE_GNU_LOCALE_API
1091 c_result
= tolower_l ((int) c_chr
, c_locale
);
1093 RUN_IN_LOCALE_SECTION (c_locale
, c_result
= tolower ((int) c_chr
));
1097 c_result
= tolower ((int) c_chr
);
1099 return (SCM_MAKE_CHAR (c_result
));
1103 SCM_DEFINE (scm_char_locale_upcase
, "char-locale-upcase", 1, 1, 0,
1104 (SCM chr
, SCM locale
),
1105 "Return the uppercase character that corresponds to @var{chr} "
1106 "according to either @var{locale} or the current locale.")
1107 #define FUNC_NAME s_scm_char_locale_upcase
1111 scm_t_locale c_locale
;
1113 SCM_VALIDATE_CHAR (1, chr
);
1114 c_chr
= SCM_CHAR (chr
);
1116 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1118 if (c_locale
!= NULL
)
1120 #ifdef USE_GNU_LOCALE_API
1121 c_result
= toupper_l ((int) c_chr
, c_locale
);
1123 RUN_IN_LOCALE_SECTION (c_locale
, c_result
= toupper ((int) c_chr
));
1127 c_result
= toupper ((int) c_chr
);
1129 return (SCM_MAKE_CHAR (c_result
));
1133 SCM_DEFINE (scm_string_locale_upcase
, "string-locale-upcase", 1, 1, 0,
1134 (SCM str
, SCM locale
),
1135 "Return a new string that is the uppercase version of "
1136 "@var{str} according to either @var{locale} or the current "
1138 #define FUNC_NAME s_scm_string_locale_upcase
1142 scm_t_locale c_locale
;
1144 SCM_VALIDATE_STRING (1, str
);
1145 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1147 c_str
= scm_i_string_chars (str
);
1148 c_ustr
= (char *) alloca (strlen (c_str
) + 1);
1152 #ifdef USE_GNU_LOCALE_API
1153 str_upcase_l (c_ustr
, c_str
, c_locale
);
1155 RUN_IN_LOCALE_SECTION (c_locale
, str_upcase (c_ustr
, c_str
));
1159 str_upcase (c_ustr
, c_str
);
1161 scm_remember_upto_here (str
);
1163 return (scm_from_locale_string (c_ustr
));
1167 SCM_DEFINE (scm_string_locale_downcase
, "string-locale-downcase", 1, 1, 0,
1168 (SCM str
, SCM locale
),
1169 "Return a new string that is the down-case version of "
1170 "@var{str} according to either @var{locale} or the current "
1172 #define FUNC_NAME s_scm_string_locale_downcase
1176 scm_t_locale c_locale
;
1178 SCM_VALIDATE_STRING (1, str
);
1179 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1181 c_str
= scm_i_string_chars (str
);
1182 c_lstr
= (char *) alloca (strlen (c_str
) + 1);
1186 #ifdef USE_GNU_LOCALE_API
1187 str_downcase_l (c_lstr
, c_str
, c_locale
);
1189 RUN_IN_LOCALE_SECTION (c_locale
, str_downcase (c_lstr
, c_str
));
1193 str_downcase (c_lstr
, c_str
);
1195 scm_remember_upto_here (str
);
1197 return (scm_from_locale_string (c_lstr
));
1201 /* Note: We don't provide mutative versions of `string-locale-(up|down)case'
1202 because, in some languages, a single downcase character maps to a couple
1203 of uppercase characters. Read the SRFI-13 document for a detailed
1204 discussion about this. */
1208 /* Locale-dependent number parsing. */
1210 SCM_DEFINE (scm_locale_string_to_integer
, "locale-string->integer",
1211 1, 2, 0, (SCM str
, SCM base
, SCM locale
),
1212 "Convert string @var{str} into an integer according to either "
1213 "@var{locale} (a locale object as returned by @code{make-locale}) "
1214 "or the current process locale. Return two values: an integer "
1215 "(on success) or @code{#f}, and the number of characters read "
1216 "from @var{str} (@code{0} on failure).")
1217 #define FUNC_NAME s_scm_locale_string_to_integer
1224 scm_t_locale c_locale
;
1226 SCM_VALIDATE_STRING (1, str
);
1227 c_str
= scm_i_string_chars (str
);
1229 if (base
!= SCM_UNDEFINED
)
1230 SCM_VALIDATE_INT_COPY (2, base
, c_base
);
1234 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
1236 if (c_locale
!= NULL
)
1238 #ifdef USE_GNU_LOCALE_API
1239 c_result
= strtol_l (c_str
, &c_endptr
, c_base
, c_locale
);
1241 RUN_IN_LOCALE_SECTION (c_locale
,
1242 c_result
= strtol (c_str
, &c_endptr
, c_base
));
1246 c_result
= strtol (c_str
, &c_endptr
, c_base
);
1248 scm_remember_upto_here (str
);
1250 if (c_endptr
== c_str
)
1251 result
= SCM_BOOL_F
;
1253 result
= scm_from_long (c_result
);
1255 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1259 SCM_DEFINE (scm_locale_string_to_inexact
, "locale-string->inexact",
1260 1, 1, 0, (SCM str
, SCM locale
),
1261 "Convert string @var{str} into an inexact number according to "
1262 "either @var{locale} (a locale object as returned by "
1263 "@code{make-locale}) or the current process locale. Return "
1264 "two values: an inexact number (on success) or @code{#f}, and "
1265 "the number of characters read from @var{str} (@code{0} on "
1267 #define FUNC_NAME s_scm_locale_string_to_inexact
1273 scm_t_locale c_locale
;
1275 SCM_VALIDATE_STRING (1, str
);
1276 c_str
= scm_i_string_chars (str
);
1278 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1280 if (c_locale
!= NULL
)
1282 #ifdef USE_GNU_LOCALE_API
1283 c_result
= strtod_l (c_str
, &c_endptr
, c_locale
);
1285 RUN_IN_LOCALE_SECTION (c_locale
,
1286 c_result
= strtod (c_str
, &c_endptr
));
1290 c_result
= strtod (c_str
, &c_endptr
);
1292 scm_remember_upto_here (str
);
1294 if (c_endptr
== c_str
)
1295 result
= SCM_BOOL_F
;
1297 result
= scm_from_double (c_result
);
1299 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1304 /* Language information, aka. `nl_langinfo ()'. */
1306 /* FIXME: Issues related to `nl-langinfo'.
1308 1. The `CODESET' value is not normalized. This is a secondary issue, but
1309 still a practical issue. See
1310 http://www.cl.cam.ac.uk/~mgk25/ucs/norm_charmap.c for codeset
1313 2. `nl_langinfo ()' is not available on Windows.
1315 3. `nl_langinfo ()' may return strings encoded in a locale different from
1316 the current one, thereby defeating `scm_from_locale_string ()'.
1317 Example: support the current locale is "Latin-1" and one asks:
1319 (nl-langinfo DAY_1 (make-locale LC_ALL "eo_EO.UTF-8"))
1321 The result will be a UTF-8 string. However, `scm_from_locale_string',
1322 which expects a Latin-1 string, won't be able to make much sense of the
1323 returned string. Thus, we'd need an `scm_from_string ()' variant where
1324 the locale (or charset) is explicitly passed. */
1327 SCM_DEFINE (scm_nl_langinfo
, "nl-langinfo", 1, 1, 0,
1328 (SCM item
, SCM locale
),
1329 "Return a string denoting locale information for @var{item} "
1330 "in the current locale or that specified by @var{locale}. "
1331 "The semantics and arguments are the same as those of the "
1332 "X/Open @code{nl_langinfo} function (@pxref{The Elegant and "
1333 "Fast Way, @code{nl_langinfo},, libc, The GNU C Library "
1334 "Reference Manual}).")
1335 #define FUNC_NAME s_scm_nl_langinfo
1337 #ifdef HAVE_NL_LANGINFO
1341 scm_t_locale c_locale
;
1343 SCM_VALIDATE_INT_COPY (2, item
, c_item
);
1344 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1346 /* Sadly, `nl_langinfo ()' returns a pointer to a static string. According
1347 to SuS v2, that static string may be modified by subsequent calls to
1348 `nl_langinfo ()' as well as by calls to `setlocale ()'. Thus, we must
1349 acquire the locale mutex before doing invoking `nl_langinfo ()'. See
1350 http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for
1353 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
1354 if (c_locale
!= NULL
)
1356 #ifdef USE_GNU_LOCALE_API
1357 c_result
= nl_langinfo_l (c_item
, c_locale
);
1359 /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
1360 mutex is already taken. */
1362 scm_t_locale_settings lsec_prev_locale
;
1364 lsec_err
= get_current_locale_settings (&lsec_prev_locale
);
1366 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1369 lsec_err
= install_locale (c_locale
);
1372 leave_locale_section (&lsec_prev_locale
);
1373 free_locale_settings (&lsec_prev_locale
);
1378 scm_locale_error (FUNC_NAME
, lsec_err
);
1381 c_result
= nl_langinfo (c_item
);
1383 restore_locale_settings (&lsec_prev_locale
);
1384 free_locale_settings (&lsec_prev_locale
);
1389 c_result
= nl_langinfo (c_item
);
1391 c_result
= strdup (c_result
);
1392 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1394 if (c_result
== NULL
)
1395 result
= SCM_BOOL_F
;
1400 #if (defined GROUPING) && (defined MON_GROUPING)
1406 /* In this cases, the result is to be interpreted as a list of
1407 numbers. If the last item is `CHARS_MAX', it has the special
1408 meaning "no more grouping". */
1410 for (p
= c_result
; (*p
!= '\0') && (*p
!= CHAR_MAX
); p
++)
1411 result
= scm_cons (SCM_I_MAKINUM ((int) *p
), result
);
1414 SCM last_pair
= result
;
1416 result
= scm_reverse_x (result
, SCM_EOL
);
1420 /* Cyclic grouping information. */
1421 if (last_pair
!= SCM_EOL
)
1422 SCM_SETCDR (last_pair
, result
);
1431 #if (defined FRAC_DIGITS) && (defined INT_FRAC_DIGITS)
1433 case INT_FRAC_DIGITS
:
1434 /* This is to be interpreted as a single integer. */
1435 if (*c_result
== CHAR_MAX
)
1437 result
= SCM_BOOL_F
;
1439 result
= SCM_I_MAKINUM (*c_result
);
1445 #if (defined P_CS_PRECEDES) && (defined INT_N_CS_PRECEDES)
1448 case INT_P_CS_PRECEDES
:
1449 case INT_N_CS_PRECEDES
:
1450 #if (defined P_SEP_BY_SPACE) && (defined N_SEP_BY_SPACE)
1451 case P_SEP_BY_SPACE
:
1452 case N_SEP_BY_SPACE
:
1454 /* This is to be interpreted as a boolean. */
1455 result
= scm_from_bool (*c_result
);
1461 #if (defined P_SIGN_POSN) && (defined INT_N_SIGN_POSN)
1464 case INT_P_SIGN_POSN
:
1465 case INT_N_SIGN_POSN
:
1466 /* See `(libc) Sign of Money Amount' for the interpretation of the
1467 return value here. */
1471 result
= scm_from_locale_symbol ("parenthesize");
1475 result
= scm_from_locale_symbol ("sign-before");
1479 result
= scm_from_locale_symbol ("sign-after");
1483 result
= scm_from_locale_symbol ("sign-before-currency-symbol");
1487 result
= scm_from_locale_symbol ("sign-after-currency-symbol");
1491 result
= scm_from_locale_symbol ("unspecified");
1497 /* FIXME: `locale_string ()' is not appropriate here because of
1498 encoding issues (see comment above). */
1499 result
= scm_take_locale_string (c_result
);
1505 scm_syserror_msg (FUNC_NAME
, "`nl-langinfo' not supported on your system",
1513 /* Define the `nl_item' constants. */
1515 define_langinfo_items (void)
1517 #if (defined HAVE_NL_TYPES_H) && (defined HAVE_LANGINFO_H)
1519 #define DEFINE_NLITEM_CONSTANT(_item) \
1520 scm_c_define (# _item, scm_from_int (_item))
1522 DEFINE_NLITEM_CONSTANT (CODESET
);
1524 /* Abbreviated days of the week. */
1525 DEFINE_NLITEM_CONSTANT (ABDAY_1
);
1526 DEFINE_NLITEM_CONSTANT (ABDAY_2
);
1527 DEFINE_NLITEM_CONSTANT (ABDAY_3
);
1528 DEFINE_NLITEM_CONSTANT (ABDAY_4
);
1529 DEFINE_NLITEM_CONSTANT (ABDAY_5
);
1530 DEFINE_NLITEM_CONSTANT (ABDAY_6
);
1531 DEFINE_NLITEM_CONSTANT (ABDAY_7
);
1533 /* Long-named days of the week. */
1534 DEFINE_NLITEM_CONSTANT (DAY_1
); /* Sunday */
1535 DEFINE_NLITEM_CONSTANT (DAY_2
); /* Monday */
1536 DEFINE_NLITEM_CONSTANT (DAY_3
); /* Tuesday */
1537 DEFINE_NLITEM_CONSTANT (DAY_4
); /* Wednesday */
1538 DEFINE_NLITEM_CONSTANT (DAY_5
); /* Thursday */
1539 DEFINE_NLITEM_CONSTANT (DAY_6
); /* Friday */
1540 DEFINE_NLITEM_CONSTANT (DAY_7
); /* Saturday */
1542 /* Abbreviated month names. */
1543 DEFINE_NLITEM_CONSTANT (ABMON_1
); /* Jan */
1544 DEFINE_NLITEM_CONSTANT (ABMON_2
);
1545 DEFINE_NLITEM_CONSTANT (ABMON_3
);
1546 DEFINE_NLITEM_CONSTANT (ABMON_4
);
1547 DEFINE_NLITEM_CONSTANT (ABMON_5
);
1548 DEFINE_NLITEM_CONSTANT (ABMON_6
);
1549 DEFINE_NLITEM_CONSTANT (ABMON_7
);
1550 DEFINE_NLITEM_CONSTANT (ABMON_8
);
1551 DEFINE_NLITEM_CONSTANT (ABMON_9
);
1552 DEFINE_NLITEM_CONSTANT (ABMON_10
);
1553 DEFINE_NLITEM_CONSTANT (ABMON_11
);
1554 DEFINE_NLITEM_CONSTANT (ABMON_12
);
1556 /* Long month names. */
1557 DEFINE_NLITEM_CONSTANT (MON_1
); /* January */
1558 DEFINE_NLITEM_CONSTANT (MON_2
);
1559 DEFINE_NLITEM_CONSTANT (MON_3
);
1560 DEFINE_NLITEM_CONSTANT (MON_4
);
1561 DEFINE_NLITEM_CONSTANT (MON_5
);
1562 DEFINE_NLITEM_CONSTANT (MON_6
);
1563 DEFINE_NLITEM_CONSTANT (MON_7
);
1564 DEFINE_NLITEM_CONSTANT (MON_8
);
1565 DEFINE_NLITEM_CONSTANT (MON_9
);
1566 DEFINE_NLITEM_CONSTANT (MON_10
);
1567 DEFINE_NLITEM_CONSTANT (MON_11
);
1568 DEFINE_NLITEM_CONSTANT (MON_12
);
1570 DEFINE_NLITEM_CONSTANT (AM_STR
); /* Ante meridiem string. */
1571 DEFINE_NLITEM_CONSTANT (PM_STR
); /* Post meridiem string. */
1573 DEFINE_NLITEM_CONSTANT (D_T_FMT
); /* Date and time format for strftime. */
1574 DEFINE_NLITEM_CONSTANT (D_FMT
); /* Date format for strftime. */
1575 DEFINE_NLITEM_CONSTANT (T_FMT
); /* Time format for strftime. */
1576 DEFINE_NLITEM_CONSTANT (T_FMT_AMPM
);/* 12-hour time format for strftime. */
1578 DEFINE_NLITEM_CONSTANT (ERA
); /* Alternate era. */
1579 DEFINE_NLITEM_CONSTANT (ERA_D_FMT
); /* Date in alternate era format. */
1580 DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT
); /* Date and time in alternate era
1582 DEFINE_NLITEM_CONSTANT (ERA_T_FMT
); /* Time in alternate era format. */
1584 DEFINE_NLITEM_CONSTANT (ALT_DIGITS
); /* Alternate symbols for digits. */
1585 DEFINE_NLITEM_CONSTANT (RADIXCHAR
);
1586 DEFINE_NLITEM_CONSTANT (THOUSEP
);
1589 DEFINE_NLITEM_CONSTANT (YESEXPR
);
1592 DEFINE_NLITEM_CONSTANT (NOEXPR
);
1595 #ifdef CRNCYSTR /* currency symbol */
1596 DEFINE_NLITEM_CONSTANT (CRNCYSTR
);
1599 /* GNU extensions. */
1602 DEFINE_NLITEM_CONSTANT (ERA_YEAR
); /* Year in alternate era format. */
1605 /* LC_MONETARY category: formatting of monetary quantities.
1606 These items each correspond to a member of `struct lconv',
1607 defined in <locale.h>. */
1608 #ifdef INT_CURR_SYMBOL
1609 DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL
);
1611 #ifdef MON_DECIMAL_POINT
1612 DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT
);
1614 #ifdef MON_THOUSANDS_SEP
1615 DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP
);
1618 DEFINE_NLITEM_CONSTANT (MON_GROUPING
);
1620 #ifdef POSITIVE_SIGN
1621 DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN
);
1623 #ifdef NEGATIVE_SIGN
1624 DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN
);
1627 DEFINE_NLITEM_CONSTANT (GROUPING
);
1629 #ifdef INT_FRAC_DIGITS
1630 DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS
);
1633 DEFINE_NLITEM_CONSTANT (FRAC_DIGITS
);
1635 #ifdef P_CS_PRECEDES
1636 DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES
);
1638 #ifdef P_SEP_BY_SPACE
1639 DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE
);
1641 #ifdef N_CS_PRECEDES
1642 DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES
);
1644 #ifdef N_SEP_BY_SPACE
1645 DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE
);
1648 DEFINE_NLITEM_CONSTANT (P_SIGN_POSN
);
1651 DEFINE_NLITEM_CONSTANT (N_SIGN_POSN
);
1653 #ifdef INT_P_CS_PRECEDES
1654 DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES
);
1656 #ifdef INT_P_SEP_BY_SPACE
1657 DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE
);
1659 #ifdef INT_N_CS_PRECEDES
1660 DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES
);
1662 #ifdef INT_N_SEP_BY_SPACE
1663 DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE
);
1665 #ifdef INT_P_SIGN_POSN
1666 DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN
);
1668 #ifdef INT_N_SIGN_POSN
1669 DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN
);
1672 #undef DEFINE_NLITEM_CONSTANT
1674 #endif /* HAVE_NL_TYPES_H */
1681 SCM global_locale_smob
;
1683 #ifdef HAVE_NL_LANGINFO
1684 scm_add_feature ("nl-langinfo");
1685 define_langinfo_items ();
1688 #include "libguile/i18n.x"
1690 /* Initialize the global locale object with a special `locale' SMOB. */
1691 SCM_NEWSMOB (global_locale_smob
, scm_tc16_locale_smob_type
, NULL
);
1692 SCM_VARIABLE_SET (scm_global_locale
, global_locale_smob
);
1696 scm_bootstrap_i18n ()
1698 scm_c_register_extension ("libguile", "scm_init_i18n",
1699 (scm_t_extension_init_func
) scm_init_i18n
,