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
85 /* Acquiring and releasing the locale lock. */
88 lock_locale_mutex (void)
91 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
97 unlock_locale_mutex (void)
100 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
106 /* Locale objects, string and character collation, and other locale-dependent
109 A large part of the code here deals with emulating glibc's reentrant
110 locale API on non-GNU systems. The emulation is a bit "brute-force":
111 Whenever a `-locale<?' procedure is passed a locale object, then:
113 1. The `scm_i_locale_mutex' is locked.
114 2. A series of `setlocale ()' call is performed to store the current
115 locale for each category in an `scm_t_locale' object.
116 3. A series of `setlocale ()' call is made to install each of the locale
117 categories of each of the base locales of each locale object,
118 recursively, starting from the last locale object of the chain.
119 4. The settings captured in step (2) are restored.
120 5. The `scm_i_locale_mutex' is released.
122 Hopefully, the X/Open standard will eventually make this hack useless.
124 Note: We don't wrap glibc's `uselocale ()' call because it sets the locale
125 of the current _thread_ (unlike `setlocale ()') and doing so would require
126 maintaining per-thread locale information on non-GNU systems and always
127 re-installing this locale upon locale-dependent calls. */
130 /* Return the category mask corresponding to CAT. */
131 #define SCM_LOCALE_CATEGORY_MASK(_cat) LC_ ## _cat ## _MASK
134 #ifndef USE_GNU_LOCALE_API
136 /* Provide the locale category masks as found in glibc. This must be kept in
137 sync with `locale-categories.h'. */
139 # define LC_CTYPE_MASK 1
140 # define LC_COLLATE_MASK 2
141 # define LC_MESSAGES_MASK 4
142 # define LC_MONETARY_MASK 8
143 # define LC_NUMERIC_MASK 16
144 # define LC_TIME_MASK 32
147 # define LC_PAPER_MASK 64
149 # define LC_PAPER_MASK 0
152 # define LC_NAME_MASK 128
154 # define LC_NAME_MASK 0
157 # define LC_ADDRESS_MASK 256
159 # define LC_ADDRESS_MASK 0
162 # define LC_TELEPHONE_MASK 512
164 # define LC_TELEPHONE_MASK 0
166 # ifdef LC_MEASUREMENT
167 # define LC_MEASUREMENT_MASK 1024
169 # define LC_MEASUREMENT_MASK 0
171 # ifdef LC_IDENTIFICATION
172 # define LC_IDENTIFICATION_MASK 2048
174 # define LC_IDENTIFICATION_MASK 0
177 # define LC_ALL_MASK (LC_CTYPE_MASK \
186 | LC_TELEPHONE_MASK \
187 | LC_MEASUREMENT_MASK \
188 | LC_IDENTIFICATION_MASK \
191 /* Locale objects as returned by `make-locale' on non-GNU systems. */
192 typedef struct scm_locale
194 SCM base_locale
; /* a `locale' object */
200 /* Free the resources used by LOCALE. */
202 scm_i_locale_free (scm_t_locale locale
)
204 free (locale
->locale_name
);
205 locale
->locale_name
= NULL
;
208 #else /* USE_GNU_LOCALE_API */
210 /* Alias for glibc's locale type. */
211 typedef locale_t scm_t_locale
;
213 #define scm_i_locale_free freelocale
215 #endif /* USE_GNU_LOCALE_API */
218 /* A locale object denoting the global locale. */
219 SCM_GLOBAL_VARIABLE (scm_global_locale
, "%global-locale");
222 /* Validate parameter ARG as a locale object and set C_LOCALE to the
223 corresponding C locale object. */
224 #define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale) \
227 SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type); \
228 (_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg); \
232 /* Validate optional parameter ARG as either undefined or bound to a locale
233 object. Set C_LOCALE to the corresponding C locale object or NULL. */
234 #define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \
237 if ((_arg) != SCM_UNDEFINED) \
238 SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \
240 (_c_locale) = NULL; \
245 SCM_SMOB (scm_tc16_locale_smob_type
, "locale", 0);
247 SCM_SMOB_FREE (scm_tc16_locale_smob_type
, smob_locale_free
, locale
)
249 scm_t_locale c_locale
;
251 c_locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
);
252 scm_i_locale_free (c_locale
);
258 static void inline scm_locale_error (const char *, int) SCM_NORETURN
;
260 /* Throw an exception corresponding to error ERR. */
262 scm_locale_error (const char *func_name
, int err
)
264 scm_syserror_msg (func_name
,
265 "Failed to install locale",
271 /* Emulating GNU's reentrant locale API. */
272 #ifndef USE_GNU_LOCALE_API
275 /* Maximum number of chained locales (via `base_locale'). */
276 #define LOCALE_STACK_SIZE_MAX 256
280 #define SCM_DEFINE_LOCALE_CATEGORY(_name) char * _name;
281 #include "locale-categories.h"
282 #undef SCM_DEFINE_LOCALE_CATEGORY
283 } scm_t_locale_settings
;
285 /* Fill out SETTINGS according to the current locale settings. On success
286 zero is returned and SETTINGS is properly initialized. */
288 get_current_locale_settings (scm_t_locale_settings
*settings
)
290 const char *locale_name
;
292 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
294 SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \
295 if (locale_name == NULL) \
298 settings-> _name = strdup (locale_name); \
299 if (settings-> _name == NULL) \
303 #include "locale-categories.h"
304 #undef SCM_DEFINE_LOCALE_CATEGORY
315 /* Restore locale settings SETTINGS. On success, return zero. */
317 restore_locale_settings (const scm_t_locale_settings
*settings
)
321 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
322 SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name)); \
323 if (result == NULL) \
326 #include "locale-categories.h"
327 #undef SCM_DEFINE_LOCALE_CATEGORY
335 /* Free memory associated with SETTINGS. */
337 free_locale_settings (scm_t_locale_settings
*settings
)
339 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
340 free (settings-> _name); \
341 settings->_name = NULL;
342 #include "locale-categories.h"
343 #undef SCM_DEFINE_LOCALE_CATEGORY
346 /* Install the locale named LOCALE_NAME for all the categories listed in
349 install_locale_categories (const char *locale_name
, int category_mask
)
353 if (category_mask
== LC_ALL_MASK
)
355 SCM_SYSCALL (result
= setlocale (LC_ALL
, locale_name
));
361 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
362 if (category_mask & SCM_LOCALE_CATEGORY_MASK (_name)) \
364 SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \
365 if (result == NULL) \
368 #include "locale-categories.h"
369 #undef SCM_DEFINE_LOCALE_CATEGORY
378 /* Install LOCALE, recursively installing its base locales first. On
379 success, zero is returned. */
381 install_locale (scm_t_locale locale
)
383 scm_t_locale stack
[LOCALE_STACK_SIZE_MAX
];
384 int category_mask
= 0;
385 size_t stack_size
= 0;
386 int stack_offset
= 0;
387 const char *result
= NULL
;
389 /* Build up a locale stack by traversing the `base_locale' link. */
392 if (stack_size
>= LOCALE_STACK_SIZE_MAX
)
393 /* We cannot use `scm_error ()' here because otherwise the locale
394 mutex may remain locked. */
397 stack
[stack_size
++] = locale
;
399 /* Keep track of which categories have already been taken into
401 category_mask
|= locale
->category_mask
;
403 if (locale
->base_locale
!= SCM_UNDEFINED
)
404 locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
->base_locale
);
408 while ((locale
!= NULL
) && (category_mask
!= LC_ALL_MASK
));
410 /* Install the C locale to start from a pristine state. */
411 SCM_SYSCALL (result
= setlocale (LC_ALL
, "C"));
415 /* Install the locales in reverse order. */
416 for (stack_offset
= stack_size
- 1;
423 locale
= stack
[stack_offset
];
424 err
= install_locale_categories (locale
->locale_name
,
425 locale
->category_mask
);
436 /* Leave the locked locale section. */
438 leave_locale_section (const scm_t_locale_settings
*settings
)
440 /* Restore the previous locale settings. */
441 (void)restore_locale_settings (settings
);
443 unlock_locale_mutex ();
446 /* Enter a locked locale section. */
448 enter_locale_section (scm_t_locale locale
,
449 scm_t_locale_settings
*prev_locale
)
453 lock_locale_mutex ();
455 err
= get_current_locale_settings (prev_locale
);
458 unlock_locale_mutex ();
462 err
= install_locale (locale
);
465 leave_locale_section (prev_locale
);
466 free_locale_settings (prev_locale
);
472 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
473 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
477 scm_t_locale_settings lsec_prev_locale; \
479 lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale); \
481 scm_locale_error (FUNC_NAME, lsec_err); \
486 leave_locale_section (&lsec_prev_locale); \
487 free_locale_settings (&lsec_prev_locale); \
492 /* Convert the current locale settings into a locale SMOB. On success, zero
493 is returned and RESULT points to the new SMOB. Otherwise, an error is
496 get_current_locale (SCM
*result
)
499 scm_t_locale c_locale
;
500 const char *current_locale
;
502 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
505 lock_locale_mutex ();
507 c_locale
->category_mask
= LC_ALL_MASK
;
508 c_locale
->base_locale
= SCM_UNDEFINED
;
510 current_locale
= setlocale (LC_ALL
, NULL
);
511 if (current_locale
!= NULL
)
513 c_locale
->locale_name
= strdup (current_locale
);
514 if (c_locale
->locale_name
== NULL
)
520 unlock_locale_mutex ();
523 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
525 SCM_NEWSMOB (*result
, scm_tc16_locale_smob_type
, c_locale
);
530 #else /* USE_GNU_LOCALE_API */
532 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
533 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
536 scm_t_locale old_loc; \
538 old_loc = uselocale (_c_locale); \
540 uselocale (old_loc); \
545 #endif /* USE_GNU_LOCALE_API */
549 /* `make-locale' can take either category lists or single categories (the
550 `LC_*' integer constants). */
551 #define SCM_LIST_OR_INTEGER_P(arg) \
552 (scm_is_integer (arg) || scm_is_true (scm_list_p (arg)))
555 /* Return the category mask corresponding to CATEGORY (an `LC_' integer
558 category_to_category_mask (SCM category
,
559 const char *func_name
, int pos
)
564 c_category
= scm_to_int (category
);
566 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
568 c_category_mask = SCM_LOCALE_CATEGORY_MASK (_name); \
573 #include "locale-categories.h"
576 c_category_mask
= LC_ALL_MASK
;
580 scm_wrong_type_arg_msg (func_name
, pos
, category
,
584 #undef SCM_DEFINE_LOCALE_CATEGORY
586 return c_category_mask
;
589 /* Convert CATEGORIES, a list of locale categories or a single category (an
590 integer), into a category mask. */
592 category_list_to_category_mask (SCM categories
,
593 const char *func_name
, int pos
)
595 int c_category_mask
= 0;
597 if (scm_is_integer (categories
))
598 c_category_mask
= category_to_category_mask (categories
,
601 for (; !scm_is_null (categories
); categories
= SCM_CDR (categories
))
603 SCM category
= SCM_CAR (categories
);
606 category_to_category_mask (category
, func_name
, pos
);
609 return c_category_mask
;
613 SCM_DEFINE (scm_make_locale
, "make-locale", 2, 1, 0,
614 (SCM category_list
, SCM locale_name
, SCM base_locale
),
615 "Return a reference to a data structure representing a set of "
616 "locale datasets. @var{category_list} should be either a list "
617 "of locale categories or a single category as used with "
618 "@code{setlocale} (@pxref{Locales, @code{setlocale}}) and "
619 "@var{locale_name} should be the name of the locale considered "
620 "(e.g., @code{\"sl_SI\"}). Optionally, if @code{base_locale} is "
621 "passed, it should be a locale object denoting settings for "
622 "categories not listed in @var{category_list}.")
623 #define FUNC_NAME s_scm_make_locale
625 SCM locale
= SCM_BOOL_F
;
629 scm_t_locale c_base_locale
, c_locale
;
631 SCM_MAKE_VALIDATE (1, category_list
, LIST_OR_INTEGER_P
);
632 SCM_VALIDATE_STRING (2, locale_name
);
633 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, base_locale
, c_base_locale
);
635 c_category_mask
= category_list_to_category_mask (category_list
,
637 c_locale_name
= scm_to_locale_string (locale_name
);
639 #ifdef USE_GNU_LOCALE_API
641 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
642 c_base_locale
= LC_GLOBAL_LOCALE
;
644 if (c_base_locale
!= (locale_t
) 0)
646 /* C_BASE_LOCALE is to be consumed by `newlocale ()' so it needs to be
647 duplicated before. */
648 c_base_locale
= duplocale (c_base_locale
);
650 if (c_base_locale
== (locale_t
) 0)
657 c_locale
= newlocale (c_category_mask
, c_locale_name
, c_base_locale
);
659 free (c_locale_name
);
661 if (c_locale
== (locale_t
) 0)
663 if (c_base_locale
!= (locale_t
) 0)
664 freelocale (c_base_locale
);
665 scm_locale_error (FUNC_NAME
, errno
);
668 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
672 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
674 c_locale
->category_mask
= c_category_mask
;
675 c_locale
->locale_name
= c_locale_name
;
677 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
679 /* Get the current locale settings and turn them into a locale
681 err
= get_current_locale (&base_locale
);
686 c_locale
->base_locale
= base_locale
;
689 /* Try out the new locale and raise an exception if it doesn't work. */
691 scm_t_locale_settings prev_locale
;
693 err
= enter_locale_section (c_locale
, &prev_locale
);
699 leave_locale_section (&prev_locale
);
700 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
709 #ifndef USE_GNU_LOCALE_API
710 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
712 free (c_locale_name
);
713 scm_locale_error (FUNC_NAME
, err
);
719 SCM_DEFINE (scm_locale_p
, "locale?", 1, 0, 0,
721 "Return true if @var{obj} is a locale object.")
722 #define FUNC_NAME s_scm_locale_p
724 return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type
, obj
));
730 /* Locale-dependent string comparison.
732 A similar API can be found in MzScheme starting from version 200:
733 http://download.plt-scheme.org/chronology/mzmr200alpha14.html . */
735 #define SCM_STRING_TO_U32_BUF(s1, c_s1) \
738 if (scm_i_is_narrow_string (s1)) \
741 const char *buf = scm_i_string_chars (s1); \
743 len = scm_i_string_length (s1); \
744 c_s1 = alloca (sizeof (scm_t_wchar) * (len + 1)); \
746 for (i = 0; i < len; i ++) \
747 c_s1[i] = (unsigned char ) buf[i]; \
751 c_s1 = (scm_t_wchar *) scm_i_string_wide_chars (s1); \
755 /* Compare UTF-32 strings according to LOCALE. Returns a negative value if
756 S1 compares smaller than S2, a positive value if S1 compares larger than
757 S2, or 0 if they compare equal. */
759 compare_u32_strings (SCM s1
, SCM s2
, SCM locale
, const char *func_name
)
760 #define FUNC_NAME func_name
763 scm_t_locale c_locale
;
764 scm_t_wchar
*c_s1
, *c_s2
;
765 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
767 SCM_STRING_TO_U32_BUF (s1
, c_s1
);
768 SCM_STRING_TO_U32_BUF (s2
, c_s2
);
771 RUN_IN_LOCALE_SECTION (c_locale
,
772 result
= u32_strcoll ((const scm_t_uint32
*) c_s1
,
773 (const scm_t_uint32
*) c_s2
));
775 result
= u32_strcoll ((const scm_t_uint32
*) c_s1
,
776 (const scm_t_uint32
*) c_s2
);
778 scm_remember_upto_here_2 (s1
, s2
);
779 scm_remember_upto_here (locale
);
784 /* Return the current language of the locale. */
788 /* Note: If the locale has been set with 'uselocale', uc_locale_language
789 from libunistring versions 0.9.1 and older will return the incorrect
790 (non-thread-specific) locale. This is fixed in versions 0.9.2 and
792 return uc_locale_language ();
796 u32_locale_casecoll (const char *func_name
, const scm_t_uint32
*c_s1
,
797 const scm_t_uint32
*c_s2
,
800 /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must note
801 make any non-local exit. */
804 const char *loc
= locale_language ();
806 ret
= u32_casecoll (c_s1
, u32_strlen (c_s1
),
807 c_s2
, u32_strlen (c_s2
),
808 loc
, UNINORM_NFC
, result
);
810 return ret
== 0 ? ret
: errno
;
814 compare_u32_strings_ci (SCM s1
, SCM s2
, SCM locale
, const char *func_name
)
815 #define FUNC_NAME func_name
818 scm_t_locale c_locale
;
819 scm_t_wchar
*c_s1
, *c_s2
;
820 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
822 SCM_STRING_TO_U32_BUF (s1
, c_s1
);
823 SCM_STRING_TO_U32_BUF (s2
, c_s2
);
826 RUN_IN_LOCALE_SECTION
828 ret
= u32_locale_casecoll (func_name
,
829 (const scm_t_uint32
*) c_s1
,
830 (const scm_t_uint32
*) c_s2
,
833 ret
= u32_locale_casecoll (func_name
,
834 (const scm_t_uint32
*) c_s1
,
835 (const scm_t_uint32
*) c_s2
,
838 if (SCM_UNLIKELY (ret
!= 0))
841 scm_syserror (FUNC_NAME
);
844 scm_remember_upto_here_2 (s1
, s2
);
845 scm_remember_upto_here (locale
);
851 /* Store into DST an upper-case version of SRC. */
853 str_upcase (register char *dst
, register const char *src
)
855 for (; *src
!= '\0'; src
++, dst
++)
856 *dst
= toupper ((int) *src
);
861 str_downcase (register char *dst
, register const char *src
)
863 for (; *src
!= '\0'; src
++, dst
++)
864 *dst
= tolower ((int) *src
);
868 #ifdef USE_GNU_LOCALE_API
870 str_upcase_l (register char *dst
, register const char *src
,
873 for (; *src
!= '\0'; src
++, dst
++)
874 *dst
= toupper_l (*src
, locale
);
879 str_downcase_l (register char *dst
, register const char *src
,
882 for (; *src
!= '\0'; src
++, dst
++)
883 *dst
= tolower_l (*src
, locale
);
889 SCM_DEFINE (scm_string_locale_lt
, "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_lt
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_gt
, "string-locale>?", 2, 1, 0,
909 (SCM s1
, SCM s2
, SCM locale
),
910 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
911 "If @var{locale} is provided, it should be locale object (as "
912 "returned by @code{make-locale}) and will be used to perform the "
913 "comparison; otherwise, the current system locale is used.")
914 #define FUNC_NAME s_scm_string_locale_gt
918 SCM_VALIDATE_STRING (1, s1
);
919 SCM_VALIDATE_STRING (2, s2
);
921 result
= compare_u32_strings (s1
, s2
, locale
, FUNC_NAME
);
923 return scm_from_bool (result
> 0);
927 SCM_DEFINE (scm_string_locale_ci_lt
, "string-locale-ci<?", 2, 1, 0,
928 (SCM s1
, SCM s2
, SCM locale
),
929 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
930 "and locale-dependent way. If @var{locale} is provided, it "
931 "should be locale object (as returned by @code{make-locale}) "
932 "and will be used to perform the comparison; otherwise, the "
933 "current system locale is used.")
934 #define FUNC_NAME s_scm_string_locale_ci_lt
938 SCM_VALIDATE_STRING (1, s1
);
939 SCM_VALIDATE_STRING (2, s2
);
941 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
943 return scm_from_bool (result
< 0);
947 SCM_DEFINE (scm_string_locale_ci_gt
, "string-locale-ci>?", 2, 1, 0,
948 (SCM s1
, SCM s2
, SCM locale
),
949 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
950 "and locale-dependent way. If @var{locale} is provided, it "
951 "should be locale object (as returned by @code{make-locale}) "
952 "and will be used to perform the comparison; otherwise, the "
953 "current system locale is used.")
954 #define FUNC_NAME s_scm_string_locale_ci_gt
958 SCM_VALIDATE_STRING (1, s1
);
959 SCM_VALIDATE_STRING (2, s2
);
961 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
963 return scm_from_bool (result
> 0);
967 SCM_DEFINE (scm_string_locale_ci_eq
, "string-locale-ci=?", 2, 1, 0,
968 (SCM s1
, SCM s2
, SCM locale
),
969 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
970 "and locale-dependent way. If @var{locale} is provided, it "
971 "should be locale object (as returned by @code{make-locale}) "
972 "and will be used to perform the comparison; otherwise, the "
973 "current system locale is used.")
974 #define FUNC_NAME s_scm_string_locale_ci_eq
978 SCM_VALIDATE_STRING (1, s1
);
979 SCM_VALIDATE_STRING (2, s2
);
981 result
= compare_u32_strings_ci (s1
, s2
, locale
, FUNC_NAME
);
983 return scm_from_bool (result
== 0);
988 SCM_DEFINE (scm_char_locale_lt
, "char-locale<?", 2, 1, 0,
989 (SCM c1
, SCM c2
, SCM locale
),
990 "Return true if character @var{c1} is lower than @var{c2} "
991 "according to @var{locale} or to the current locale.")
992 #define FUNC_NAME s_scm_char_locale_lt
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_gt
, "char-locale>?", 2, 1, 0,
1008 (SCM c1
, SCM c2
, SCM locale
),
1009 "Return true if character @var{c1} is greater than @var{c2} "
1010 "according to @var{locale} or to the current locale.")
1011 #define FUNC_NAME s_scm_char_locale_gt
1015 SCM_VALIDATE_CHAR (1, c1
);
1016 SCM_VALIDATE_CHAR (2, c2
);
1018 result
= compare_u32_strings (scm_string (scm_list_1 (c1
)),
1019 scm_string (scm_list_1 (c2
)),
1022 return scm_from_bool (result
> 0);
1026 SCM_DEFINE (scm_char_locale_ci_lt
, "char-locale-ci<?", 2, 1, 0,
1027 (SCM c1
, SCM c2
, SCM locale
),
1028 "Return true if character @var{c1} is lower than @var{c2}, "
1029 "in a case insensitive way according to @var{locale} or to "
1030 "the current locale.")
1031 #define FUNC_NAME s_scm_char_locale_ci_lt
1035 SCM_VALIDATE_CHAR (1, c1
);
1036 SCM_VALIDATE_CHAR (2, c2
);
1038 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1039 scm_string (scm_list_1 (c2
)),
1042 return scm_from_bool (result
< 0);
1046 SCM_DEFINE (scm_char_locale_ci_gt
, "char-locale-ci>?", 2, 1, 0,
1047 (SCM c1
, SCM c2
, SCM locale
),
1048 "Return true if character @var{c1} is greater than @var{c2}, "
1049 "in a case insensitive way according to @var{locale} or to "
1050 "the current locale.")
1051 #define FUNC_NAME s_scm_char_locale_ci_gt
1055 SCM_VALIDATE_CHAR (1, c1
);
1056 SCM_VALIDATE_CHAR (2, c2
);
1058 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1059 scm_string (scm_list_1 (c2
)),
1062 return scm_from_bool (result
> 0);
1066 SCM_DEFINE (scm_char_locale_ci_eq
, "char-locale-ci=?", 2, 1, 0,
1067 (SCM c1
, SCM c2
, SCM locale
),
1068 "Return true if character @var{c1} is equal to @var{c2}, "
1069 "in a case insensitive way according to @var{locale} or to "
1070 "the current locale.")
1071 #define FUNC_NAME s_scm_char_locale_ci_eq
1075 SCM_VALIDATE_CHAR (1, c1
);
1076 SCM_VALIDATE_CHAR (2, c2
);
1078 result
= compare_u32_strings_ci (scm_string (scm_list_1 (c1
)),
1079 scm_string (scm_list_1 (c2
)),
1082 return scm_from_bool (result
== 0);
1088 /* Locale-dependent alphabetic character mapping. */
1091 u32_locale_tocase (const scm_t_uint32
*c_s1
, size_t len
,
1092 scm_t_uint32
**p_c_s2
, size_t * p_len2
,
1093 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t,
1094 const char *, uninorm_t
,
1095 scm_t_uint32
*, size_t *))
1097 /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must not
1098 make any non-local exit. */
1101 const char *loc
= locale_language ();
1103 /* The first NULL here indicates that no NFC or NFKC normalization
1104 is done. The second NULL means the return buffer is
1106 ret
= func (c_s1
, len
, loc
, NULL
, NULL
, p_len2
);
1110 *p_c_s2
= (scm_t_uint32
*) NULL
;
1121 chr_to_case (SCM chr
, scm_t_locale c_locale
,
1122 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t, const char *,
1123 uninorm_t
, scm_t_uint32
*, size_t *),
1124 const char *func_name
,
1126 #define FUNC_NAME func_name
1130 scm_t_uint32
*convbuf
;
1136 if (c_locale
!= NULL
)
1137 RUN_IN_LOCALE_SECTION (c_locale
, ret
=
1138 u32_locale_tocase (&c
, 1, &convbuf
, &convlen
, func
));
1141 u32_locale_tocase (&c
, 1, &convbuf
, &convlen
, func
);
1143 if (SCM_UNLIKELY (ret
!= 0))
1150 convchar
= SCM_MAKE_CHAR ((scm_t_wchar
) convbuf
[0]);
1159 SCM_DEFINE (scm_char_locale_downcase
, "char-locale-downcase", 1, 1, 0,
1160 (SCM chr
, SCM locale
),
1161 "Return the lowercase character that corresponds to @var{chr} "
1162 "according to either @var{locale} or the current locale.")
1163 #define FUNC_NAME s_scm_char_locale_downcase
1165 scm_t_locale c_locale
;
1169 SCM_VALIDATE_CHAR (1, chr
);
1170 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1172 ret
= chr_to_case (chr
, c_locale
, u32_tolower
, FUNC_NAME
, &err
);
1177 scm_syserror (FUNC_NAME
);
1183 SCM_DEFINE (scm_char_locale_upcase
, "char-locale-upcase", 1, 1, 0,
1184 (SCM chr
, SCM locale
),
1185 "Return the uppercase character that corresponds to @var{chr} "
1186 "according to either @var{locale} or the current locale.")
1187 #define FUNC_NAME s_scm_char_locale_upcase
1189 scm_t_locale c_locale
;
1193 SCM_VALIDATE_CHAR (1, chr
);
1194 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1196 ret
= chr_to_case (chr
, c_locale
, u32_toupper
, FUNC_NAME
, &err
);
1201 scm_syserror (FUNC_NAME
);
1207 SCM_DEFINE (scm_char_locale_titlecase
, "char-locale-titlecase", 1, 1, 0,
1208 (SCM chr
, SCM locale
),
1209 "Return the titlecase character that corresponds to @var{chr} "
1210 "according to either @var{locale} or the current locale.")
1211 #define FUNC_NAME s_scm_char_locale_titlecase
1213 scm_t_locale c_locale
;
1217 SCM_VALIDATE_CHAR (1, chr
);
1218 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1220 ret
= chr_to_case (chr
, c_locale
, u32_totitle
, FUNC_NAME
, &err
);
1225 scm_syserror (FUNC_NAME
);
1232 str_to_case (SCM str
, scm_t_locale c_locale
,
1233 scm_t_uint32
*(*func
) (const scm_t_uint32
*, size_t, const char *,
1234 uninorm_t
, scm_t_uint32
*, size_t *),
1235 const char *func_name
,
1237 #define FUNC_NAME func_name
1239 scm_t_wchar
*c_str
, *c_buf
;
1240 scm_t_uint32
*c_convstr
;
1241 size_t len
, convlen
;
1245 len
= scm_i_string_length (str
);
1248 SCM_STRING_TO_U32_BUF (str
, c_str
);
1251 RUN_IN_LOCALE_SECTION (c_locale
, ret
=
1252 u32_locale_tocase ((scm_t_uint32
*) c_str
, len
,
1257 u32_locale_tocase ((scm_t_uint32
*) c_str
, len
,
1258 &c_convstr
, &convlen
, func
);
1260 scm_remember_upto_here (str
);
1262 if (SCM_UNLIKELY (ret
!= 0))
1268 convstr
= scm_i_make_wide_string (convlen
, &c_buf
, 0);
1269 memcpy (c_buf
, c_convstr
, convlen
* sizeof (scm_t_wchar
));
1272 scm_i_try_narrow_string (convstr
);
1278 SCM_DEFINE (scm_string_locale_upcase
, "string-locale-upcase", 1, 1, 0,
1279 (SCM str
, SCM locale
),
1280 "Return a new string that is the uppercase version of "
1281 "@var{str} according to either @var{locale} or the current "
1283 #define FUNC_NAME s_scm_string_locale_upcase
1285 scm_t_locale c_locale
;
1289 SCM_VALIDATE_STRING (1, str
);
1290 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1292 ret
= str_to_case (str
, c_locale
, u32_toupper
, FUNC_NAME
, &err
);
1297 scm_syserror (FUNC_NAME
);
1303 SCM_DEFINE (scm_string_locale_downcase
, "string-locale-downcase", 1, 1, 0,
1304 (SCM str
, SCM locale
),
1305 "Return a new string that is the down-case version of "
1306 "@var{str} according to either @var{locale} or the current "
1308 #define FUNC_NAME s_scm_string_locale_downcase
1310 scm_t_locale c_locale
;
1314 SCM_VALIDATE_STRING (1, str
);
1315 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1317 ret
= str_to_case (str
, c_locale
, u32_tolower
, FUNC_NAME
, &err
);
1322 scm_syserror (FUNC_NAME
);
1328 SCM_DEFINE (scm_string_locale_titlecase
, "string-locale-titlecase", 1, 1, 0,
1329 (SCM str
, SCM locale
),
1330 "Return a new string that is the title-case version of "
1331 "@var{str} according to either @var{locale} or the current "
1333 #define FUNC_NAME s_scm_string_locale_titlecase
1335 scm_t_locale c_locale
;
1339 SCM_VALIDATE_STRING (1, str
);
1340 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1342 ret
= str_to_case (str
, c_locale
, u32_totitle
, FUNC_NAME
, &err
);
1347 scm_syserror (FUNC_NAME
);
1353 /* Note: We don't provide mutative versions of `string-locale-(up|down)case'
1354 because, in some languages, a single downcase character maps to a couple
1355 of uppercase characters. Read the SRFI-13 document for a detailed
1356 discussion about this. */
1360 /* Locale-dependent number parsing. */
1362 SCM_DEFINE (scm_locale_string_to_integer
, "locale-string->integer",
1363 1, 2, 0, (SCM str
, SCM base
, SCM locale
),
1364 "Convert string @var{str} into an integer according to either "
1365 "@var{locale} (a locale object as returned by @code{make-locale}) "
1366 "or the current process locale. Return two values: an integer "
1367 "(on success) or @code{#f}, and the number of characters read "
1368 "from @var{str} (@code{0} on failure).")
1369 #define FUNC_NAME s_scm_locale_string_to_integer
1376 scm_t_locale c_locale
;
1378 SCM_VALIDATE_STRING (1, str
);
1379 c_str
= scm_i_string_chars (str
);
1381 if (base
!= SCM_UNDEFINED
)
1382 SCM_VALIDATE_INT_COPY (2, base
, c_base
);
1386 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
1388 if (c_locale
!= NULL
)
1390 #ifdef USE_GNU_LOCALE_API
1391 c_result
= strtol_l (c_str
, &c_endptr
, c_base
, c_locale
);
1393 RUN_IN_LOCALE_SECTION (c_locale
,
1394 c_result
= strtol (c_str
, &c_endptr
, c_base
));
1398 c_result
= strtol (c_str
, &c_endptr
, c_base
);
1400 scm_remember_upto_here (str
);
1402 if (c_endptr
== c_str
)
1403 result
= SCM_BOOL_F
;
1405 result
= scm_from_long (c_result
);
1407 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1411 SCM_DEFINE (scm_locale_string_to_inexact
, "locale-string->inexact",
1412 1, 1, 0, (SCM str
, SCM locale
),
1413 "Convert string @var{str} into an inexact number according to "
1414 "either @var{locale} (a locale object as returned by "
1415 "@code{make-locale}) or the current process locale. Return "
1416 "two values: an inexact number (on success) or @code{#f}, and "
1417 "the number of characters read from @var{str} (@code{0} on "
1419 #define FUNC_NAME s_scm_locale_string_to_inexact
1425 scm_t_locale c_locale
;
1427 SCM_VALIDATE_STRING (1, str
);
1428 c_str
= scm_i_string_chars (str
);
1430 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1432 if (c_locale
!= NULL
)
1434 #ifdef USE_GNU_LOCALE_API
1435 c_result
= strtod_l (c_str
, &c_endptr
, c_locale
);
1437 RUN_IN_LOCALE_SECTION (c_locale
,
1438 c_result
= strtod (c_str
, &c_endptr
));
1442 c_result
= strtod (c_str
, &c_endptr
);
1444 scm_remember_upto_here (str
);
1446 if (c_endptr
== c_str
)
1447 result
= SCM_BOOL_F
;
1449 result
= scm_from_double (c_result
);
1451 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1456 /* Language information, aka. `nl_langinfo ()'. */
1458 /* FIXME: Issues related to `nl-langinfo'.
1460 1. The `CODESET' value is not normalized. This is a secondary issue, but
1461 still a practical issue. See
1462 http://www.cl.cam.ac.uk/~mgk25/ucs/norm_charmap.c for codeset
1465 2. `nl_langinfo ()' is not available on Windows.
1467 3. `nl_langinfo ()' may return strings encoded in a locale different from
1471 (nl-langinfo DAY_1 (make-locale LC_ALL "eo_EO.UTF-8"))
1473 returns a result that is a UTF-8 string, regardless of the
1474 setting of the current locale. If nl_langinfo supports CODESET,
1475 we can convert the string properly using scm_from_stringn. If
1476 CODESET is not supported, we won't be able to make much sense of
1477 the returned string.
1479 Note: We don't use Gnulib's `nl_langinfo' module because it's currently not
1480 as complete as the compatibility hacks in `i18n.scm'. */
1483 SCM_DEFINE (scm_nl_langinfo
, "nl-langinfo", 1, 1, 0,
1484 (SCM item
, SCM locale
),
1485 "Return a string denoting locale information for @var{item} "
1486 "in the current locale or that specified by @var{locale}. "
1487 "The semantics and arguments are the same as those of the "
1488 "X/Open @code{nl_langinfo} function (@pxref{The Elegant and "
1489 "Fast Way, @code{nl_langinfo},, libc, The GNU C Library "
1490 "Reference Manual}).")
1491 #define FUNC_NAME s_scm_nl_langinfo
1493 #ifdef HAVE_NL_LANGINFO
1497 scm_t_locale c_locale
;
1498 #ifdef HAVE_LANGINFO_CODESET
1502 SCM_VALIDATE_INT_COPY (2, item
, c_item
);
1503 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1505 /* Sadly, `nl_langinfo ()' returns a pointer to a static string. According
1506 to SuS v2, that static string may be modified by subsequent calls to
1507 `nl_langinfo ()' as well as by calls to `setlocale ()'. Thus, we must
1508 acquire the locale mutex before doing invoking `nl_langinfo ()'. See
1509 http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for
1512 lock_locale_mutex ();
1513 if (c_locale
!= NULL
)
1515 #ifdef USE_GNU_LOCALE_API
1516 c_result
= nl_langinfo_l (c_item
, c_locale
);
1517 #ifdef HAVE_LANGINFO_CODESET
1518 codeset
= nl_langinfo_l (CODESET
, c_locale
);
1519 #endif /* HAVE_LANGINFO_CODESET */
1520 #else /* !USE_GNU_LOCALE_API */
1521 /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
1522 mutex is already taken. */
1524 scm_t_locale_settings lsec_prev_locale
;
1526 lsec_err
= get_current_locale_settings (&lsec_prev_locale
);
1528 unlock_locale_mutex ();
1531 lsec_err
= install_locale (c_locale
);
1534 leave_locale_section (&lsec_prev_locale
);
1535 free_locale_settings (&lsec_prev_locale
);
1540 scm_locale_error (FUNC_NAME
, lsec_err
);
1543 c_result
= nl_langinfo (c_item
);
1544 #ifdef HAVE_LANGINFO_CODESET
1545 codeset
= nl_langinfo (CODESET
);
1546 #endif /* HAVE_LANGINFO_CODESET */
1548 restore_locale_settings (&lsec_prev_locale
);
1549 free_locale_settings (&lsec_prev_locale
);
1555 c_result
= nl_langinfo (c_item
);
1556 #ifdef HAVE_LANGINFO_CODESET
1557 codeset
= nl_langinfo (CODESET
);
1558 #endif /* HAVE_LANGINFO_CODESET */
1561 c_result
= strdup (c_result
);
1562 unlock_locale_mutex ();
1564 if (c_result
== NULL
)
1565 result
= SCM_BOOL_F
;
1570 #if (defined GROUPING) && (defined MON_GROUPING)
1576 /* In this cases, the result is to be interpreted as a list
1577 of numbers. If the last item is `CHAR_MAX' or a negative
1578 number, it has the special meaning "no more grouping"
1579 (negative numbers aren't specified in POSIX but can be
1581 <http://lists.gnu.org/archive/html/bug-guile/2011-02/msg00159.html>). */
1583 for (p
= c_result
; (*p
> 0) && (*p
!= CHAR_MAX
); p
++)
1584 result
= scm_cons (SCM_I_MAKINUM ((int) *p
), result
);
1587 SCM last_pair
= result
;
1589 result
= scm_reverse_x (result
, SCM_EOL
);
1593 /* Cyclic grouping information. */
1594 if (last_pair
!= SCM_EOL
)
1595 SCM_SETCDR (last_pair
, result
);
1604 #if (defined FRAC_DIGITS) && (defined INT_FRAC_DIGITS)
1606 case INT_FRAC_DIGITS
:
1607 /* This is to be interpreted as a single integer. */
1608 if (*c_result
== CHAR_MAX
)
1610 result
= SCM_BOOL_F
;
1612 result
= SCM_I_MAKINUM (*c_result
);
1618 #if (defined P_CS_PRECEDES) && (defined INT_N_CS_PRECEDES)
1621 case INT_P_CS_PRECEDES
:
1622 case INT_N_CS_PRECEDES
:
1623 #if (defined P_SEP_BY_SPACE) && (defined N_SEP_BY_SPACE)
1624 case P_SEP_BY_SPACE
:
1625 case N_SEP_BY_SPACE
:
1627 /* This is to be interpreted as a boolean. */
1628 result
= scm_from_bool (*c_result
);
1634 #if (defined P_SIGN_POSN) && (defined INT_N_SIGN_POSN)
1637 case INT_P_SIGN_POSN
:
1638 case INT_N_SIGN_POSN
:
1639 /* See `(libc) Sign of Money Amount' for the interpretation of the
1640 return value here. */
1644 result
= scm_from_latin1_symbol ("parenthesize");
1648 result
= scm_from_latin1_symbol ("sign-before");
1652 result
= scm_from_latin1_symbol ("sign-after");
1656 result
= scm_from_latin1_symbol ("sign-before-currency-symbol");
1660 result
= scm_from_latin1_symbol ("sign-after-currency-symbol");
1664 result
= scm_from_latin1_symbol ("unspecified");
1670 #ifdef HAVE_LANGINFO_CODESET
1671 result
= scm_from_stringn (c_result
, strlen (c_result
),
1673 SCM_FAILED_CONVERSION_QUESTION_MARK
);
1674 #else /* !HAVE_LANGINFO_CODESET */
1675 /* This may be incorrectly encoded if the locale differs
1676 from the c_locale. */
1677 result
= scm_from_locale_string (c_result
);
1678 #endif /* !HAVE_LANGINFO_CODESET */
1685 scm_syserror_msg (FUNC_NAME
, "`nl-langinfo' not supported on your system",
1693 /* Define the `nl_item' constants. */
1695 define_langinfo_items (void)
1697 #ifdef HAVE_LANGINFO_H
1699 #define DEFINE_NLITEM_CONSTANT(_item) \
1700 scm_c_define (# _item, scm_from_int (_item))
1702 DEFINE_NLITEM_CONSTANT (CODESET
);
1704 /* Abbreviated days of the week. */
1705 DEFINE_NLITEM_CONSTANT (ABDAY_1
);
1706 DEFINE_NLITEM_CONSTANT (ABDAY_2
);
1707 DEFINE_NLITEM_CONSTANT (ABDAY_3
);
1708 DEFINE_NLITEM_CONSTANT (ABDAY_4
);
1709 DEFINE_NLITEM_CONSTANT (ABDAY_5
);
1710 DEFINE_NLITEM_CONSTANT (ABDAY_6
);
1711 DEFINE_NLITEM_CONSTANT (ABDAY_7
);
1713 /* Long-named days of the week. */
1714 DEFINE_NLITEM_CONSTANT (DAY_1
); /* Sunday */
1715 DEFINE_NLITEM_CONSTANT (DAY_2
); /* Monday */
1716 DEFINE_NLITEM_CONSTANT (DAY_3
); /* Tuesday */
1717 DEFINE_NLITEM_CONSTANT (DAY_4
); /* Wednesday */
1718 DEFINE_NLITEM_CONSTANT (DAY_5
); /* Thursday */
1719 DEFINE_NLITEM_CONSTANT (DAY_6
); /* Friday */
1720 DEFINE_NLITEM_CONSTANT (DAY_7
); /* Saturday */
1722 /* Abbreviated month names. */
1723 DEFINE_NLITEM_CONSTANT (ABMON_1
); /* Jan */
1724 DEFINE_NLITEM_CONSTANT (ABMON_2
);
1725 DEFINE_NLITEM_CONSTANT (ABMON_3
);
1726 DEFINE_NLITEM_CONSTANT (ABMON_4
);
1727 DEFINE_NLITEM_CONSTANT (ABMON_5
);
1728 DEFINE_NLITEM_CONSTANT (ABMON_6
);
1729 DEFINE_NLITEM_CONSTANT (ABMON_7
);
1730 DEFINE_NLITEM_CONSTANT (ABMON_8
);
1731 DEFINE_NLITEM_CONSTANT (ABMON_9
);
1732 DEFINE_NLITEM_CONSTANT (ABMON_10
);
1733 DEFINE_NLITEM_CONSTANT (ABMON_11
);
1734 DEFINE_NLITEM_CONSTANT (ABMON_12
);
1736 /* Long month names. */
1737 DEFINE_NLITEM_CONSTANT (MON_1
); /* January */
1738 DEFINE_NLITEM_CONSTANT (MON_2
);
1739 DEFINE_NLITEM_CONSTANT (MON_3
);
1740 DEFINE_NLITEM_CONSTANT (MON_4
);
1741 DEFINE_NLITEM_CONSTANT (MON_5
);
1742 DEFINE_NLITEM_CONSTANT (MON_6
);
1743 DEFINE_NLITEM_CONSTANT (MON_7
);
1744 DEFINE_NLITEM_CONSTANT (MON_8
);
1745 DEFINE_NLITEM_CONSTANT (MON_9
);
1746 DEFINE_NLITEM_CONSTANT (MON_10
);
1747 DEFINE_NLITEM_CONSTANT (MON_11
);
1748 DEFINE_NLITEM_CONSTANT (MON_12
);
1750 DEFINE_NLITEM_CONSTANT (AM_STR
); /* Ante meridiem string. */
1751 DEFINE_NLITEM_CONSTANT (PM_STR
); /* Post meridiem string. */
1753 DEFINE_NLITEM_CONSTANT (D_T_FMT
); /* Date and time format for strftime. */
1754 DEFINE_NLITEM_CONSTANT (D_FMT
); /* Date format for strftime. */
1755 DEFINE_NLITEM_CONSTANT (T_FMT
); /* Time format for strftime. */
1756 DEFINE_NLITEM_CONSTANT (T_FMT_AMPM
);/* 12-hour time format for strftime. */
1758 DEFINE_NLITEM_CONSTANT (ERA
); /* Alternate era. */
1759 DEFINE_NLITEM_CONSTANT (ERA_D_FMT
); /* Date in alternate era format. */
1760 DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT
); /* Date and time in alternate era
1762 DEFINE_NLITEM_CONSTANT (ERA_T_FMT
); /* Time in alternate era format. */
1764 DEFINE_NLITEM_CONSTANT (ALT_DIGITS
); /* Alternate symbols for digits. */
1765 DEFINE_NLITEM_CONSTANT (RADIXCHAR
);
1766 DEFINE_NLITEM_CONSTANT (THOUSEP
);
1769 DEFINE_NLITEM_CONSTANT (YESEXPR
);
1772 DEFINE_NLITEM_CONSTANT (NOEXPR
);
1775 #ifdef CRNCYSTR /* currency symbol */
1776 DEFINE_NLITEM_CONSTANT (CRNCYSTR
);
1779 /* GNU extensions. */
1782 DEFINE_NLITEM_CONSTANT (ERA_YEAR
); /* Year in alternate era format. */
1785 /* LC_MONETARY category: formatting of monetary quantities.
1786 These items each correspond to a member of `struct lconv',
1787 defined in <locale.h>. */
1788 #ifdef INT_CURR_SYMBOL
1789 DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL
);
1791 #ifdef MON_DECIMAL_POINT
1792 DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT
);
1794 #ifdef MON_THOUSANDS_SEP
1795 DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP
);
1798 DEFINE_NLITEM_CONSTANT (MON_GROUPING
);
1800 #ifdef POSITIVE_SIGN
1801 DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN
);
1803 #ifdef NEGATIVE_SIGN
1804 DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN
);
1807 DEFINE_NLITEM_CONSTANT (GROUPING
);
1809 #ifdef INT_FRAC_DIGITS
1810 DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS
);
1813 DEFINE_NLITEM_CONSTANT (FRAC_DIGITS
);
1815 #ifdef P_CS_PRECEDES
1816 DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES
);
1818 #ifdef P_SEP_BY_SPACE
1819 DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE
);
1821 #ifdef N_CS_PRECEDES
1822 DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES
);
1824 #ifdef N_SEP_BY_SPACE
1825 DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE
);
1828 DEFINE_NLITEM_CONSTANT (P_SIGN_POSN
);
1831 DEFINE_NLITEM_CONSTANT (N_SIGN_POSN
);
1833 #ifdef INT_P_CS_PRECEDES
1834 DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES
);
1836 #ifdef INT_P_SEP_BY_SPACE
1837 DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE
);
1839 #ifdef INT_N_CS_PRECEDES
1840 DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES
);
1842 #ifdef INT_N_SEP_BY_SPACE
1843 DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE
);
1845 #ifdef INT_P_SIGN_POSN
1846 DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN
);
1848 #ifdef INT_N_SIGN_POSN
1849 DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN
);
1852 #undef DEFINE_NLITEM_CONSTANT
1854 #endif /* HAVE_NL_TYPES_H */
1861 SCM global_locale_smob
;
1863 #ifdef HAVE_NL_LANGINFO
1864 scm_add_feature ("nl-langinfo");
1865 define_langinfo_items ();
1868 #include "libguile/i18n.x"
1870 /* Initialize the global locale object with a special `locale' SMOB. */
1871 /* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
1872 glibc <= 2.11 not (yet) worked around by Gnulib. See
1873 http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details. */
1874 SCM_NEWSMOB (global_locale_smob
, scm_tc16_locale_smob_type
, NULL
);
1875 SCM_VARIABLE_SET (scm_global_locale
, global_locale_smob
);
1879 scm_bootstrap_i18n ()
1881 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
1883 (scm_t_extension_init_func
) scm_init_i18n
,