1 /* Copyright (C) 2006, 2007, 2008, 2009, 2010 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 /* FIXME: If the locale has been set with 'uselocale',
770 libunistring's uc_locale_language will return the incorrect
771 language: it will return the language appropriate for the global
772 (non-thread-specific) locale.
774 There appears to be no portable way to extract the language from
775 the thread-specific locale_t. There is no LANGUAGE capability in
776 nl_langinfo or nl_langinfo_l.
778 Thus, uc_locale_language needs to be fixed upstream. */
779 return uc_locale_language ();
783 u32_locale_casecoll (const char *func_name
, const scm_t_uint32
*c_s1
,
784 const scm_t_uint32
*c_s2
,
787 /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must note
788 make any non-local exit. */
791 const char *loc
= locale_language ();
793 ret
= u32_casecoll (c_s1
, u32_strlen (c_s1
),
794 c_s2
, u32_strlen (c_s2
),
795 loc
, UNINORM_NFC
, result
);
797 return ret
== 0 ? ret
: errno
;
801 compare_u32_strings_ci (SCM s1
, SCM s2
, SCM locale
, const char *func_name
)
802 #define FUNC_NAME func_name
805 scm_t_locale c_locale
;
806 scm_t_wchar
*c_s1
, *c_s2
;
807 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
809 SCM_STRING_TO_U32_BUF (s1
, c_s1
);
810 SCM_STRING_TO_U32_BUF (s2
, c_s2
);
813 RUN_IN_LOCALE_SECTION
815 ret
= u32_locale_casecoll (func_name
,
816 (const scm_t_uint32
*) c_s1
,
817 (const scm_t_uint32
*) c_s2
,
820 ret
= u32_locale_casecoll (func_name
,
821 (const scm_t_uint32
*) c_s1
,
822 (const scm_t_uint32
*) c_s2
,
825 if (SCM_UNLIKELY (ret
!= 0))
828 scm_syserror (FUNC_NAME
);
831 scm_remember_upto_here_2 (s1
, s2
);
832 scm_remember_upto_here (locale
);
838 /* Store into DST an upper-case version of SRC. */
840 str_upcase (register char *dst
, register const char *src
)
842 for (; *src
!= '\0'; src
++, dst
++)
843 *dst
= toupper ((int) *src
);
848 str_downcase (register char *dst
, register const char *src
)
850 for (; *src
!= '\0'; src
++, dst
++)
851 *dst
= tolower ((int) *src
);
855 #ifdef USE_GNU_LOCALE_API
857 str_upcase_l (register char *dst
, register const char *src
,
860 for (; *src
!= '\0'; src
++, dst
++)
861 *dst
= toupper_l (*src
, locale
);
866 str_downcase_l (register char *dst
, register const char *src
,
869 for (; *src
!= '\0'; src
++, dst
++)
870 *dst
= tolower_l (*src
, locale
);
876 SCM_DEFINE (scm_string_locale_lt
, "string-locale<?", 2, 1, 0,
877 (SCM s1
, SCM s2
, SCM locale
),
878 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
879 "If @var{locale} is provided, it should be locale object (as "
880 "returned by @code{make-locale}) and will be used to perform the "
881 "comparison; otherwise, the current system locale is used.")
882 #define FUNC_NAME s_scm_string_locale_lt
886 SCM_VALIDATE_STRING (1, s1
);
887 SCM_VALIDATE_STRING (2, s2
);
889 result
= compare_u32_strings (s1
, s2
, locale
, FUNC_NAME
);
891 return scm_from_bool (result
< 0);
895 SCM_DEFINE (scm_string_locale_gt
, "string-locale>?", 2, 1, 0,
896 (SCM s1
, SCM s2
, SCM locale
),
897 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
898 "If @var{locale} is provided, it should be locale object (as "
899 "returned by @code{make-locale}) and will be used to perform the "
900 "comparison; otherwise, the current system locale is used.")
901 #define FUNC_NAME s_scm_string_locale_gt
905 SCM_VALIDATE_STRING (1, s1
);
906 SCM_VALIDATE_STRING (2, s2
);
908 result
= compare_u32_strings (s1
, s2
, locale
, FUNC_NAME
);
910 return scm_from_bool (result
> 0);
914 SCM_DEFINE (scm_string_locale_ci_lt
, "string-locale-ci<?", 2, 1, 0,
915 (SCM s1
, SCM s2
, SCM locale
),
916 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
917 "and locale-dependent way. If @var{locale} is provided, it "
918 "should be locale object (as returned by @code{make-locale}) "
919 "and will be used to perform the comparison; otherwise, the "
920 "current system locale is used.")
921 #define FUNC_NAME s_scm_string_locale_ci_lt
925 SCM_VALIDATE_STRING (1, s1
);
926 SCM_VALIDATE_STRING (2, s2
);
928 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
930 return scm_from_bool (result
< 0);
934 SCM_DEFINE (scm_string_locale_ci_gt
, "string-locale-ci>?", 2, 1, 0,
935 (SCM s1
, SCM s2
, SCM locale
),
936 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
937 "and locale-dependent way. If @var{locale} is provided, it "
938 "should be locale object (as returned by @code{make-locale}) "
939 "and will be used to perform the comparison; otherwise, the "
940 "current system locale is used.")
941 #define FUNC_NAME s_scm_string_locale_ci_gt
945 SCM_VALIDATE_STRING (1, s1
);
946 SCM_VALIDATE_STRING (2, s2
);
948 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
950 return scm_from_bool (result
> 0);
954 SCM_DEFINE (scm_string_locale_ci_eq
, "string-locale-ci=?", 2, 1, 0,
955 (SCM s1
, SCM s2
, SCM locale
),
956 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
957 "and locale-dependent way. If @var{locale} is provided, it "
958 "should be locale object (as returned by @code{make-locale}) "
959 "and will be used to perform the comparison; otherwise, the "
960 "current system locale is used.")
961 #define FUNC_NAME s_scm_string_locale_ci_eq
965 SCM_VALIDATE_STRING (1, s1
);
966 SCM_VALIDATE_STRING (2, s2
);
968 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
970 return scm_from_bool (result
== 0);
975 SCM_DEFINE (scm_char_locale_lt
, "char-locale<?", 2, 1, 0,
976 (SCM c1
, SCM c2
, SCM locale
),
977 "Return true if character @var{c1} is lower than @var{c2} "
978 "according to @var{locale} or to the current locale.")
979 #define FUNC_NAME s_scm_char_locale_lt
983 SCM_VALIDATE_CHAR (1, c1
);
984 SCM_VALIDATE_CHAR (2, c2
);
986 result
= compare_u32_strings (scm_string (scm_list_1 (c1
)),
987 scm_string (scm_list_1 (c2
)),
990 return scm_from_bool (result
< 0);
994 SCM_DEFINE (scm_char_locale_gt
, "char-locale>?", 2, 1, 0,
995 (SCM c1
, SCM c2
, SCM locale
),
996 "Return true if character @var{c1} is greater than @var{c2} "
997 "according to @var{locale} or to the current locale.")
998 #define FUNC_NAME s_scm_char_locale_gt
1002 SCM_VALIDATE_CHAR (1, c1
);
1003 SCM_VALIDATE_CHAR (2, c2
);
1005 result
= compare_u32_strings (scm_string (scm_list_1 (c1
)),
1006 scm_string (scm_list_1 (c2
)),
1009 return scm_from_bool (result
> 0);
1013 SCM_DEFINE (scm_char_locale_ci_lt
, "char-locale-ci<?", 2, 1, 0,
1014 (SCM c1
, SCM c2
, SCM locale
),
1015 "Return true if character @var{c1} is lower than @var{c2}, "
1016 "in a case insensitive way according to @var{locale} or to "
1017 "the current locale.")
1018 #define FUNC_NAME s_scm_char_locale_ci_lt
1022 SCM_VALIDATE_CHAR (1, c1
);
1023 SCM_VALIDATE_CHAR (2, c2
);
1025 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1026 scm_string (scm_list_1 (c2
)),
1029 return scm_from_bool (result
< 0);
1033 SCM_DEFINE (scm_char_locale_ci_gt
, "char-locale-ci>?", 2, 1, 0,
1034 (SCM c1
, SCM c2
, SCM locale
),
1035 "Return true if character @var{c1} is greater than @var{c2}, "
1036 "in a case insensitive way according to @var{locale} or to "
1037 "the current locale.")
1038 #define FUNC_NAME s_scm_char_locale_ci_gt
1042 SCM_VALIDATE_CHAR (1, c1
);
1043 SCM_VALIDATE_CHAR (2, c2
);
1045 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1046 scm_string (scm_list_1 (c2
)),
1049 return scm_from_bool (result
> 0);
1053 SCM_DEFINE (scm_char_locale_ci_eq
, "char-locale-ci=?", 2, 1, 0,
1054 (SCM c1
, SCM c2
, SCM locale
),
1055 "Return true if character @var{c1} is equal to @var{c2}, "
1056 "in a case insensitive way according to @var{locale} or to "
1057 "the current locale.")
1058 #define FUNC_NAME s_scm_char_locale_ci_eq
1062 SCM_VALIDATE_CHAR (1, c1
);
1063 SCM_VALIDATE_CHAR (2, c2
);
1065 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1066 scm_string (scm_list_1 (c2
)),
1069 return scm_from_bool (result
== 0);
1075 /* Locale-dependent alphabetic character mapping. */
1078 u32_locale_tocase (const scm_t_uint32
*c_s1
, size_t len
,
1079 scm_t_uint32
**p_c_s2
, size_t * p_len2
,
1080 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t,
1081 const char *, uninorm_t
,
1082 scm_t_uint32
*, size_t *))
1084 /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must not
1085 make any non-local exit. */
1088 const char *loc
= locale_language ();
1090 /* The first NULL here indicates that no NFC or NFKC normalization
1091 is done. The second NULL means the return buffer is
1093 ret
= func (c_s1
, len
, loc
, NULL
, NULL
, p_len2
);
1097 *p_c_s2
= (scm_t_uint32
*) NULL
;
1108 chr_to_case (SCM chr
, scm_t_locale c_locale
,
1109 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t, const char *,
1110 uninorm_t
, scm_t_uint32
*, size_t *),
1111 const char *func_name
,
1113 #define FUNC_NAME func_name
1117 scm_t_uint32
*convbuf
;
1121 str
= scm_i_make_wide_string (1, &buf
);
1122 buf
[0] = SCM_CHAR (chr
);
1124 if (c_locale
!= NULL
)
1125 RUN_IN_LOCALE_SECTION (c_locale
, ret
=
1126 u32_locale_tocase ((scm_t_uint32
*) buf
, 1,
1131 u32_locale_tocase ((scm_t_uint32
*) buf
, 1, &convbuf
,
1134 if (SCM_UNLIKELY (ret
!= 0))
1141 convchar
= SCM_MAKE_CHAR ((scm_t_wchar
) convbuf
[0]);
1150 SCM_DEFINE (scm_char_locale_downcase
, "char-locale-downcase", 1, 1, 0,
1151 (SCM chr
, SCM locale
),
1152 "Return the lowercase character that corresponds to @var{chr} "
1153 "according to either @var{locale} or the current locale.")
1154 #define FUNC_NAME s_scm_char_locale_downcase
1156 scm_t_locale c_locale
;
1160 SCM_VALIDATE_CHAR (1, chr
);
1161 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1163 ret
= chr_to_case (chr
, c_locale
, u32_tolower
, FUNC_NAME
, &err
);
1168 scm_syserror (FUNC_NAME
);
1174 SCM_DEFINE (scm_char_locale_upcase
, "char-locale-upcase", 1, 1, 0,
1175 (SCM chr
, SCM locale
),
1176 "Return the uppercase character that corresponds to @var{chr} "
1177 "according to either @var{locale} or the current locale.")
1178 #define FUNC_NAME s_scm_char_locale_upcase
1180 scm_t_locale c_locale
;
1184 SCM_VALIDATE_CHAR (1, chr
);
1185 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1187 ret
= chr_to_case (chr
, c_locale
, u32_toupper
, FUNC_NAME
, &err
);
1192 scm_syserror (FUNC_NAME
);
1198 SCM_DEFINE (scm_char_locale_titlecase
, "char-locale-titlecase", 1, 1, 0,
1199 (SCM chr
, SCM locale
),
1200 "Return the titlecase character that corresponds to @var{chr} "
1201 "according to either @var{locale} or the current locale.")
1202 #define FUNC_NAME s_scm_char_locale_titlecase
1204 scm_t_locale c_locale
;
1208 SCM_VALIDATE_CHAR (1, chr
);
1209 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1211 ret
= chr_to_case (chr
, c_locale
, u32_totitle
, FUNC_NAME
, &err
);
1216 scm_syserror (FUNC_NAME
);
1223 str_to_case (SCM str
, scm_t_locale c_locale
,
1224 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t, const char *,
1225 uninorm_t
, scm_t_uint32
*, size_t *),
1226 const char *func_name
,
1228 #define FUNC_NAME func_name
1230 scm_t_wchar
*c_str
, *c_buf
;
1231 scm_t_uint32
*c_convstr
;
1232 size_t len
, convlen
;
1236 len
= scm_i_string_length (str
);
1239 SCM_STRING_TO_U32_BUF (str
, c_str
);
1242 RUN_IN_LOCALE_SECTION (c_locale
, ret
=
1243 u32_locale_tocase ((scm_t_uint32
*) c_str
, len
,
1248 u32_locale_tocase ((scm_t_uint32
*) c_str
, len
,
1249 &c_convstr
, &convlen
, func
);
1251 scm_remember_upto_here (str
);
1253 if (SCM_UNLIKELY (ret
!= 0))
1259 convstr
= scm_i_make_wide_string (convlen
, &c_buf
);
1260 memcpy (c_buf
, c_convstr
, convlen
* sizeof (scm_t_wchar
));
1263 scm_i_try_narrow_string (convstr
);
1269 SCM_DEFINE (scm_string_locale_upcase
, "string-locale-upcase", 1, 1, 0,
1270 (SCM str
, SCM locale
),
1271 "Return a new string that is the uppercase version of "
1272 "@var{str} according to either @var{locale} or the current "
1274 #define FUNC_NAME s_scm_string_locale_upcase
1276 scm_t_locale c_locale
;
1280 SCM_VALIDATE_STRING (1, str
);
1281 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1283 ret
= str_to_case (str
, c_locale
, u32_toupper
, FUNC_NAME
, &err
);
1288 scm_syserror (FUNC_NAME
);
1294 SCM_DEFINE (scm_string_locale_downcase
, "string-locale-downcase", 1, 1, 0,
1295 (SCM str
, SCM locale
),
1296 "Return a new string that is the down-case version of "
1297 "@var{str} according to either @var{locale} or the current "
1299 #define FUNC_NAME s_scm_string_locale_downcase
1301 scm_t_locale c_locale
;
1305 SCM_VALIDATE_STRING (1, str
);
1306 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1308 ret
= str_to_case (str
, c_locale
, u32_tolower
, FUNC_NAME
, &err
);
1313 scm_syserror (FUNC_NAME
);
1319 SCM_DEFINE (scm_string_locale_titlecase
, "string-locale-titlecase", 1, 1, 0,
1320 (SCM str
, SCM locale
),
1321 "Return a new string that is the title-case version of "
1322 "@var{str} according to either @var{locale} or the current "
1324 #define FUNC_NAME s_scm_string_locale_titlecase
1326 scm_t_locale c_locale
;
1330 SCM_VALIDATE_STRING (1, str
);
1331 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1333 ret
= str_to_case (str
, c_locale
, u32_totitle
, FUNC_NAME
, &err
);
1338 scm_syserror (FUNC_NAME
);
1344 /* Note: We don't provide mutative versions of `string-locale-(up|down)case'
1345 because, in some languages, a single downcase character maps to a couple
1346 of uppercase characters. Read the SRFI-13 document for a detailed
1347 discussion about this. */
1351 /* Locale-dependent number parsing. */
1353 SCM_DEFINE (scm_locale_string_to_integer
, "locale-string->integer",
1354 1, 2, 0, (SCM str
, SCM base
, SCM locale
),
1355 "Convert string @var{str} into an integer according to either "
1356 "@var{locale} (a locale object as returned by @code{make-locale}) "
1357 "or the current process locale. Return two values: an integer "
1358 "(on success) or @code{#f}, and the number of characters read "
1359 "from @var{str} (@code{0} on failure).")
1360 #define FUNC_NAME s_scm_locale_string_to_integer
1367 scm_t_locale c_locale
;
1369 SCM_VALIDATE_STRING (1, str
);
1370 c_str
= scm_i_string_chars (str
);
1372 if (base
!= SCM_UNDEFINED
)
1373 SCM_VALIDATE_INT_COPY (2, base
, c_base
);
1377 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
1379 if (c_locale
!= NULL
)
1381 #ifdef USE_GNU_LOCALE_API
1382 c_result
= strtol_l (c_str
, &c_endptr
, c_base
, c_locale
);
1384 RUN_IN_LOCALE_SECTION (c_locale
,
1385 c_result
= strtol (c_str
, &c_endptr
, c_base
));
1389 c_result
= strtol (c_str
, &c_endptr
, c_base
);
1391 scm_remember_upto_here (str
);
1393 if (c_endptr
== c_str
)
1394 result
= SCM_BOOL_F
;
1396 result
= scm_from_long (c_result
);
1398 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1402 SCM_DEFINE (scm_locale_string_to_inexact
, "locale-string->inexact",
1403 1, 1, 0, (SCM str
, SCM locale
),
1404 "Convert string @var{str} into an inexact number according to "
1405 "either @var{locale} (a locale object as returned by "
1406 "@code{make-locale}) or the current process locale. Return "
1407 "two values: an inexact number (on success) or @code{#f}, and "
1408 "the number of characters read from @var{str} (@code{0} on "
1410 #define FUNC_NAME s_scm_locale_string_to_inexact
1416 scm_t_locale c_locale
;
1418 SCM_VALIDATE_STRING (1, str
);
1419 c_str
= scm_i_string_chars (str
);
1421 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1423 if (c_locale
!= NULL
)
1425 #ifdef USE_GNU_LOCALE_API
1426 c_result
= strtod_l (c_str
, &c_endptr
, c_locale
);
1428 RUN_IN_LOCALE_SECTION (c_locale
,
1429 c_result
= strtod (c_str
, &c_endptr
));
1433 c_result
= strtod (c_str
, &c_endptr
);
1435 scm_remember_upto_here (str
);
1437 if (c_endptr
== c_str
)
1438 result
= SCM_BOOL_F
;
1440 result
= scm_from_double (c_result
);
1442 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1447 /* Language information, aka. `nl_langinfo ()'. */
1449 /* FIXME: Issues related to `nl-langinfo'.
1451 1. The `CODESET' value is not normalized. This is a secondary issue, but
1452 still a practical issue. See
1453 http://www.cl.cam.ac.uk/~mgk25/ucs/norm_charmap.c for codeset
1456 2. `nl_langinfo ()' is not available on Windows.
1458 3. `nl_langinfo ()' may return strings encoded in a locale different from
1462 (nl-langinfo DAY_1 (make-locale LC_ALL "eo_EO.UTF-8"))
1464 returns a result that is a UTF-8 string, regardless of the
1465 setting of the current locale. If nl_langinfo supports CODESET,
1466 we can convert the string properly using scm_from_stringn. If
1467 CODESET is not supported, we won't be able to make much sense of
1468 the returned string.
1470 Note: We don't use Gnulib's `nl_langinfo' module because it's currently not
1471 as complete as the compatibility hacks in `i18n.scm'. */
1474 SCM_DEFINE (scm_nl_langinfo
, "nl-langinfo", 1, 1, 0,
1475 (SCM item
, SCM locale
),
1476 "Return a string denoting locale information for @var{item} "
1477 "in the current locale or that specified by @var{locale}. "
1478 "The semantics and arguments are the same as those of the "
1479 "X/Open @code{nl_langinfo} function (@pxref{The Elegant and "
1480 "Fast Way, @code{nl_langinfo},, libc, The GNU C Library "
1481 "Reference Manual}).")
1482 #define FUNC_NAME s_scm_nl_langinfo
1484 #ifdef HAVE_NL_LANGINFO
1488 scm_t_locale c_locale
;
1489 #ifdef HAVE_LANGINFO_CODESET
1493 SCM_VALIDATE_INT_COPY (2, item
, c_item
);
1494 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1496 /* Sadly, `nl_langinfo ()' returns a pointer to a static string. According
1497 to SuS v2, that static string may be modified by subsequent calls to
1498 `nl_langinfo ()' as well as by calls to `setlocale ()'. Thus, we must
1499 acquire the locale mutex before doing invoking `nl_langinfo ()'. See
1500 http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for
1503 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
1504 if (c_locale
!= NULL
)
1506 #ifdef USE_GNU_LOCALE_API
1507 c_result
= nl_langinfo_l (c_item
, c_locale
);
1508 #ifdef HAVE_LANGINFO_CODESET
1509 codeset
= nl_langinfo_l (CODESET
, c_locale
);
1510 #endif /* HAVE_LANGINFO_CODESET */
1511 #else /* !USE_GNU_LOCALE_API */
1512 /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
1513 mutex is already taken. */
1515 scm_t_locale_settings lsec_prev_locale
;
1517 lsec_err
= get_current_locale_settings (&lsec_prev_locale
);
1519 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1522 lsec_err
= install_locale (c_locale
);
1525 leave_locale_section (&lsec_prev_locale
);
1526 free_locale_settings (&lsec_prev_locale
);
1531 scm_locale_error (FUNC_NAME
, lsec_err
);
1534 c_result
= nl_langinfo (c_item
);
1535 #ifdef HAVE_LANGINFO_CODESET
1536 codeset
= nl_langinfo (CODESET
);
1537 #endif /* HAVE_LANGINFO_CODESET */
1539 restore_locale_settings (&lsec_prev_locale
);
1540 free_locale_settings (&lsec_prev_locale
);
1546 c_result
= nl_langinfo (c_item
);
1547 #ifdef HAVE_LANGINFO_CODESET
1548 codeset
= nl_langinfo (CODESET
);
1549 #endif /* HAVE_LANGINFO_CODESET */
1552 c_result
= strdup (c_result
);
1553 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1555 if (c_result
== NULL
)
1556 result
= SCM_BOOL_F
;
1561 #if (defined GROUPING) && (defined MON_GROUPING)
1567 /* In this cases, the result is to be interpreted as a list of
1568 numbers. If the last item is `CHARS_MAX', it has the special
1569 meaning "no more grouping". */
1571 for (p
= c_result
; (*p
!= '\0') && (*p
!= CHAR_MAX
); p
++)
1572 result
= scm_cons (SCM_I_MAKINUM ((int) *p
), result
);
1575 SCM last_pair
= result
;
1577 result
= scm_reverse_x (result
, SCM_EOL
);
1581 /* Cyclic grouping information. */
1582 if (last_pair
!= SCM_EOL
)
1583 SCM_SETCDR (last_pair
, result
);
1592 #if (defined FRAC_DIGITS) && (defined INT_FRAC_DIGITS)
1594 case INT_FRAC_DIGITS
:
1595 /* This is to be interpreted as a single integer. */
1596 if (*c_result
== CHAR_MAX
)
1598 result
= SCM_BOOL_F
;
1600 result
= SCM_I_MAKINUM (*c_result
);
1606 #if (defined P_CS_PRECEDES) && (defined INT_N_CS_PRECEDES)
1609 case INT_P_CS_PRECEDES
:
1610 case INT_N_CS_PRECEDES
:
1611 #if (defined P_SEP_BY_SPACE) && (defined N_SEP_BY_SPACE)
1612 case P_SEP_BY_SPACE
:
1613 case N_SEP_BY_SPACE
:
1615 /* This is to be interpreted as a boolean. */
1616 result
= scm_from_bool (*c_result
);
1622 #if (defined P_SIGN_POSN) && (defined INT_N_SIGN_POSN)
1625 case INT_P_SIGN_POSN
:
1626 case INT_N_SIGN_POSN
:
1627 /* See `(libc) Sign of Money Amount' for the interpretation of the
1628 return value here. */
1632 result
= scm_from_locale_symbol ("parenthesize");
1636 result
= scm_from_locale_symbol ("sign-before");
1640 result
= scm_from_locale_symbol ("sign-after");
1644 result
= scm_from_locale_symbol ("sign-before-currency-symbol");
1648 result
= scm_from_locale_symbol ("sign-after-currency-symbol");
1652 result
= scm_from_locale_symbol ("unspecified");
1658 #ifdef HAVE_LANGINFO_CODESET
1659 result
= scm_from_stringn (c_result
, strlen (c_result
),
1661 SCM_FAILED_CONVERSION_QUESTION_MARK
);
1662 #else /* !HAVE_LANGINFO_CODESET */
1663 /* This may be incorrectly encoded if the locale differs
1664 from the c_locale. */
1665 result
= scm_from_locale_string (c_result
);
1666 #endif /* !HAVE_LANGINFO_CODESET */
1673 scm_syserror_msg (FUNC_NAME
, "`nl-langinfo' not supported on your system",
1681 /* Define the `nl_item' constants. */
1683 define_langinfo_items (void)
1685 #if (defined HAVE_NL_TYPES_H) && (defined HAVE_LANGINFO_H)
1687 #define DEFINE_NLITEM_CONSTANT(_item) \
1688 scm_c_define (# _item, scm_from_int (_item))
1690 DEFINE_NLITEM_CONSTANT (CODESET
);
1692 /* Abbreviated days of the week. */
1693 DEFINE_NLITEM_CONSTANT (ABDAY_1
);
1694 DEFINE_NLITEM_CONSTANT (ABDAY_2
);
1695 DEFINE_NLITEM_CONSTANT (ABDAY_3
);
1696 DEFINE_NLITEM_CONSTANT (ABDAY_4
);
1697 DEFINE_NLITEM_CONSTANT (ABDAY_5
);
1698 DEFINE_NLITEM_CONSTANT (ABDAY_6
);
1699 DEFINE_NLITEM_CONSTANT (ABDAY_7
);
1701 /* Long-named days of the week. */
1702 DEFINE_NLITEM_CONSTANT (DAY_1
); /* Sunday */
1703 DEFINE_NLITEM_CONSTANT (DAY_2
); /* Monday */
1704 DEFINE_NLITEM_CONSTANT (DAY_3
); /* Tuesday */
1705 DEFINE_NLITEM_CONSTANT (DAY_4
); /* Wednesday */
1706 DEFINE_NLITEM_CONSTANT (DAY_5
); /* Thursday */
1707 DEFINE_NLITEM_CONSTANT (DAY_6
); /* Friday */
1708 DEFINE_NLITEM_CONSTANT (DAY_7
); /* Saturday */
1710 /* Abbreviated month names. */
1711 DEFINE_NLITEM_CONSTANT (ABMON_1
); /* Jan */
1712 DEFINE_NLITEM_CONSTANT (ABMON_2
);
1713 DEFINE_NLITEM_CONSTANT (ABMON_3
);
1714 DEFINE_NLITEM_CONSTANT (ABMON_4
);
1715 DEFINE_NLITEM_CONSTANT (ABMON_5
);
1716 DEFINE_NLITEM_CONSTANT (ABMON_6
);
1717 DEFINE_NLITEM_CONSTANT (ABMON_7
);
1718 DEFINE_NLITEM_CONSTANT (ABMON_8
);
1719 DEFINE_NLITEM_CONSTANT (ABMON_9
);
1720 DEFINE_NLITEM_CONSTANT (ABMON_10
);
1721 DEFINE_NLITEM_CONSTANT (ABMON_11
);
1722 DEFINE_NLITEM_CONSTANT (ABMON_12
);
1724 /* Long month names. */
1725 DEFINE_NLITEM_CONSTANT (MON_1
); /* January */
1726 DEFINE_NLITEM_CONSTANT (MON_2
);
1727 DEFINE_NLITEM_CONSTANT (MON_3
);
1728 DEFINE_NLITEM_CONSTANT (MON_4
);
1729 DEFINE_NLITEM_CONSTANT (MON_5
);
1730 DEFINE_NLITEM_CONSTANT (MON_6
);
1731 DEFINE_NLITEM_CONSTANT (MON_7
);
1732 DEFINE_NLITEM_CONSTANT (MON_8
);
1733 DEFINE_NLITEM_CONSTANT (MON_9
);
1734 DEFINE_NLITEM_CONSTANT (MON_10
);
1735 DEFINE_NLITEM_CONSTANT (MON_11
);
1736 DEFINE_NLITEM_CONSTANT (MON_12
);
1738 DEFINE_NLITEM_CONSTANT (AM_STR
); /* Ante meridiem string. */
1739 DEFINE_NLITEM_CONSTANT (PM_STR
); /* Post meridiem string. */
1741 DEFINE_NLITEM_CONSTANT (D_T_FMT
); /* Date and time format for strftime. */
1742 DEFINE_NLITEM_CONSTANT (D_FMT
); /* Date format for strftime. */
1743 DEFINE_NLITEM_CONSTANT (T_FMT
); /* Time format for strftime. */
1744 DEFINE_NLITEM_CONSTANT (T_FMT_AMPM
);/* 12-hour time format for strftime. */
1746 DEFINE_NLITEM_CONSTANT (ERA
); /* Alternate era. */
1747 DEFINE_NLITEM_CONSTANT (ERA_D_FMT
); /* Date in alternate era format. */
1748 DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT
); /* Date and time in alternate era
1750 DEFINE_NLITEM_CONSTANT (ERA_T_FMT
); /* Time in alternate era format. */
1752 DEFINE_NLITEM_CONSTANT (ALT_DIGITS
); /* Alternate symbols for digits. */
1753 DEFINE_NLITEM_CONSTANT (RADIXCHAR
);
1754 DEFINE_NLITEM_CONSTANT (THOUSEP
);
1757 DEFINE_NLITEM_CONSTANT (YESEXPR
);
1760 DEFINE_NLITEM_CONSTANT (NOEXPR
);
1763 #ifdef CRNCYSTR /* currency symbol */
1764 DEFINE_NLITEM_CONSTANT (CRNCYSTR
);
1767 /* GNU extensions. */
1770 DEFINE_NLITEM_CONSTANT (ERA_YEAR
); /* Year in alternate era format. */
1773 /* LC_MONETARY category: formatting of monetary quantities.
1774 These items each correspond to a member of `struct lconv',
1775 defined in <locale.h>. */
1776 #ifdef INT_CURR_SYMBOL
1777 DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL
);
1779 #ifdef MON_DECIMAL_POINT
1780 DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT
);
1782 #ifdef MON_THOUSANDS_SEP
1783 DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP
);
1786 DEFINE_NLITEM_CONSTANT (MON_GROUPING
);
1788 #ifdef POSITIVE_SIGN
1789 DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN
);
1791 #ifdef NEGATIVE_SIGN
1792 DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN
);
1795 DEFINE_NLITEM_CONSTANT (GROUPING
);
1797 #ifdef INT_FRAC_DIGITS
1798 DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS
);
1801 DEFINE_NLITEM_CONSTANT (FRAC_DIGITS
);
1803 #ifdef P_CS_PRECEDES
1804 DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES
);
1806 #ifdef P_SEP_BY_SPACE
1807 DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE
);
1809 #ifdef N_CS_PRECEDES
1810 DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES
);
1812 #ifdef N_SEP_BY_SPACE
1813 DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE
);
1816 DEFINE_NLITEM_CONSTANT (P_SIGN_POSN
);
1819 DEFINE_NLITEM_CONSTANT (N_SIGN_POSN
);
1821 #ifdef INT_P_CS_PRECEDES
1822 DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES
);
1824 #ifdef INT_P_SEP_BY_SPACE
1825 DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE
);
1827 #ifdef INT_N_CS_PRECEDES
1828 DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES
);
1830 #ifdef INT_N_SEP_BY_SPACE
1831 DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE
);
1833 #ifdef INT_P_SIGN_POSN
1834 DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN
);
1836 #ifdef INT_N_SIGN_POSN
1837 DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN
);
1840 #undef DEFINE_NLITEM_CONSTANT
1842 #endif /* HAVE_NL_TYPES_H */
1849 SCM global_locale_smob
;
1851 #ifdef HAVE_NL_LANGINFO
1852 scm_add_feature ("nl-langinfo");
1853 define_langinfo_items ();
1856 #include "libguile/i18n.x"
1858 /* Initialize the global locale object with a special `locale' SMOB. */
1859 /* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
1860 glibc <= 2.11 not (yet) worked around by Gnulib. See
1861 http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details. */
1862 SCM_NEWSMOB (global_locale_smob
, scm_tc16_locale_smob_type
, NULL
);
1863 SCM_VARIABLE_SET (scm_global_locale
, global_locale_smob
);
1867 scm_bootstrap_i18n ()
1869 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
1871 (scm_t_extension_init_func
) scm_init_i18n
,