1 /* Copyright (C) 2006, 2007, 2008 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
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but 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 02110-1301 USA
24 #include "libguile/_scm.h"
25 #include "libguile/feature.h"
26 #include "libguile/i18n.h"
27 #include "libguile/strings.h"
28 #include "libguile/chars.h"
29 #include "libguile/dynwind.h"
30 #include "libguile/validate.h"
31 #include "libguile/values.h"
32 #include "libguile/threads.h"
35 #include <string.h> /* `strcoll ()' */
36 #include <ctype.h> /* `toupper ()' et al. */
39 #if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
40 /* The GNU thread-aware locale API is documented in ``Thread-Aware Locale
41 Model, a Proposal'', by Ulrich Drepper:
43 http://people.redhat.com/drepper/tllocale.ps.gz
45 It is now also implemented by Darwin:
47 http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/newlocale.3.html
49 The whole API was eventually standardized in the ``Open Group Base
50 Specifications Issue 7'' (aka. "POSIX 2008"):
52 http://www.opengroup.org/onlinepubs/9699919799/basedefs/locale.h.html */
53 # define USE_GNU_LOCALE_API
56 #if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H)
60 #include "libguile/posix.h" /* for `scm_i_locale_mutex' */
62 #if (defined HAVE_LANGINFO_H) && (defined HAVE_NL_TYPES_H)
63 # include <langinfo.h>
64 # include <nl_types.h>
67 #ifndef HAVE_SETLOCALE
69 setlocale (int category
, const char *name
)
76 /* Helper stringification macro. */
77 #define SCM_I18N_STRINGIFY(_name) # _name
81 /* Locale objects, string and character collation, and other locale-dependent
84 A large part of the code here deals with emulating glibc's reentrant
85 locale API on non-GNU systems. The emulation is a bit "brute-force":
86 Whenever a `-locale<?' procedure is passed a locale object, then:
88 1. The `scm_i_locale_mutex' is locked.
89 2. A series of `setlocale ()' call is performed to store the current
90 locale for each category in an `scm_t_locale' object.
91 3. A series of `setlocale ()' call is made to install each of the locale
92 categories of each of the base locales of each locale object,
93 recursively, starting from the last locale object of the chain.
94 4. The settings captured in step (2) are restored.
95 5. The `scm_i_locale_mutex' is released.
97 Hopefully, the X/Open standard will eventually make this hack useless.
99 Note: We don't wrap glibc's `uselocale ()' call because it sets the locale
100 of the current _thread_ (unlike `setlocale ()') and doing so would require
101 maintaining per-thread locale information on non-GNU systems and always
102 re-installing this locale upon locale-dependent calls. */
105 /* Return the category mask corresponding to CAT. */
106 #define SCM_LOCALE_CATEGORY_MASK(_cat) LC_ ## _cat ## _MASK
109 #ifndef USE_GNU_LOCALE_API
111 /* Provide the locale category masks as found in glibc. This must be kept in
112 sync with `locale-categories.h'. */
114 # define LC_CTYPE_MASK 1
115 # define LC_COLLATE_MASK 2
116 # define LC_MESSAGES_MASK 4
117 # define LC_MONETARY_MASK 8
118 # define LC_NUMERIC_MASK 16
119 # define LC_TIME_MASK 32
122 # define LC_PAPER_MASK 64
124 # define LC_PAPER_MASK 0
127 # define LC_NAME_MASK 128
129 # define LC_NAME_MASK 0
132 # define LC_ADDRESS_MASK 256
134 # define LC_ADDRESS_MASK 0
137 # define LC_TELEPHONE_MASK 512
139 # define LC_TELEPHONE_MASK 0
141 # ifdef LC_MEASUREMENT
142 # define LC_MEASUREMENT_MASK 1024
144 # define LC_MEASUREMENT_MASK 0
146 # ifdef LC_IDENTIFICATION
147 # define LC_IDENTIFICATION_MASK 2048
149 # define LC_IDENTIFICATION_MASK 0
152 # define LC_ALL_MASK (LC_CTYPE_MASK \
161 | LC_TELEPHONE_MASK \
162 | LC_MEASUREMENT_MASK \
163 | LC_IDENTIFICATION_MASK \
166 /* Locale objects as returned by `make-locale' on non-GNU systems. */
167 typedef struct scm_locale
169 SCM base_locale
; /* a `locale' object */
175 /* Free the resources used by LOCALE. */
177 scm_i_locale_free (scm_t_locale locale
)
179 free (locale
->locale_name
);
180 locale
->locale_name
= NULL
;
183 #else /* USE_GNU_LOCALE_API */
185 /* Alias for glibc's locale type. */
186 typedef locale_t scm_t_locale
;
188 #define scm_i_locale_free freelocale
190 #endif /* USE_GNU_LOCALE_API */
193 /* A locale object denoting the global locale. */
194 SCM_GLOBAL_VARIABLE (scm_global_locale
, "%global-locale");
197 /* Validate parameter ARG as a locale object and set C_LOCALE to the
198 corresponding C locale object. */
199 #define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale) \
202 SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type); \
203 (_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg); \
207 /* Validate optional parameter ARG as either undefined or bound to a locale
208 object. Set C_LOCALE to the corresponding C locale object or NULL. */
209 #define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \
212 if ((_arg) != SCM_UNDEFINED) \
213 SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \
215 (_c_locale) = NULL; \
220 SCM_SMOB (scm_tc16_locale_smob_type
, "locale", 0);
222 SCM_SMOB_FREE (scm_tc16_locale_smob_type
, smob_locale_free
, locale
)
224 scm_t_locale c_locale
;
226 c_locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
);
227 scm_i_locale_free (c_locale
);
232 #ifndef USE_GNU_LOCALE_API
234 smob_locale_mark (SCM locale
)
236 register SCM dependency
;
238 if (!scm_is_eq (locale
, SCM_VARIABLE_REF (scm_global_locale
)))
240 scm_t_locale c_locale
;
242 c_locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
);
243 dependency
= (c_locale
->base_locale
);
246 dependency
= SCM_BOOL_F
;
253 static void inline scm_locale_error (const char *, int) SCM_NORETURN
;
255 /* Throw an exception corresponding to error ERR. */
257 scm_locale_error (const char *func_name
, int err
)
259 scm_syserror_msg (func_name
,
260 "Failed to install locale",
266 /* Emulating GNU's reentrant locale API. */
267 #ifndef USE_GNU_LOCALE_API
270 /* Maximum number of chained locales (via `base_locale'). */
271 #define LOCALE_STACK_SIZE_MAX 256
275 #define SCM_DEFINE_LOCALE_CATEGORY(_name) char * _name;
276 #include "locale-categories.h"
277 #undef SCM_DEFINE_LOCALE_CATEGORY
278 } scm_t_locale_settings
;
280 /* Fill out SETTINGS according to the current locale settings. On success
281 zero is returned and SETTINGS is properly initialized. */
283 get_current_locale_settings (scm_t_locale_settings
*settings
)
285 const char *locale_name
;
287 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
289 SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \
290 if (locale_name == NULL) \
293 settings-> _name = strdup (locale_name); \
294 if (settings-> _name == NULL) \
298 #include "locale-categories.h"
299 #undef SCM_DEFINE_LOCALE_CATEGORY
310 /* Restore locale settings SETTINGS. On success, return zero. */
312 restore_locale_settings (const scm_t_locale_settings
*settings
)
316 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
317 SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name)); \
318 if (result == NULL) \
321 #include "locale-categories.h"
322 #undef SCM_DEFINE_LOCALE_CATEGORY
330 /* Free memory associated with SETTINGS. */
332 free_locale_settings (scm_t_locale_settings
*settings
)
334 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
335 free (settings-> _name); \
336 settings->_name = NULL;
337 #include "locale-categories.h"
338 #undef SCM_DEFINE_LOCALE_CATEGORY
341 /* Install the locale named LOCALE_NAME for all the categories listed in
344 install_locale_categories (const char *locale_name
, int category_mask
)
348 if (category_mask
== LC_ALL_MASK
)
350 SCM_SYSCALL (result
= setlocale (LC_ALL
, locale_name
));
356 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
357 if (category_mask & SCM_LOCALE_CATEGORY_MASK (_name)) \
359 SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \
360 if (result == NULL) \
363 #include "locale-categories.h"
364 #undef SCM_DEFINE_LOCALE_CATEGORY
373 /* Install LOCALE, recursively installing its base locales first. On
374 success, zero is returned. */
376 install_locale (scm_t_locale locale
)
378 scm_t_locale stack
[LOCALE_STACK_SIZE_MAX
];
379 int category_mask
= 0;
380 size_t stack_size
= 0;
381 int stack_offset
= 0;
382 const char *result
= NULL
;
384 /* Build up a locale stack by traversing the `base_locale' link. */
387 if (stack_size
>= LOCALE_STACK_SIZE_MAX
)
388 /* We cannot use `scm_error ()' here because otherwise the locale
389 mutex may remain locked. */
392 stack
[stack_size
++] = locale
;
394 /* Keep track of which categories have already been taken into
396 category_mask
|= locale
->category_mask
;
398 if (locale
->base_locale
!= SCM_UNDEFINED
)
399 locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
->base_locale
);
403 while ((locale
!= NULL
) && (category_mask
!= LC_ALL_MASK
));
405 /* Install the C locale to start from a pristine state. */
406 SCM_SYSCALL (result
= setlocale (LC_ALL
, "C"));
410 /* Install the locales in reverse order. */
411 for (stack_offset
= stack_size
- 1;
418 locale
= stack
[stack_offset
];
419 err
= install_locale_categories (locale
->locale_name
,
420 locale
->category_mask
);
431 /* Leave the locked locale section. */
433 leave_locale_section (const scm_t_locale_settings
*settings
)
435 /* Restore the previous locale settings. */
436 (void)restore_locale_settings (settings
);
438 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
441 /* Enter a locked locale section. */
443 enter_locale_section (scm_t_locale locale
,
444 scm_t_locale_settings
*prev_locale
)
448 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
450 err
= get_current_locale_settings (prev_locale
);
453 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
457 err
= install_locale (locale
);
460 leave_locale_section (prev_locale
);
461 free_locale_settings (prev_locale
);
467 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
468 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
472 scm_t_locale_settings lsec_prev_locale; \
474 lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale); \
476 scm_locale_error (FUNC_NAME, lsec_err); \
481 leave_locale_section (&lsec_prev_locale); \
482 free_locale_settings (&lsec_prev_locale); \
487 /* Convert the current locale settings into a locale SMOB. On success, zero
488 is returned and RESULT points to the new SMOB. Otherwise, an error is
491 get_current_locale (SCM
*result
)
494 scm_t_locale c_locale
;
495 const char *current_locale
;
497 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
500 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
502 c_locale
->category_mask
= LC_ALL_MASK
;
503 c_locale
->base_locale
= SCM_UNDEFINED
;
505 current_locale
= setlocale (LC_ALL
, NULL
);
506 if (current_locale
!= NULL
)
508 c_locale
->locale_name
= strdup (current_locale
);
509 if (c_locale
->locale_name
== NULL
)
515 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
518 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
520 SCM_NEWSMOB (*result
, scm_tc16_locale_smob_type
, c_locale
);
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
)))
624 /* Fetch the current locale and turn in into a `locale_t'. Don't
625 duplicate the resulting `locale_t' because we want it to be consumed
626 by `newlocale ()'. */
627 char *current_locale
;
629 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
631 current_locale
= setlocale (LC_ALL
, NULL
);
632 c_base_locale
= newlocale (LC_ALL_MASK
, current_locale
, NULL
);
634 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
636 if (c_base_locale
== (locale_t
) 0)
637 scm_locale_error (FUNC_NAME
, errno
);
639 else if (c_base_locale
!= (locale_t
) 0)
641 /* C_BASE_LOCALE is to be consumed by `newlocale ()' so it needs to be
642 duplicated before. */
643 c_base_locale
= duplocale (c_base_locale
);
644 if (c_base_locale
== (locale_t
) 0)
651 c_locale
= newlocale (c_category_mask
, c_locale_name
, c_base_locale
);
653 free (c_locale_name
);
655 if (c_locale
== (locale_t
) 0)
657 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
658 /* The base locale object was created lazily and must be freed. */
659 freelocale (c_base_locale
);
661 scm_locale_error (FUNC_NAME
, errno
);
664 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
668 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
670 c_locale
->category_mask
= c_category_mask
;
671 c_locale
->locale_name
= c_locale_name
;
673 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
675 /* Get the current locale settings and turn them into a locale
677 err
= get_current_locale (&base_locale
);
682 c_locale
->base_locale
= base_locale
;
685 /* Try out the new locale and raise an exception if it doesn't work. */
687 scm_t_locale_settings prev_locale
;
689 err
= enter_locale_section (c_locale
, &prev_locale
);
695 leave_locale_section (&prev_locale
);
696 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
705 #ifndef USE_GNU_LOCALE_API
706 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
708 free (c_locale_name
);
709 scm_locale_error (FUNC_NAME
, err
);
715 SCM_DEFINE (scm_locale_p
, "locale?", 1, 0, 0,
717 "Return true if @var{obj} is a locale object.")
718 #define FUNC_NAME s_scm_locale_p
720 return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type
, obj
));
726 /* Locale-dependent string comparison.
728 A similar API can be found in MzScheme starting from version 200:
729 http://download.plt-scheme.org/chronology/mzmr200alpha14.html . */
732 /* Compare null-terminated strings C_S1 and C_S2 according to LOCALE. Return
733 an integer whose sign is the same as the difference between C_S1 and
736 compare_strings (const char *c_s1
, const char *c_s2
, SCM locale
,
737 const char *func_name
)
738 #define FUNC_NAME func_name
741 scm_t_locale c_locale
;
743 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
747 #ifdef USE_GNU_LOCALE_API
748 result
= strcoll_l (c_s1
, c_s2
, c_locale
);
751 RUN_IN_LOCALE_SECTION (c_locale
, result
= strcoll (c_s1
, c_s2
));
753 result
= strcmp (c_s1
, c_s2
);
755 #endif /* !USE_GNU_LOCALE_API */
760 result
= strcoll (c_s1
, c_s2
);
762 result
= strcmp (c_s1
, c_s2
);
769 /* Store into DST an upper-case version of SRC. */
771 str_upcase (register char *dst
, register const char *src
)
773 for (; *src
!= '\0'; src
++, dst
++)
774 *dst
= toupper ((int) *src
);
779 str_downcase (register char *dst
, register const char *src
)
781 for (; *src
!= '\0'; src
++, dst
++)
782 *dst
= tolower ((int) *src
);
786 #ifdef USE_GNU_LOCALE_API
788 str_upcase_l (register char *dst
, register const char *src
,
791 for (; *src
!= '\0'; src
++, dst
++)
792 *dst
= toupper_l (*src
, locale
);
797 str_downcase_l (register char *dst
, register const char *src
,
800 for (; *src
!= '\0'; src
++, dst
++)
801 *dst
= tolower_l (*src
, locale
);
807 /* Compare null-terminated strings C_S1 and C_S2 in a case-independent way
808 according to LOCALE. Return an integer whose sign is the same as the
809 difference between C_S1 and C_S2. */
811 compare_strings_ci (const char *c_s1
, const char *c_s2
, SCM locale
,
812 const char *func_name
)
813 #define FUNC_NAME func_name
816 scm_t_locale c_locale
;
819 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
821 c_us1
= (char *) alloca (strlen (c_s1
) + 1);
822 c_us2
= (char *) alloca (strlen (c_s2
) + 1);
826 #ifdef USE_GNU_LOCALE_API
827 str_upcase_l (c_us1
, c_s1
, c_locale
);
828 str_upcase_l (c_us2
, c_s2
, c_locale
);
830 result
= strcoll_l (c_us1
, c_us2
, c_locale
);
833 scm_t_locale_settings prev_locale
;
835 err
= enter_locale_section (c_locale
, &prev_locale
);
838 scm_locale_error (func_name
, err
);
842 str_upcase (c_us1
, c_s1
);
843 str_upcase (c_us2
, c_s2
);
846 result
= strcoll (c_us1
, c_us2
);
848 result
= strcmp (c_us1
, c_us2
);
849 #endif /* !HAVE_STRCOLL */
851 leave_locale_section (&prev_locale
);
852 free_locale_settings (&prev_locale
);
853 #endif /* !USE_GNU_LOCALE_API */
857 str_upcase (c_us1
, c_s1
);
858 str_upcase (c_us2
, c_s2
);
861 result
= strcoll (c_us1
, c_us2
);
863 result
= strcmp (c_us1
, c_us2
);
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
881 const char *c_s1
, *c_s2
;
883 SCM_VALIDATE_STRING (1, s1
);
884 SCM_VALIDATE_STRING (2, s2
);
886 c_s1
= scm_i_string_chars (s1
);
887 c_s2
= scm_i_string_chars (s2
);
889 result
= compare_strings (c_s1
, c_s2
, locale
, FUNC_NAME
);
891 scm_remember_upto_here_2 (s1
, s2
);
893 return scm_from_bool (result
< 0);
897 SCM_DEFINE (scm_string_locale_gt
, "string-locale>?", 2, 1, 0,
898 (SCM s1
, SCM s2
, SCM locale
),
899 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
900 "If @var{locale} is provided, it should be locale object (as "
901 "returned by @code{make-locale}) and will be used to perform the "
902 "comparison; otherwise, the current system locale is used.")
903 #define FUNC_NAME s_scm_string_locale_gt
906 const char *c_s1
, *c_s2
;
908 SCM_VALIDATE_STRING (1, s1
);
909 SCM_VALIDATE_STRING (2, s2
);
911 c_s1
= scm_i_string_chars (s1
);
912 c_s2
= scm_i_string_chars (s2
);
914 result
= compare_strings (c_s1
, c_s2
, locale
, FUNC_NAME
);
916 scm_remember_upto_here_2 (s1
, s2
);
918 return scm_from_bool (result
> 0);
922 SCM_DEFINE (scm_string_locale_ci_lt
, "string-locale-ci<?", 2, 1, 0,
923 (SCM s1
, SCM s2
, SCM locale
),
924 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
925 "and locale-dependent way. If @var{locale} is provided, it "
926 "should be locale object (as returned by @code{make-locale}) "
927 "and will be used to perform the comparison; otherwise, the "
928 "current system locale is used.")
929 #define FUNC_NAME s_scm_string_locale_ci_lt
932 const char *c_s1
, *c_s2
;
934 SCM_VALIDATE_STRING (1, s1
);
935 SCM_VALIDATE_STRING (2, s2
);
937 c_s1
= scm_i_string_chars (s1
);
938 c_s2
= scm_i_string_chars (s2
);
940 result
= compare_strings_ci (c_s1
, c_s2
, locale
, FUNC_NAME
);
942 scm_remember_upto_here_2 (s1
, s2
);
944 return scm_from_bool (result
< 0);
948 SCM_DEFINE (scm_string_locale_ci_gt
, "string-locale-ci>?", 2, 1, 0,
949 (SCM s1
, SCM s2
, SCM locale
),
950 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
951 "and locale-dependent way. If @var{locale} is provided, it "
952 "should be locale object (as returned by @code{make-locale}) "
953 "and will be used to perform the comparison; otherwise, the "
954 "current system locale is used.")
955 #define FUNC_NAME s_scm_string_locale_ci_gt
958 const char *c_s1
, *c_s2
;
960 SCM_VALIDATE_STRING (1, s1
);
961 SCM_VALIDATE_STRING (2, s2
);
963 c_s1
= scm_i_string_chars (s1
);
964 c_s2
= scm_i_string_chars (s2
);
966 result
= compare_strings_ci (c_s1
, c_s2
, locale
, FUNC_NAME
);
968 scm_remember_upto_here_2 (s1
, s2
);
970 return scm_from_bool (result
> 0);
974 SCM_DEFINE (scm_string_locale_ci_eq
, "string-locale-ci=?", 2, 1, 0,
975 (SCM s1
, SCM s2
, SCM locale
),
976 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
977 "and locale-dependent way. If @var{locale} is provided, it "
978 "should be locale object (as returned by @code{make-locale}) "
979 "and will be used to perform the comparison; otherwise, the "
980 "current system locale is used.")
981 #define FUNC_NAME s_scm_string_locale_ci_eq
984 const char *c_s1
, *c_s2
;
986 SCM_VALIDATE_STRING (1, s1
);
987 SCM_VALIDATE_STRING (2, s2
);
989 c_s1
= scm_i_string_chars (s1
);
990 c_s2
= scm_i_string_chars (s2
);
992 result
= compare_strings_ci (c_s1
, c_s2
, locale
, FUNC_NAME
);
994 scm_remember_upto_here_2 (s1
, s2
);
996 return scm_from_bool (result
== 0);
1001 SCM_DEFINE (scm_char_locale_lt
, "char-locale<?", 2, 1, 0,
1002 (SCM c1
, SCM c2
, SCM locale
),
1003 "Return true if character @var{c1} is lower than @var{c2} "
1004 "according to @var{locale} or to the current locale.")
1005 #define FUNC_NAME s_scm_char_locale_lt
1007 char c_c1
[2], c_c2
[2];
1009 SCM_VALIDATE_CHAR (1, c1
);
1010 SCM_VALIDATE_CHAR (2, c2
);
1012 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1013 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1015 return scm_from_bool (compare_strings (c_c1
, c_c2
, locale
, FUNC_NAME
) < 0);
1019 SCM_DEFINE (scm_char_locale_gt
, "char-locale>?", 2, 1, 0,
1020 (SCM c1
, SCM c2
, SCM locale
),
1021 "Return true if character @var{c1} is greater than @var{c2} "
1022 "according to @var{locale} or to the current locale.")
1023 #define FUNC_NAME s_scm_char_locale_gt
1025 char c_c1
[2], c_c2
[2];
1027 SCM_VALIDATE_CHAR (1, c1
);
1028 SCM_VALIDATE_CHAR (2, c2
);
1030 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1031 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1033 return scm_from_bool (compare_strings (c_c1
, c_c2
, locale
, FUNC_NAME
) > 0);
1037 SCM_DEFINE (scm_char_locale_ci_lt
, "char-locale-ci<?", 2, 1, 0,
1038 (SCM c1
, SCM c2
, SCM locale
),
1039 "Return true if character @var{c1} is lower than @var{c2}, "
1040 "in a case insensitive way according to @var{locale} or to "
1041 "the current locale.")
1042 #define FUNC_NAME s_scm_char_locale_ci_lt
1045 char c_c1
[2], c_c2
[2];
1047 SCM_VALIDATE_CHAR (1, c1
);
1048 SCM_VALIDATE_CHAR (2, c2
);
1050 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1051 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1053 result
= compare_strings_ci (c_c1
, c_c2
, locale
, FUNC_NAME
);
1055 return scm_from_bool (result
< 0);
1059 SCM_DEFINE (scm_char_locale_ci_gt
, "char-locale-ci>?", 2, 1, 0,
1060 (SCM c1
, SCM c2
, SCM locale
),
1061 "Return true if character @var{c1} is greater than @var{c2}, "
1062 "in a case insensitive way according to @var{locale} or to "
1063 "the current locale.")
1064 #define FUNC_NAME s_scm_char_locale_ci_gt
1067 char c_c1
[2], c_c2
[2];
1069 SCM_VALIDATE_CHAR (1, c1
);
1070 SCM_VALIDATE_CHAR (2, c2
);
1072 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1073 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1075 result
= compare_strings_ci (c_c1
, c_c2
, locale
, FUNC_NAME
);
1077 return scm_from_bool (result
> 0);
1081 SCM_DEFINE (scm_char_locale_ci_eq
, "char-locale-ci=?", 2, 1, 0,
1082 (SCM c1
, SCM c2
, SCM locale
),
1083 "Return true if character @var{c1} is equal to @var{c2}, "
1084 "in a case insensitive way according to @var{locale} or to "
1085 "the current locale.")
1086 #define FUNC_NAME s_scm_char_locale_ci_eq
1089 char c_c1
[2], c_c2
[2];
1091 SCM_VALIDATE_CHAR (1, c1
);
1092 SCM_VALIDATE_CHAR (2, c2
);
1094 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1095 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1097 result
= compare_strings_ci (c_c1
, c_c2
, locale
, FUNC_NAME
);
1099 return scm_from_bool (result
== 0);
1105 /* Locale-dependent alphabetic character mapping. */
1107 SCM_DEFINE (scm_char_locale_downcase
, "char-locale-downcase", 1, 1, 0,
1108 (SCM chr
, SCM locale
),
1109 "Return the lowercase character that corresponds to @var{chr} "
1110 "according to either @var{locale} or the current locale.")
1111 #define FUNC_NAME s_scm_char_locale_downcase
1115 scm_t_locale c_locale
;
1117 SCM_VALIDATE_CHAR (1, chr
);
1118 c_chr
= SCM_CHAR (chr
);
1120 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1122 if (c_locale
!= NULL
)
1124 #ifdef USE_GNU_LOCALE_API
1125 c_result
= tolower_l ((int) c_chr
, c_locale
);
1127 RUN_IN_LOCALE_SECTION (c_locale
, c_result
= tolower ((int) c_chr
));
1131 c_result
= tolower ((int) c_chr
);
1133 return (SCM_MAKE_CHAR (c_result
));
1137 SCM_DEFINE (scm_char_locale_upcase
, "char-locale-upcase", 1, 1, 0,
1138 (SCM chr
, SCM locale
),
1139 "Return the uppercase character that corresponds to @var{chr} "
1140 "according to either @var{locale} or the current locale.")
1141 #define FUNC_NAME s_scm_char_locale_upcase
1145 scm_t_locale c_locale
;
1147 SCM_VALIDATE_CHAR (1, chr
);
1148 c_chr
= SCM_CHAR (chr
);
1150 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1152 if (c_locale
!= NULL
)
1154 #ifdef USE_GNU_LOCALE_API
1155 c_result
= toupper_l ((int) c_chr
, c_locale
);
1157 RUN_IN_LOCALE_SECTION (c_locale
, c_result
= toupper ((int) c_chr
));
1161 c_result
= toupper ((int) c_chr
);
1163 return (SCM_MAKE_CHAR (c_result
));
1167 SCM_DEFINE (scm_string_locale_upcase
, "string-locale-upcase", 1, 1, 0,
1168 (SCM str
, SCM locale
),
1169 "Return a new string that is the uppercase version of "
1170 "@var{str} according to either @var{locale} or the current "
1172 #define FUNC_NAME s_scm_string_locale_upcase
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_ustr
= (char *) alloca (strlen (c_str
) + 1);
1186 #ifdef USE_GNU_LOCALE_API
1187 str_upcase_l (c_ustr
, c_str
, c_locale
);
1189 RUN_IN_LOCALE_SECTION (c_locale
, str_upcase (c_ustr
, c_str
));
1193 str_upcase (c_ustr
, c_str
);
1195 scm_remember_upto_here (str
);
1197 return (scm_from_locale_string (c_ustr
));
1201 SCM_DEFINE (scm_string_locale_downcase
, "string-locale-downcase", 1, 1, 0,
1202 (SCM str
, SCM locale
),
1203 "Return a new string that is the down-case version of "
1204 "@var{str} according to either @var{locale} or the current "
1206 #define FUNC_NAME s_scm_string_locale_downcase
1210 scm_t_locale c_locale
;
1212 SCM_VALIDATE_STRING (1, str
);
1213 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1215 c_str
= scm_i_string_chars (str
);
1216 c_lstr
= (char *) alloca (strlen (c_str
) + 1);
1220 #ifdef USE_GNU_LOCALE_API
1221 str_downcase_l (c_lstr
, c_str
, c_locale
);
1223 RUN_IN_LOCALE_SECTION (c_locale
, str_downcase (c_lstr
, c_str
));
1227 str_downcase (c_lstr
, c_str
);
1229 scm_remember_upto_here (str
);
1231 return (scm_from_locale_string (c_lstr
));
1235 /* Note: We don't provide mutative versions of `string-locale-(up|down)case'
1236 because, in some languages, a single downcase character maps to a couple
1237 of uppercase characters. Read the SRFI-13 document for a detailed
1238 discussion about this. */
1242 /* Locale-dependent number parsing. */
1244 SCM_DEFINE (scm_locale_string_to_integer
, "locale-string->integer",
1245 1, 2, 0, (SCM str
, SCM base
, SCM locale
),
1246 "Convert string @var{str} into an integer according to either "
1247 "@var{locale} (a locale object as returned by @code{make-locale}) "
1248 "or the current process locale. Return two values: an integer "
1249 "(on success) or @code{#f}, and the number of characters read "
1250 "from @var{str} (@code{0} on failure).")
1251 #define FUNC_NAME s_scm_locale_string_to_integer
1258 scm_t_locale c_locale
;
1260 SCM_VALIDATE_STRING (1, str
);
1261 c_str
= scm_i_string_chars (str
);
1263 if (base
!= SCM_UNDEFINED
)
1264 SCM_VALIDATE_INT_COPY (2, base
, c_base
);
1268 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
1270 if (c_locale
!= NULL
)
1272 #ifdef USE_GNU_LOCALE_API
1273 c_result
= strtol_l (c_str
, &c_endptr
, c_base
, c_locale
);
1275 RUN_IN_LOCALE_SECTION (c_locale
,
1276 c_result
= strtol (c_str
, &c_endptr
, c_base
));
1280 c_result
= strtol (c_str
, &c_endptr
, c_base
);
1282 scm_remember_upto_here (str
);
1284 if (c_endptr
== c_str
)
1285 result
= SCM_BOOL_F
;
1287 result
= scm_from_long (c_result
);
1289 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1293 SCM_DEFINE (scm_locale_string_to_inexact
, "locale-string->inexact",
1294 1, 1, 0, (SCM str
, SCM locale
),
1295 "Convert string @var{str} into an inexact number according to "
1296 "either @var{locale} (a locale object as returned by "
1297 "@code{make-locale}) or the current process locale. Return "
1298 "two values: an inexact number (on success) or @code{#f}, and "
1299 "the number of characters read from @var{str} (@code{0} on "
1301 #define FUNC_NAME s_scm_locale_string_to_inexact
1307 scm_t_locale c_locale
;
1309 SCM_VALIDATE_STRING (1, str
);
1310 c_str
= scm_i_string_chars (str
);
1312 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1314 if (c_locale
!= NULL
)
1316 #ifdef USE_GNU_LOCALE_API
1317 c_result
= strtod_l (c_str
, &c_endptr
, c_locale
);
1319 RUN_IN_LOCALE_SECTION (c_locale
,
1320 c_result
= strtod (c_str
, &c_endptr
));
1324 c_result
= strtod (c_str
, &c_endptr
);
1326 scm_remember_upto_here (str
);
1328 if (c_endptr
== c_str
)
1329 result
= SCM_BOOL_F
;
1331 result
= scm_from_double (c_result
);
1333 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1338 /* Language information, aka. `nl_langinfo ()'. */
1340 /* FIXME: Issues related to `nl-langinfo'.
1342 1. The `CODESET' value is not normalized. This is a secondary issue, but
1343 still a practical issue. See
1344 http://www.cl.cam.ac.uk/~mgk25/ucs/norm_charmap.c for codeset
1347 2. `nl_langinfo ()' is not available on Windows.
1349 3. `nl_langinfo ()' may return strings encoded in a locale different from
1350 the current one, thereby defeating `scm_from_locale_string ()'.
1351 Example: support the current locale is "Latin-1" and one asks:
1353 (nl-langinfo DAY_1 (make-locale LC_ALL "eo_EO.UTF-8"))
1355 The result will be a UTF-8 string. However, `scm_from_locale_string',
1356 which expects a Latin-1 string, won't be able to make much sense of the
1357 returned string. Thus, we'd need an `scm_from_string ()' variant where
1358 the locale (or charset) is explicitly passed. */
1361 SCM_DEFINE (scm_nl_langinfo
, "nl-langinfo", 1, 1, 0,
1362 (SCM item
, SCM locale
),
1363 "Return a string denoting locale information for @var{item} "
1364 "in the current locale or that specified by @var{locale}. "
1365 "The semantics and arguments are the same as those of the "
1366 "X/Open @code{nl_langinfo} function (@pxref{The Elegant and "
1367 "Fast Way, @code{nl_langinfo},, libc, The GNU C Library "
1368 "Reference Manual}).")
1369 #define FUNC_NAME s_scm_nl_langinfo
1371 #ifdef HAVE_NL_LANGINFO
1375 scm_t_locale c_locale
;
1377 SCM_VALIDATE_INT_COPY (2, item
, c_item
);
1378 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1380 /* Sadly, `nl_langinfo ()' returns a pointer to a static string. According
1381 to SuS v2, that static string may be modified by subsequent calls to
1382 `nl_langinfo ()' as well as by calls to `setlocale ()'. Thus, we must
1383 acquire the locale mutex before doing invoking `nl_langinfo ()'. See
1384 http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for
1387 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
1388 if (c_locale
!= NULL
)
1390 #ifdef USE_GNU_LOCALE_API
1391 c_result
= nl_langinfo_l (c_item
, c_locale
);
1393 /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
1394 mutex is already taken. */
1396 scm_t_locale_settings lsec_prev_locale
;
1398 lsec_err
= get_current_locale_settings (&lsec_prev_locale
);
1400 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1403 lsec_err
= install_locale (c_locale
);
1406 leave_locale_section (&lsec_prev_locale
);
1407 free_locale_settings (&lsec_prev_locale
);
1412 scm_locale_error (FUNC_NAME
, lsec_err
);
1415 c_result
= nl_langinfo (c_item
);
1417 restore_locale_settings (&lsec_prev_locale
);
1418 free_locale_settings (&lsec_prev_locale
);
1423 c_result
= nl_langinfo (c_item
);
1425 c_result
= strdup (c_result
);
1426 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1428 if (c_result
== NULL
)
1429 result
= SCM_BOOL_F
;
1434 #if (defined GROUPING) && (defined MON_GROUPING)
1440 /* In this cases, the result is to be interpreted as a list of
1441 numbers. If the last item is `CHARS_MAX', it has the special
1442 meaning "no more grouping". */
1444 for (p
= c_result
; (*p
!= '\0') && (*p
!= CHAR_MAX
); p
++)
1445 result
= scm_cons (SCM_I_MAKINUM ((int) *p
), result
);
1448 SCM last_pair
= result
;
1450 result
= scm_reverse_x (result
, SCM_EOL
);
1454 /* Cyclic grouping information. */
1455 if (last_pair
!= SCM_EOL
)
1456 SCM_SETCDR (last_pair
, result
);
1465 #if (defined FRAC_DIGITS) && (defined INT_FRAC_DIGITS)
1467 case INT_FRAC_DIGITS
:
1468 /* This is to be interpreted as a single integer. */
1469 if (*c_result
== CHAR_MAX
)
1471 result
= SCM_BOOL_F
;
1473 result
= SCM_I_MAKINUM (*c_result
);
1479 #if (defined P_CS_PRECEDES) && (defined INT_N_CS_PRECEDES)
1482 case INT_P_CS_PRECEDES
:
1483 case INT_N_CS_PRECEDES
:
1484 #if (defined P_SEP_BY_SPACE) && (defined N_SEP_BY_SPACE)
1485 case P_SEP_BY_SPACE
:
1486 case N_SEP_BY_SPACE
:
1488 /* This is to be interpreted as a boolean. */
1489 result
= scm_from_bool (*c_result
);
1495 #if (defined P_SIGN_POSN) && (defined INT_N_SIGN_POSN)
1498 case INT_P_SIGN_POSN
:
1499 case INT_N_SIGN_POSN
:
1500 /* See `(libc) Sign of Money Amount' for the interpretation of the
1501 return value here. */
1505 result
= scm_from_locale_symbol ("parenthesize");
1509 result
= scm_from_locale_symbol ("sign-before");
1513 result
= scm_from_locale_symbol ("sign-after");
1517 result
= scm_from_locale_symbol ("sign-before-currency-symbol");
1521 result
= scm_from_locale_symbol ("sign-after-currency-symbol");
1525 result
= scm_from_locale_symbol ("unspecified");
1531 /* FIXME: `locale_string ()' is not appropriate here because of
1532 encoding issues (see comment above). */
1533 result
= scm_take_locale_string (c_result
);
1539 scm_syserror_msg (FUNC_NAME
, "`nl-langinfo' not supported on your system",
1547 /* Define the `nl_item' constants. */
1549 define_langinfo_items (void)
1551 #if (defined HAVE_NL_TYPES_H) && (defined HAVE_LANGINFO_H)
1553 #define DEFINE_NLITEM_CONSTANT(_item) \
1554 scm_c_define (# _item, scm_from_int (_item))
1556 DEFINE_NLITEM_CONSTANT (CODESET
);
1558 /* Abbreviated days of the week. */
1559 DEFINE_NLITEM_CONSTANT (ABDAY_1
);
1560 DEFINE_NLITEM_CONSTANT (ABDAY_2
);
1561 DEFINE_NLITEM_CONSTANT (ABDAY_3
);
1562 DEFINE_NLITEM_CONSTANT (ABDAY_4
);
1563 DEFINE_NLITEM_CONSTANT (ABDAY_5
);
1564 DEFINE_NLITEM_CONSTANT (ABDAY_6
);
1565 DEFINE_NLITEM_CONSTANT (ABDAY_7
);
1567 /* Long-named days of the week. */
1568 DEFINE_NLITEM_CONSTANT (DAY_1
); /* Sunday */
1569 DEFINE_NLITEM_CONSTANT (DAY_2
); /* Monday */
1570 DEFINE_NLITEM_CONSTANT (DAY_3
); /* Tuesday */
1571 DEFINE_NLITEM_CONSTANT (DAY_4
); /* Wednesday */
1572 DEFINE_NLITEM_CONSTANT (DAY_5
); /* Thursday */
1573 DEFINE_NLITEM_CONSTANT (DAY_6
); /* Friday */
1574 DEFINE_NLITEM_CONSTANT (DAY_7
); /* Saturday */
1576 /* Abbreviated month names. */
1577 DEFINE_NLITEM_CONSTANT (ABMON_1
); /* Jan */
1578 DEFINE_NLITEM_CONSTANT (ABMON_2
);
1579 DEFINE_NLITEM_CONSTANT (ABMON_3
);
1580 DEFINE_NLITEM_CONSTANT (ABMON_4
);
1581 DEFINE_NLITEM_CONSTANT (ABMON_5
);
1582 DEFINE_NLITEM_CONSTANT (ABMON_6
);
1583 DEFINE_NLITEM_CONSTANT (ABMON_7
);
1584 DEFINE_NLITEM_CONSTANT (ABMON_8
);
1585 DEFINE_NLITEM_CONSTANT (ABMON_9
);
1586 DEFINE_NLITEM_CONSTANT (ABMON_10
);
1587 DEFINE_NLITEM_CONSTANT (ABMON_11
);
1588 DEFINE_NLITEM_CONSTANT (ABMON_12
);
1590 /* Long month names. */
1591 DEFINE_NLITEM_CONSTANT (MON_1
); /* January */
1592 DEFINE_NLITEM_CONSTANT (MON_2
);
1593 DEFINE_NLITEM_CONSTANT (MON_3
);
1594 DEFINE_NLITEM_CONSTANT (MON_4
);
1595 DEFINE_NLITEM_CONSTANT (MON_5
);
1596 DEFINE_NLITEM_CONSTANT (MON_6
);
1597 DEFINE_NLITEM_CONSTANT (MON_7
);
1598 DEFINE_NLITEM_CONSTANT (MON_8
);
1599 DEFINE_NLITEM_CONSTANT (MON_9
);
1600 DEFINE_NLITEM_CONSTANT (MON_10
);
1601 DEFINE_NLITEM_CONSTANT (MON_11
);
1602 DEFINE_NLITEM_CONSTANT (MON_12
);
1604 DEFINE_NLITEM_CONSTANT (AM_STR
); /* Ante meridiem string. */
1605 DEFINE_NLITEM_CONSTANT (PM_STR
); /* Post meridiem string. */
1607 DEFINE_NLITEM_CONSTANT (D_T_FMT
); /* Date and time format for strftime. */
1608 DEFINE_NLITEM_CONSTANT (D_FMT
); /* Date format for strftime. */
1609 DEFINE_NLITEM_CONSTANT (T_FMT
); /* Time format for strftime. */
1610 DEFINE_NLITEM_CONSTANT (T_FMT_AMPM
);/* 12-hour time format for strftime. */
1612 DEFINE_NLITEM_CONSTANT (ERA
); /* Alternate era. */
1613 DEFINE_NLITEM_CONSTANT (ERA_D_FMT
); /* Date in alternate era format. */
1614 DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT
); /* Date and time in alternate era
1616 DEFINE_NLITEM_CONSTANT (ERA_T_FMT
); /* Time in alternate era format. */
1618 DEFINE_NLITEM_CONSTANT (ALT_DIGITS
); /* Alternate symbols for digits. */
1619 DEFINE_NLITEM_CONSTANT (RADIXCHAR
);
1620 DEFINE_NLITEM_CONSTANT (THOUSEP
);
1623 DEFINE_NLITEM_CONSTANT (YESEXPR
);
1626 DEFINE_NLITEM_CONSTANT (NOEXPR
);
1629 #ifdef CRNCYSTR /* currency symbol */
1630 DEFINE_NLITEM_CONSTANT (CRNCYSTR
);
1633 /* GNU extensions. */
1636 DEFINE_NLITEM_CONSTANT (ERA_YEAR
); /* Year in alternate era format. */
1639 /* LC_MONETARY category: formatting of monetary quantities.
1640 These items each correspond to a member of `struct lconv',
1641 defined in <locale.h>. */
1642 #ifdef INT_CURR_SYMBOL
1643 DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL
);
1645 #ifdef MON_DECIMAL_POINT
1646 DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT
);
1648 #ifdef MON_THOUSANDS_SEP
1649 DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP
);
1652 DEFINE_NLITEM_CONSTANT (MON_GROUPING
);
1654 #ifdef POSITIVE_SIGN
1655 DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN
);
1657 #ifdef NEGATIVE_SIGN
1658 DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN
);
1661 DEFINE_NLITEM_CONSTANT (GROUPING
);
1663 #ifdef INT_FRAC_DIGITS
1664 DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS
);
1667 DEFINE_NLITEM_CONSTANT (FRAC_DIGITS
);
1669 #ifdef P_CS_PRECEDES
1670 DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES
);
1672 #ifdef P_SEP_BY_SPACE
1673 DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE
);
1675 #ifdef N_CS_PRECEDES
1676 DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES
);
1678 #ifdef N_SEP_BY_SPACE
1679 DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE
);
1682 DEFINE_NLITEM_CONSTANT (P_SIGN_POSN
);
1685 DEFINE_NLITEM_CONSTANT (N_SIGN_POSN
);
1687 #ifdef INT_P_CS_PRECEDES
1688 DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES
);
1690 #ifdef INT_P_SEP_BY_SPACE
1691 DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE
);
1693 #ifdef INT_N_CS_PRECEDES
1694 DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES
);
1696 #ifdef INT_N_SEP_BY_SPACE
1697 DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE
);
1699 #ifdef INT_P_SIGN_POSN
1700 DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN
);
1702 #ifdef INT_N_SIGN_POSN
1703 DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN
);
1706 #undef DEFINE_NLITEM_CONSTANT
1708 #endif /* HAVE_NL_TYPES_H */
1715 SCM global_locale_smob
;
1717 #ifdef HAVE_NL_LANGINFO
1718 scm_add_feature ("nl-langinfo");
1719 define_langinfo_items ();
1722 #include "libguile/i18n.x"
1724 #ifndef USE_GNU_LOCALE_API
1725 scm_set_smob_mark (scm_tc16_locale_smob_type
, smob_locale_mark
);
1728 /* Initialize the global locale object with a special `locale' SMOB. */
1729 SCM_NEWSMOB (global_locale_smob
, scm_tc16_locale_smob_type
, NULL
);
1730 SCM_VARIABLE_SET (scm_global_locale
, global_locale_smob
);