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 is being standardized by the X/Open Group (as of Jan. 2007)
50 following Drepper's proposal. */
51 # define USE_GNU_LOCALE_API
54 #if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H)
58 #include "libguile/posix.h" /* for `scm_i_locale_mutex' */
60 #if (defined HAVE_LANGINFO_H) && (defined HAVE_NL_TYPES_H)
61 # include <langinfo.h>
62 # include <nl_types.h>
65 #ifndef HAVE_SETLOCALE
67 setlocale (int category
, const char *name
)
74 /* Helper stringification macro. */
75 #define SCM_I18N_STRINGIFY(_name) # _name
79 /* Locale objects, string and character collation, and other locale-dependent
82 A large part of the code here deals with emulating glibc's reentrant
83 locale API on non-GNU systems. The emulation is a bit "brute-force":
84 Whenever a `-locale<?' procedure is passed a locale object, then:
86 1. The `scm_i_locale_mutex' is locked.
87 2. A series of `setlocale ()' call is performed to store the current
88 locale for each category in an `scm_t_locale' object.
89 3. A series of `setlocale ()' call is made to install each of the locale
90 categories of each of the base locales of each locale object,
91 recursively, starting from the last locale object of the chain.
92 4. The settings captured in step (2) are restored.
93 5. The `scm_i_locale_mutex' is released.
95 Hopefully, the X/Open standard will eventually make this hack useless.
97 Note: We don't wrap glibc's `uselocale ()' call because it sets the locale
98 of the current _thread_ (unlike `setlocale ()') and doing so would require
99 maintaining per-thread locale information on non-GNU systems and always
100 re-installing this locale upon locale-dependent calls. */
103 /* Return the category mask corresponding to CAT. */
104 #define SCM_LOCALE_CATEGORY_MASK(_cat) LC_ ## _cat ## _MASK
107 #ifndef USE_GNU_LOCALE_API
109 /* Provide the locale category masks as found in glibc. This must be kept in
110 sync with `locale-categories.h'. */
112 # define LC_CTYPE_MASK 1
113 # define LC_COLLATE_MASK 2
114 # define LC_MESSAGES_MASK 4
115 # define LC_MONETARY_MASK 8
116 # define LC_NUMERIC_MASK 16
117 # define LC_TIME_MASK 32
120 # define LC_PAPER_MASK 64
122 # define LC_PAPER_MASK 0
125 # define LC_NAME_MASK 128
127 # define LC_NAME_MASK 0
130 # define LC_ADDRESS_MASK 256
132 # define LC_ADDRESS_MASK 0
135 # define LC_TELEPHONE_MASK 512
137 # define LC_TELEPHONE_MASK 0
139 # ifdef LC_MEASUREMENT
140 # define LC_MEASUREMENT_MASK 1024
142 # define LC_MEASUREMENT_MASK 0
144 # ifdef LC_IDENTIFICATION
145 # define LC_IDENTIFICATION_MASK 2048
147 # define LC_IDENTIFICATION_MASK 0
150 # define LC_ALL_MASK (LC_CTYPE_MASK \
159 | LC_TELEPHONE_MASK \
160 | LC_MEASUREMENT_MASK \
161 | LC_IDENTIFICATION_MASK \
164 /* Locale objects as returned by `make-locale' on non-GNU systems. */
165 typedef struct scm_locale
167 SCM base_locale
; /* a `locale' object */
173 /* Free the resources used by LOCALE. */
175 scm_i_locale_free (scm_t_locale locale
)
177 free (locale
->locale_name
);
178 locale
->locale_name
= NULL
;
181 #else /* USE_GNU_LOCALE_API */
183 /* Alias for glibc's locale type. */
184 typedef locale_t scm_t_locale
;
186 #define scm_i_locale_free freelocale
188 #endif /* USE_GNU_LOCALE_API */
191 /* A locale object denoting the global locale. */
192 SCM_GLOBAL_VARIABLE (scm_global_locale
, "%global-locale");
195 /* Validate parameter ARG as a locale object and set C_LOCALE to the
196 corresponding C locale object. */
197 #define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale) \
200 SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type); \
201 (_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg); \
205 /* Validate optional parameter ARG as either undefined or bound to a locale
206 object. Set C_LOCALE to the corresponding C locale object or NULL. */
207 #define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \
210 if ((_arg) != SCM_UNDEFINED) \
211 SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \
213 (_c_locale) = NULL; \
218 SCM_SMOB (scm_tc16_locale_smob_type
, "locale", 0);
220 SCM_SMOB_FREE (scm_tc16_locale_smob_type
, smob_locale_free
, locale
)
222 scm_t_locale c_locale
;
224 c_locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
);
225 scm_i_locale_free (c_locale
);
230 #ifndef USE_GNU_LOCALE_API
232 smob_locale_mark (SCM locale
)
234 register SCM dependency
;
236 if (!scm_is_eq (locale
, SCM_VARIABLE_REF (scm_global_locale
)))
238 scm_t_locale c_locale
;
240 c_locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
);
241 dependency
= (c_locale
->base_locale
);
244 dependency
= SCM_BOOL_F
;
251 static void inline scm_locale_error (const char *, int) SCM_NORETURN
;
253 /* Throw an exception corresponding to error ERR. */
255 scm_locale_error (const char *func_name
, int err
)
257 scm_syserror_msg (func_name
,
258 "Failed to install locale",
264 /* Emulating GNU's reentrant locale API. */
265 #ifndef USE_GNU_LOCALE_API
268 /* Maximum number of chained locales (via `base_locale'). */
269 #define LOCALE_STACK_SIZE_MAX 256
273 #define SCM_DEFINE_LOCALE_CATEGORY(_name) char * _name;
274 #include "locale-categories.h"
275 #undef SCM_DEFINE_LOCALE_CATEGORY
276 } scm_t_locale_settings
;
278 /* Fill out SETTINGS according to the current locale settings. On success
279 zero is returned and SETTINGS is properly initialized. */
281 get_current_locale_settings (scm_t_locale_settings
*settings
)
283 const char *locale_name
;
285 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
287 SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \
288 if (locale_name == NULL) \
291 settings-> _name = strdup (locale_name); \
292 if (settings-> _name == NULL) \
296 #include "locale-categories.h"
297 #undef SCM_DEFINE_LOCALE_CATEGORY
308 /* Restore locale settings SETTINGS. On success, return zero. */
310 restore_locale_settings (const scm_t_locale_settings
*settings
)
314 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
315 SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name)); \
316 if (result == NULL) \
319 #include "locale-categories.h"
320 #undef SCM_DEFINE_LOCALE_CATEGORY
328 /* Free memory associated with SETTINGS. */
330 free_locale_settings (scm_t_locale_settings
*settings
)
332 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
333 free (settings-> _name); \
334 settings->_name = NULL;
335 #include "locale-categories.h"
336 #undef SCM_DEFINE_LOCALE_CATEGORY
339 /* Install the locale named LOCALE_NAME for all the categories listed in
342 install_locale_categories (const char *locale_name
, int category_mask
)
346 if (category_mask
== LC_ALL_MASK
)
348 SCM_SYSCALL (result
= setlocale (LC_ALL
, locale_name
));
354 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
355 if (category_mask & SCM_LOCALE_CATEGORY_MASK (_name)) \
357 SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \
358 if (result == NULL) \
361 #include "locale-categories.h"
362 #undef SCM_DEFINE_LOCALE_CATEGORY
371 /* Install LOCALE, recursively installing its base locales first. On
372 success, zero is returned. */
374 install_locale (scm_t_locale locale
)
376 scm_t_locale stack
[LOCALE_STACK_SIZE_MAX
];
377 int category_mask
= 0;
378 size_t stack_size
= 0;
379 int stack_offset
= 0;
380 const char *result
= NULL
;
382 /* Build up a locale stack by traversing the `base_locale' link. */
385 if (stack_size
>= LOCALE_STACK_SIZE_MAX
)
386 /* We cannot use `scm_error ()' here because otherwise the locale
387 mutex may remain locked. */
390 stack
[stack_size
++] = locale
;
392 /* Keep track of which categories have already been taken into
394 category_mask
|= locale
->category_mask
;
396 if (locale
->base_locale
!= SCM_UNDEFINED
)
397 locale
= (scm_t_locale
) SCM_SMOB_DATA (locale
->base_locale
);
401 while ((locale
!= NULL
) && (category_mask
!= LC_ALL_MASK
));
403 /* Install the C locale to start from a pristine state. */
404 SCM_SYSCALL (result
= setlocale (LC_ALL
, "C"));
408 /* Install the locales in reverse order. */
409 for (stack_offset
= stack_size
- 1;
416 locale
= stack
[stack_offset
];
417 err
= install_locale_categories (locale
->locale_name
,
418 locale
->category_mask
);
429 /* Leave the locked locale section. */
431 leave_locale_section (const scm_t_locale_settings
*settings
)
433 /* Restore the previous locale settings. */
434 (void)restore_locale_settings (settings
);
436 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
439 /* Enter a locked locale section. */
441 enter_locale_section (scm_t_locale locale
,
442 scm_t_locale_settings
*prev_locale
)
446 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
448 err
= get_current_locale_settings (prev_locale
);
451 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
455 err
= install_locale (locale
);
458 leave_locale_section (prev_locale
);
459 free_locale_settings (prev_locale
);
465 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
466 #define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
470 scm_t_locale_settings lsec_prev_locale; \
472 lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale); \
474 scm_locale_error (FUNC_NAME, lsec_err); \
479 leave_locale_section (&lsec_prev_locale); \
480 free_locale_settings (&lsec_prev_locale); \
485 /* Convert the current locale settings into a locale SMOB. On success, zero
486 is returned and RESULT points to the new SMOB. Otherwise, an error is
489 get_current_locale (SCM
*result
)
492 scm_t_locale c_locale
;
493 const char *current_locale
;
495 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
498 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
500 c_locale
->category_mask
= LC_ALL_MASK
;
501 c_locale
->base_locale
= SCM_UNDEFINED
;
503 current_locale
= setlocale (LC_ALL
, NULL
);
504 if (current_locale
!= NULL
)
506 c_locale
->locale_name
= strdup (current_locale
);
507 if (c_locale
->locale_name
== NULL
)
513 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
516 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
518 SCM_NEWSMOB (*result
, scm_tc16_locale_smob_type
, c_locale
);
524 #endif /* !USE_GNU_LOCALE_API */
528 /* `make-locale' can take either category lists or single categories (the
529 `LC_*' integer constants). */
530 #define SCM_LIST_OR_INTEGER_P(arg) \
531 (scm_is_integer (arg) || scm_is_true (scm_list_p (arg)))
534 /* Return the category mask corresponding to CATEGORY (an `LC_' integer
537 category_to_category_mask (SCM category
,
538 const char *func_name
, int pos
)
543 c_category
= scm_to_int (category
);
545 #define SCM_DEFINE_LOCALE_CATEGORY(_name) \
547 c_category_mask = SCM_LOCALE_CATEGORY_MASK (_name); \
552 #include "locale-categories.h"
555 c_category_mask
= LC_ALL_MASK
;
559 scm_wrong_type_arg_msg (func_name
, pos
, category
,
563 #undef SCM_DEFINE_LOCALE_CATEGORY
565 return c_category_mask
;
568 /* Convert CATEGORIES, a list of locale categories or a single category (an
569 integer), into a category mask. */
571 category_list_to_category_mask (SCM categories
,
572 const char *func_name
, int pos
)
574 int c_category_mask
= 0;
576 if (scm_is_integer (categories
))
577 c_category_mask
= category_to_category_mask (categories
,
580 for (; !scm_is_null (categories
); categories
= SCM_CDR (categories
))
582 SCM category
= SCM_CAR (categories
);
585 category_to_category_mask (category
, func_name
, pos
);
588 return c_category_mask
;
592 SCM_DEFINE (scm_make_locale
, "make-locale", 2, 1, 0,
593 (SCM category_list
, SCM locale_name
, SCM base_locale
),
594 "Return a reference to a data structure representing a set of "
595 "locale datasets. @var{category_list} should be either a list "
596 "of locale categories or a single category as used with "
597 "@code{setlocale} (@pxref{Locales, @code{setlocale}}) and "
598 "@var{locale_name} should be the name of the locale considered "
599 "(e.g., @code{\"sl_SI\"}). Optionally, if @code{base_locale} is "
600 "passed, it should be a locale object denoting settings for "
601 "categories not listed in @var{category_list}.")
602 #define FUNC_NAME s_scm_make_locale
604 SCM locale
= SCM_BOOL_F
;
608 scm_t_locale c_base_locale
, c_locale
;
610 SCM_MAKE_VALIDATE (1, category_list
, LIST_OR_INTEGER_P
);
611 SCM_VALIDATE_STRING (2, locale_name
);
612 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, base_locale
, c_base_locale
);
614 c_category_mask
= category_list_to_category_mask (category_list
,
616 c_locale_name
= scm_to_locale_string (locale_name
);
618 #ifdef USE_GNU_LOCALE_API
620 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
622 /* Fetch the current locale and turn in into a `locale_t'. Don't
623 duplicate the resulting `locale_t' because we want it to be consumed
624 by `newlocale ()'. */
625 char *current_locale
;
627 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
629 current_locale
= setlocale (LC_ALL
, NULL
);
630 c_base_locale
= newlocale (LC_ALL_MASK
, current_locale
, NULL
);
632 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
634 if (c_base_locale
== (locale_t
) 0)
635 scm_locale_error (FUNC_NAME
, errno
);
637 else if (c_base_locale
!= (locale_t
) 0)
639 /* C_BASE_LOCALE is to be consumed by `newlocale ()' so it needs to be
640 duplicated before. */
641 c_base_locale
= duplocale (c_base_locale
);
642 if (c_base_locale
== (locale_t
) 0)
649 c_locale
= newlocale (c_category_mask
, c_locale_name
, c_base_locale
);
651 free (c_locale_name
);
653 if (c_locale
== (locale_t
) 0)
655 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
656 /* The base locale object was created lazily and must be freed. */
657 freelocale (c_base_locale
);
659 scm_locale_error (FUNC_NAME
, errno
);
662 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
666 c_locale
= scm_gc_malloc (sizeof (* c_locale
), "locale");
668 c_locale
->category_mask
= c_category_mask
;
669 c_locale
->locale_name
= c_locale_name
;
671 if (scm_is_eq (base_locale
, SCM_VARIABLE_REF (scm_global_locale
)))
673 /* Get the current locale settings and turn them into a locale
675 err
= get_current_locale (&base_locale
);
680 c_locale
->base_locale
= base_locale
;
683 /* Try out the new locale and raise an exception if it doesn't work. */
685 scm_t_locale_settings prev_locale
;
687 err
= enter_locale_section (c_locale
, &prev_locale
);
693 leave_locale_section (&prev_locale
);
694 SCM_NEWSMOB (locale
, scm_tc16_locale_smob_type
, c_locale
);
703 #ifndef USE_GNU_LOCALE_API
704 scm_gc_free (c_locale
, sizeof (* c_locale
), "locale");
706 free (c_locale_name
);
707 scm_locale_error (FUNC_NAME
, err
);
713 SCM_DEFINE (scm_locale_p
, "locale?", 1, 0, 0,
715 "Return true if @var{obj} is a locale object.")
716 #define FUNC_NAME s_scm_locale_p
718 return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type
, obj
));
724 /* Locale-dependent string comparison.
726 A similar API can be found in MzScheme starting from version 200:
727 http://download.plt-scheme.org/chronology/mzmr200alpha14.html . */
730 /* Compare null-terminated strings C_S1 and C_S2 according to LOCALE. Return
731 an integer whose sign is the same as the difference between C_S1 and
734 compare_strings (const char *c_s1
, const char *c_s2
, SCM locale
,
735 const char *func_name
)
736 #define FUNC_NAME func_name
739 scm_t_locale c_locale
;
741 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
745 #ifdef USE_GNU_LOCALE_API
746 result
= strcoll_l (c_s1
, c_s2
, c_locale
);
749 RUN_IN_LOCALE_SECTION (c_locale
, result
= strcoll (c_s1
, c_s2
));
751 result
= strcmp (c_s1
, c_s2
);
753 #endif /* !USE_GNU_LOCALE_API */
758 result
= strcoll (c_s1
, c_s2
);
760 result
= strcmp (c_s1
, c_s2
);
767 /* Store into DST an upper-case version of SRC. */
769 str_upcase (register char *dst
, register const char *src
)
771 for (; *src
!= '\0'; src
++, dst
++)
772 *dst
= toupper ((int) *src
);
777 str_downcase (register char *dst
, register const char *src
)
779 for (; *src
!= '\0'; src
++, dst
++)
780 *dst
= tolower ((int) *src
);
784 #ifdef USE_GNU_LOCALE_API
786 str_upcase_l (register char *dst
, register const char *src
,
789 for (; *src
!= '\0'; src
++, dst
++)
790 *dst
= toupper_l (*src
, locale
);
795 str_downcase_l (register char *dst
, register const char *src
,
798 for (; *src
!= '\0'; src
++, dst
++)
799 *dst
= tolower_l (*src
, locale
);
805 /* Compare null-terminated strings C_S1 and C_S2 in a case-independent way
806 according to LOCALE. Return an integer whose sign is the same as the
807 difference between C_S1 and C_S2. */
809 compare_strings_ci (const char *c_s1
, const char *c_s2
, SCM locale
,
810 const char *func_name
)
811 #define FUNC_NAME func_name
814 scm_t_locale c_locale
;
817 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
819 c_us1
= (char *) alloca (strlen (c_s1
) + 1);
820 c_us2
= (char *) alloca (strlen (c_s2
) + 1);
824 #ifdef USE_GNU_LOCALE_API
825 str_upcase_l (c_us1
, c_s1
, c_locale
);
826 str_upcase_l (c_us2
, c_s2
, c_locale
);
828 result
= strcoll_l (c_us1
, c_us2
, c_locale
);
831 scm_t_locale_settings prev_locale
;
833 err
= enter_locale_section (c_locale
, &prev_locale
);
836 scm_locale_error (func_name
, err
);
840 str_upcase (c_us1
, c_s1
);
841 str_upcase (c_us2
, c_s2
);
844 result
= strcoll (c_us1
, c_us2
);
846 result
= strcmp (c_us1
, c_us2
);
847 #endif /* !HAVE_STRCOLL */
849 leave_locale_section (&prev_locale
);
850 free_locale_settings (&prev_locale
);
851 #endif /* !USE_GNU_LOCALE_API */
855 str_upcase (c_us1
, c_s1
);
856 str_upcase (c_us2
, c_s2
);
859 result
= strcoll (c_us1
, c_us2
);
861 result
= strcmp (c_us1
, c_us2
);
870 SCM_DEFINE (scm_string_locale_lt
, "string-locale<?", 2, 1, 0,
871 (SCM s1
, SCM s2
, SCM locale
),
872 "Compare strings @var{s1} and @var{s2} in a locale-dependent way."
873 "If @var{locale} is provided, it should be locale object (as "
874 "returned by @code{make-locale}) and will be used to perform the "
875 "comparison; otherwise, the current system locale is used.")
876 #define FUNC_NAME s_scm_string_locale_lt
879 const char *c_s1
, *c_s2
;
881 SCM_VALIDATE_STRING (1, s1
);
882 SCM_VALIDATE_STRING (2, s2
);
884 c_s1
= scm_i_string_chars (s1
);
885 c_s2
= scm_i_string_chars (s2
);
887 result
= compare_strings (c_s1
, c_s2
, locale
, FUNC_NAME
);
889 scm_remember_upto_here_2 (s1
, s2
);
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
904 const char *c_s1
, *c_s2
;
906 SCM_VALIDATE_STRING (1, s1
);
907 SCM_VALIDATE_STRING (2, s2
);
909 c_s1
= scm_i_string_chars (s1
);
910 c_s2
= scm_i_string_chars (s2
);
912 result
= compare_strings (c_s1
, c_s2
, locale
, FUNC_NAME
);
914 scm_remember_upto_here_2 (s1
, s2
);
916 return scm_from_bool (result
> 0);
920 SCM_DEFINE (scm_string_locale_ci_lt
, "string-locale-ci<?", 2, 1, 0,
921 (SCM s1
, SCM s2
, SCM locale
),
922 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
923 "and locale-dependent way. If @var{locale} is provided, it "
924 "should be locale object (as returned by @code{make-locale}) "
925 "and will be used to perform the comparison; otherwise, the "
926 "current system locale is used.")
927 #define FUNC_NAME s_scm_string_locale_ci_lt
930 const char *c_s1
, *c_s2
;
932 SCM_VALIDATE_STRING (1, s1
);
933 SCM_VALIDATE_STRING (2, s2
);
935 c_s1
= scm_i_string_chars (s1
);
936 c_s2
= scm_i_string_chars (s2
);
938 result
= compare_strings_ci (c_s1
, c_s2
, locale
, FUNC_NAME
);
940 scm_remember_upto_here_2 (s1
, s2
);
942 return scm_from_bool (result
< 0);
946 SCM_DEFINE (scm_string_locale_ci_gt
, "string-locale-ci>?", 2, 1, 0,
947 (SCM s1
, SCM s2
, SCM locale
),
948 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
949 "and locale-dependent way. If @var{locale} is provided, it "
950 "should be locale object (as returned by @code{make-locale}) "
951 "and will be used to perform the comparison; otherwise, the "
952 "current system locale is used.")
953 #define FUNC_NAME s_scm_string_locale_ci_gt
956 const char *c_s1
, *c_s2
;
958 SCM_VALIDATE_STRING (1, s1
);
959 SCM_VALIDATE_STRING (2, s2
);
961 c_s1
= scm_i_string_chars (s1
);
962 c_s2
= scm_i_string_chars (s2
);
964 result
= compare_strings_ci (c_s1
, c_s2
, locale
, FUNC_NAME
);
966 scm_remember_upto_here_2 (s1
, s2
);
968 return scm_from_bool (result
> 0);
972 SCM_DEFINE (scm_string_locale_ci_eq
, "string-locale-ci=?", 2, 1, 0,
973 (SCM s1
, SCM s2
, SCM locale
),
974 "Compare strings @var{s1} and @var{s2} in a case-insensitive, "
975 "and locale-dependent way. If @var{locale} is provided, it "
976 "should be locale object (as returned by @code{make-locale}) "
977 "and will be used to perform the comparison; otherwise, the "
978 "current system locale is used.")
979 #define FUNC_NAME s_scm_string_locale_ci_eq
982 const char *c_s1
, *c_s2
;
984 SCM_VALIDATE_STRING (1, s1
);
985 SCM_VALIDATE_STRING (2, s2
);
987 c_s1
= scm_i_string_chars (s1
);
988 c_s2
= scm_i_string_chars (s2
);
990 result
= compare_strings_ci (c_s1
, c_s2
, locale
, FUNC_NAME
);
992 scm_remember_upto_here_2 (s1
, s2
);
994 return scm_from_bool (result
== 0);
999 SCM_DEFINE (scm_char_locale_lt
, "char-locale<?", 2, 1, 0,
1000 (SCM c1
, SCM c2
, SCM locale
),
1001 "Return true if character @var{c1} is lower than @var{c2} "
1002 "according to @var{locale} or to the current locale.")
1003 #define FUNC_NAME s_scm_char_locale_lt
1005 char c_c1
[2], c_c2
[2];
1007 SCM_VALIDATE_CHAR (1, c1
);
1008 SCM_VALIDATE_CHAR (2, c2
);
1010 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1011 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1013 return scm_from_bool (compare_strings (c_c1
, c_c2
, locale
, FUNC_NAME
) < 0);
1017 SCM_DEFINE (scm_char_locale_gt
, "char-locale>?", 2, 1, 0,
1018 (SCM c1
, SCM c2
, SCM locale
),
1019 "Return true if character @var{c1} is greater than @var{c2} "
1020 "according to @var{locale} or to the current locale.")
1021 #define FUNC_NAME s_scm_char_locale_gt
1023 char c_c1
[2], c_c2
[2];
1025 SCM_VALIDATE_CHAR (1, c1
);
1026 SCM_VALIDATE_CHAR (2, c2
);
1028 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1029 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1031 return scm_from_bool (compare_strings (c_c1
, c_c2
, locale
, FUNC_NAME
) > 0);
1035 SCM_DEFINE (scm_char_locale_ci_lt
, "char-locale-ci<?", 2, 1, 0,
1036 (SCM c1
, SCM c2
, SCM locale
),
1037 "Return true if character @var{c1} is lower than @var{c2}, "
1038 "in a case insensitive way according to @var{locale} or to "
1039 "the current locale.")
1040 #define FUNC_NAME s_scm_char_locale_ci_lt
1043 char c_c1
[2], c_c2
[2];
1045 SCM_VALIDATE_CHAR (1, c1
);
1046 SCM_VALIDATE_CHAR (2, c2
);
1048 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1049 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1051 result
= compare_strings_ci (c_c1
, c_c2
, locale
, FUNC_NAME
);
1053 return scm_from_bool (result
< 0);
1057 SCM_DEFINE (scm_char_locale_ci_gt
, "char-locale-ci>?", 2, 1, 0,
1058 (SCM c1
, SCM c2
, SCM locale
),
1059 "Return true if character @var{c1} is greater than @var{c2}, "
1060 "in a case insensitive way according to @var{locale} or to "
1061 "the current locale.")
1062 #define FUNC_NAME s_scm_char_locale_ci_gt
1065 char c_c1
[2], c_c2
[2];
1067 SCM_VALIDATE_CHAR (1, c1
);
1068 SCM_VALIDATE_CHAR (2, c2
);
1070 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1071 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1073 result
= compare_strings_ci (c_c1
, c_c2
, locale
, FUNC_NAME
);
1075 return scm_from_bool (result
> 0);
1079 SCM_DEFINE (scm_char_locale_ci_eq
, "char-locale-ci=?", 2, 1, 0,
1080 (SCM c1
, SCM c2
, SCM locale
),
1081 "Return true if character @var{c1} is equal to @var{c2}, "
1082 "in a case insensitive way according to @var{locale} or to "
1083 "the current locale.")
1084 #define FUNC_NAME s_scm_char_locale_ci_eq
1087 char c_c1
[2], c_c2
[2];
1089 SCM_VALIDATE_CHAR (1, c1
);
1090 SCM_VALIDATE_CHAR (2, c2
);
1092 c_c1
[0] = (char)SCM_CHAR (c1
); c_c1
[1] = '\0';
1093 c_c2
[0] = (char)SCM_CHAR (c2
); c_c2
[1] = '\0';
1095 result
= compare_strings_ci (c_c1
, c_c2
, locale
, FUNC_NAME
);
1097 return scm_from_bool (result
== 0);
1103 /* Locale-dependent alphabetic character mapping. */
1105 SCM_DEFINE (scm_char_locale_downcase
, "char-locale-downcase", 1, 1, 0,
1106 (SCM chr
, SCM locale
),
1107 "Return the lowercase character that corresponds to @var{chr} "
1108 "according to either @var{locale} or the current locale.")
1109 #define FUNC_NAME s_scm_char_locale_downcase
1113 scm_t_locale c_locale
;
1115 SCM_VALIDATE_CHAR (1, chr
);
1116 c_chr
= SCM_CHAR (chr
);
1118 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1120 if (c_locale
!= NULL
)
1122 #ifdef USE_GNU_LOCALE_API
1123 c_result
= tolower_l ((int) c_chr
, c_locale
);
1125 RUN_IN_LOCALE_SECTION (c_locale
, c_result
= tolower ((int) c_chr
));
1129 c_result
= tolower ((int) c_chr
);
1131 return (SCM_MAKE_CHAR (c_result
));
1135 SCM_DEFINE (scm_char_locale_upcase
, "char-locale-upcase", 1, 1, 0,
1136 (SCM chr
, SCM locale
),
1137 "Return the uppercase character that corresponds to @var{chr} "
1138 "according to either @var{locale} or the current locale.")
1139 #define FUNC_NAME s_scm_char_locale_upcase
1143 scm_t_locale c_locale
;
1145 SCM_VALIDATE_CHAR (1, chr
);
1146 c_chr
= SCM_CHAR (chr
);
1148 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1150 if (c_locale
!= NULL
)
1152 #ifdef USE_GNU_LOCALE_API
1153 c_result
= toupper_l ((int) c_chr
, c_locale
);
1155 RUN_IN_LOCALE_SECTION (c_locale
, c_result
= toupper ((int) c_chr
));
1159 c_result
= toupper ((int) c_chr
);
1161 return (SCM_MAKE_CHAR (c_result
));
1165 SCM_DEFINE (scm_string_locale_upcase
, "string-locale-upcase", 1, 1, 0,
1166 (SCM str
, SCM locale
),
1167 "Return a new string that is the uppercase version of "
1168 "@var{str} according to either @var{locale} or the current "
1170 #define FUNC_NAME s_scm_string_locale_upcase
1174 scm_t_locale c_locale
;
1176 SCM_VALIDATE_STRING (1, str
);
1177 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1179 c_str
= scm_i_string_chars (str
);
1180 c_ustr
= (char *) alloca (strlen (c_str
) + 1);
1184 #ifdef USE_GNU_LOCALE_API
1185 str_upcase_l (c_ustr
, c_str
, c_locale
);
1187 RUN_IN_LOCALE_SECTION (c_locale
, str_upcase (c_ustr
, c_str
));
1191 str_upcase (c_ustr
, c_str
);
1193 scm_remember_upto_here (str
);
1195 return (scm_from_locale_string (c_ustr
));
1199 SCM_DEFINE (scm_string_locale_downcase
, "string-locale-downcase", 1, 1, 0,
1200 (SCM str
, SCM locale
),
1201 "Return a new string that is the down-case version of "
1202 "@var{str} according to either @var{locale} or the current "
1204 #define FUNC_NAME s_scm_string_locale_downcase
1208 scm_t_locale c_locale
;
1210 SCM_VALIDATE_STRING (1, str
);
1211 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1213 c_str
= scm_i_string_chars (str
);
1214 c_lstr
= (char *) alloca (strlen (c_str
) + 1);
1218 #ifdef USE_GNU_LOCALE_API
1219 str_downcase_l (c_lstr
, c_str
, c_locale
);
1221 RUN_IN_LOCALE_SECTION (c_locale
, str_downcase (c_lstr
, c_str
));
1225 str_downcase (c_lstr
, c_str
);
1227 scm_remember_upto_here (str
);
1229 return (scm_from_locale_string (c_lstr
));
1233 /* Note: We don't provide mutative versions of `string-locale-(up|down)case'
1234 because, in some languages, a single downcase character maps to a couple
1235 of uppercase characters. Read the SRFI-13 document for a detailed
1236 discussion about this. */
1240 /* Locale-dependent number parsing. */
1242 SCM_DEFINE (scm_locale_string_to_integer
, "locale-string->integer",
1243 1, 2, 0, (SCM str
, SCM base
, SCM locale
),
1244 "Convert string @var{str} into an integer according to either "
1245 "@var{locale} (a locale object as returned by @code{make-locale}) "
1246 "or the current process locale. Return two values: an integer "
1247 "(on success) or @code{#f}, and the number of characters read "
1248 "from @var{str} (@code{0} on failure).")
1249 #define FUNC_NAME s_scm_locale_string_to_integer
1256 scm_t_locale c_locale
;
1258 SCM_VALIDATE_STRING (1, str
);
1259 c_str
= scm_i_string_chars (str
);
1261 if (base
!= SCM_UNDEFINED
)
1262 SCM_VALIDATE_INT_COPY (2, base
, c_base
);
1266 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale
, c_locale
);
1268 if (c_locale
!= NULL
)
1270 #ifdef USE_GNU_LOCALE_API
1271 c_result
= strtol_l (c_str
, &c_endptr
, c_base
, c_locale
);
1273 RUN_IN_LOCALE_SECTION (c_locale
,
1274 c_result
= strtol (c_str
, &c_endptr
, c_base
));
1278 c_result
= strtol (c_str
, &c_endptr
, c_base
);
1280 scm_remember_upto_here (str
);
1282 if (c_endptr
== c_str
)
1283 result
= SCM_BOOL_F
;
1285 result
= scm_from_long (c_result
);
1287 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1291 SCM_DEFINE (scm_locale_string_to_inexact
, "locale-string->inexact",
1292 1, 1, 0, (SCM str
, SCM locale
),
1293 "Convert string @var{str} into an inexact number according to "
1294 "either @var{locale} (a locale object as returned by "
1295 "@code{make-locale}) or the current process locale. Return "
1296 "two values: an inexact number (on success) or @code{#f}, and "
1297 "the number of characters read from @var{str} (@code{0} on "
1299 #define FUNC_NAME s_scm_locale_string_to_inexact
1305 scm_t_locale c_locale
;
1307 SCM_VALIDATE_STRING (1, str
);
1308 c_str
= scm_i_string_chars (str
);
1310 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1312 if (c_locale
!= NULL
)
1314 #ifdef USE_GNU_LOCALE_API
1315 c_result
= strtod_l (c_str
, &c_endptr
, c_locale
);
1317 RUN_IN_LOCALE_SECTION (c_locale
,
1318 c_result
= strtod (c_str
, &c_endptr
));
1322 c_result
= strtod (c_str
, &c_endptr
);
1324 scm_remember_upto_here (str
);
1326 if (c_endptr
== c_str
)
1327 result
= SCM_BOOL_F
;
1329 result
= scm_from_double (c_result
);
1331 return (scm_values (scm_list_2 (result
, scm_from_long (c_endptr
- c_str
))));
1336 /* Language information, aka. `nl_langinfo ()'. */
1338 /* FIXME: Issues related to `nl-langinfo'.
1340 1. The `CODESET' value is not normalized. This is a secondary issue, but
1341 still a practical issue. See
1342 http://www.cl.cam.ac.uk/~mgk25/ucs/norm_charmap.c for codeset
1345 2. `nl_langinfo ()' is not available on Windows.
1347 3. `nl_langinfo ()' may return strings encoded in a locale different from
1348 the current one, thereby defeating `scm_from_locale_string ()'.
1349 Example: support the current locale is "Latin-1" and one asks:
1351 (nl-langinfo DAY_1 (make-locale LC_ALL "eo_EO.UTF-8"))
1353 The result will be a UTF-8 string. However, `scm_from_locale_string',
1354 which expects a Latin-1 string, won't be able to make much sense of the
1355 returned string. Thus, we'd need an `scm_from_string ()' variant where
1356 the locale (or charset) is explicitly passed. */
1359 SCM_DEFINE (scm_nl_langinfo
, "nl-langinfo", 1, 1, 0,
1360 (SCM item
, SCM locale
),
1361 "Return a string denoting locale information for @var{item} "
1362 "in the current locale or that specified by @var{locale}. "
1363 "The semantics and arguments are the same as those of the "
1364 "X/Open @code{nl_langinfo} function (@pxref{The Elegant and "
1365 "Fast Way, @code{nl_langinfo},, libc, The GNU C Library "
1366 "Reference Manual}).")
1367 #define FUNC_NAME s_scm_nl_langinfo
1369 #ifdef HAVE_NL_LANGINFO
1373 scm_t_locale c_locale
;
1375 SCM_VALIDATE_INT_COPY (2, item
, c_item
);
1376 SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale
, c_locale
);
1378 /* Sadly, `nl_langinfo ()' returns a pointer to a static string. According
1379 to SuS v2, that static string may be modified by subsequent calls to
1380 `nl_langinfo ()' as well as by calls to `setlocale ()'. Thus, we must
1381 acquire the locale mutex before doing invoking `nl_langinfo ()'. See
1382 http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for
1385 scm_i_pthread_mutex_lock (&scm_i_locale_mutex
);
1386 if (c_locale
!= NULL
)
1388 #ifdef USE_GNU_LOCALE_API
1389 c_result
= nl_langinfo_l (c_item
, c_locale
);
1391 /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
1392 mutex is already taken. */
1394 scm_t_locale_settings lsec_prev_locale
;
1396 lsec_err
= get_current_locale_settings (&lsec_prev_locale
);
1398 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1401 lsec_err
= install_locale (c_locale
);
1404 leave_locale_section (&lsec_prev_locale
);
1405 free_locale_settings (&lsec_prev_locale
);
1410 scm_locale_error (FUNC_NAME
, lsec_err
);
1413 c_result
= nl_langinfo (c_item
);
1415 restore_locale_settings (&lsec_prev_locale
);
1416 free_locale_settings (&lsec_prev_locale
);
1421 c_result
= nl_langinfo (c_item
);
1423 c_result
= strdup (c_result
);
1424 scm_i_pthread_mutex_unlock (&scm_i_locale_mutex
);
1426 if (c_result
== NULL
)
1427 result
= SCM_BOOL_F
;
1432 #if (defined GROUPING) && (defined MON_GROUPING)
1438 /* In this cases, the result is to be interpreted as a list of
1439 numbers. If the last item is `CHARS_MAX', it has the special
1440 meaning "no more grouping". */
1442 for (p
= c_result
; (*p
!= '\0') && (*p
!= CHAR_MAX
); p
++)
1443 result
= scm_cons (SCM_I_MAKINUM ((int) *p
), result
);
1446 SCM last_pair
= result
;
1448 result
= scm_reverse_x (result
, SCM_EOL
);
1452 /* Cyclic grouping information. */
1453 if (last_pair
!= SCM_EOL
)
1454 SCM_SETCDR (last_pair
, result
);
1463 #if (defined FRAC_DIGITS) && (defined INT_FRAC_DIGITS)
1465 case INT_FRAC_DIGITS
:
1466 /* This is to be interpreted as a single integer. */
1467 if (*c_result
== CHAR_MAX
)
1469 result
= SCM_BOOL_F
;
1471 result
= SCM_I_MAKINUM (*c_result
);
1477 #if (defined P_CS_PRECEDES) && (defined INT_N_CS_PRECEDES)
1480 case INT_P_CS_PRECEDES
:
1481 case INT_N_CS_PRECEDES
:
1482 #if (defined P_SEP_BY_SPACE) && (defined N_SEP_BY_SPACE)
1483 case P_SEP_BY_SPACE
:
1484 case N_SEP_BY_SPACE
:
1486 /* This is to be interpreted as a boolean. */
1487 result
= scm_from_bool (*c_result
);
1493 #if (defined P_SIGN_POSN) && (defined INT_N_SIGN_POSN)
1496 case INT_P_SIGN_POSN
:
1497 case INT_N_SIGN_POSN
:
1498 /* See `(libc) Sign of Money Amount' for the interpretation of the
1499 return value here. */
1503 result
= scm_from_locale_symbol ("parenthesize");
1507 result
= scm_from_locale_symbol ("sign-before");
1511 result
= scm_from_locale_symbol ("sign-after");
1515 result
= scm_from_locale_symbol ("sign-before-currency-symbol");
1519 result
= scm_from_locale_symbol ("sign-after-currency-symbol");
1523 result
= scm_from_locale_symbol ("unspecified");
1529 /* FIXME: `locale_string ()' is not appropriate here because of
1530 encoding issues (see comment above). */
1531 result
= scm_take_locale_string (c_result
);
1537 scm_syserror_msg (FUNC_NAME
, "`nl-langinfo' not supported on your system",
1545 /* Define the `nl_item' constants. */
1547 define_langinfo_items (void)
1549 #if (defined HAVE_NL_TYPES_H) && (defined HAVE_LANGINFO_H)
1551 #define DEFINE_NLITEM_CONSTANT(_item) \
1552 scm_c_define (# _item, scm_from_int (_item))
1554 DEFINE_NLITEM_CONSTANT (CODESET
);
1556 /* Abbreviated days of the week. */
1557 DEFINE_NLITEM_CONSTANT (ABDAY_1
);
1558 DEFINE_NLITEM_CONSTANT (ABDAY_2
);
1559 DEFINE_NLITEM_CONSTANT (ABDAY_3
);
1560 DEFINE_NLITEM_CONSTANT (ABDAY_4
);
1561 DEFINE_NLITEM_CONSTANT (ABDAY_5
);
1562 DEFINE_NLITEM_CONSTANT (ABDAY_6
);
1563 DEFINE_NLITEM_CONSTANT (ABDAY_7
);
1565 /* Long-named days of the week. */
1566 DEFINE_NLITEM_CONSTANT (DAY_1
); /* Sunday */
1567 DEFINE_NLITEM_CONSTANT (DAY_2
); /* Monday */
1568 DEFINE_NLITEM_CONSTANT (DAY_3
); /* Tuesday */
1569 DEFINE_NLITEM_CONSTANT (DAY_4
); /* Wednesday */
1570 DEFINE_NLITEM_CONSTANT (DAY_5
); /* Thursday */
1571 DEFINE_NLITEM_CONSTANT (DAY_6
); /* Friday */
1572 DEFINE_NLITEM_CONSTANT (DAY_7
); /* Saturday */
1574 /* Abbreviated month names. */
1575 DEFINE_NLITEM_CONSTANT (ABMON_1
); /* Jan */
1576 DEFINE_NLITEM_CONSTANT (ABMON_2
);
1577 DEFINE_NLITEM_CONSTANT (ABMON_3
);
1578 DEFINE_NLITEM_CONSTANT (ABMON_4
);
1579 DEFINE_NLITEM_CONSTANT (ABMON_5
);
1580 DEFINE_NLITEM_CONSTANT (ABMON_6
);
1581 DEFINE_NLITEM_CONSTANT (ABMON_7
);
1582 DEFINE_NLITEM_CONSTANT (ABMON_8
);
1583 DEFINE_NLITEM_CONSTANT (ABMON_9
);
1584 DEFINE_NLITEM_CONSTANT (ABMON_10
);
1585 DEFINE_NLITEM_CONSTANT (ABMON_11
);
1586 DEFINE_NLITEM_CONSTANT (ABMON_12
);
1588 /* Long month names. */
1589 DEFINE_NLITEM_CONSTANT (MON_1
); /* January */
1590 DEFINE_NLITEM_CONSTANT (MON_2
);
1591 DEFINE_NLITEM_CONSTANT (MON_3
);
1592 DEFINE_NLITEM_CONSTANT (MON_4
);
1593 DEFINE_NLITEM_CONSTANT (MON_5
);
1594 DEFINE_NLITEM_CONSTANT (MON_6
);
1595 DEFINE_NLITEM_CONSTANT (MON_7
);
1596 DEFINE_NLITEM_CONSTANT (MON_8
);
1597 DEFINE_NLITEM_CONSTANT (MON_9
);
1598 DEFINE_NLITEM_CONSTANT (MON_10
);
1599 DEFINE_NLITEM_CONSTANT (MON_11
);
1600 DEFINE_NLITEM_CONSTANT (MON_12
);
1602 DEFINE_NLITEM_CONSTANT (AM_STR
); /* Ante meridiem string. */
1603 DEFINE_NLITEM_CONSTANT (PM_STR
); /* Post meridiem string. */
1605 DEFINE_NLITEM_CONSTANT (D_T_FMT
); /* Date and time format for strftime. */
1606 DEFINE_NLITEM_CONSTANT (D_FMT
); /* Date format for strftime. */
1607 DEFINE_NLITEM_CONSTANT (T_FMT
); /* Time format for strftime. */
1608 DEFINE_NLITEM_CONSTANT (T_FMT_AMPM
);/* 12-hour time format for strftime. */
1610 DEFINE_NLITEM_CONSTANT (ERA
); /* Alternate era. */
1611 DEFINE_NLITEM_CONSTANT (ERA_D_FMT
); /* Date in alternate era format. */
1612 DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT
); /* Date and time in alternate era
1614 DEFINE_NLITEM_CONSTANT (ERA_T_FMT
); /* Time in alternate era format. */
1616 DEFINE_NLITEM_CONSTANT (ALT_DIGITS
); /* Alternate symbols for digits. */
1617 DEFINE_NLITEM_CONSTANT (RADIXCHAR
);
1618 DEFINE_NLITEM_CONSTANT (THOUSEP
);
1621 DEFINE_NLITEM_CONSTANT (YESEXPR
);
1624 DEFINE_NLITEM_CONSTANT (NOEXPR
);
1627 #ifdef CRNCYSTR /* currency symbol */
1628 DEFINE_NLITEM_CONSTANT (CRNCYSTR
);
1631 /* GNU extensions. */
1634 DEFINE_NLITEM_CONSTANT (ERA_YEAR
); /* Year in alternate era format. */
1637 /* LC_MONETARY category: formatting of monetary quantities.
1638 These items each correspond to a member of `struct lconv',
1639 defined in <locale.h>. */
1640 #ifdef INT_CURR_SYMBOL
1641 DEFINE_NLITEM_CONSTANT (INT_CURR_SYMBOL
);
1643 #ifdef MON_DECIMAL_POINT
1644 DEFINE_NLITEM_CONSTANT (MON_DECIMAL_POINT
);
1646 #ifdef MON_THOUSANDS_SEP
1647 DEFINE_NLITEM_CONSTANT (MON_THOUSANDS_SEP
);
1650 DEFINE_NLITEM_CONSTANT (MON_GROUPING
);
1652 #ifdef POSITIVE_SIGN
1653 DEFINE_NLITEM_CONSTANT (POSITIVE_SIGN
);
1655 #ifdef NEGATIVE_SIGN
1656 DEFINE_NLITEM_CONSTANT (NEGATIVE_SIGN
);
1659 DEFINE_NLITEM_CONSTANT (GROUPING
);
1661 #ifdef INT_FRAC_DIGITS
1662 DEFINE_NLITEM_CONSTANT (INT_FRAC_DIGITS
);
1665 DEFINE_NLITEM_CONSTANT (FRAC_DIGITS
);
1667 #ifdef P_CS_PRECEDES
1668 DEFINE_NLITEM_CONSTANT (P_CS_PRECEDES
);
1670 #ifdef P_SEP_BY_SPACE
1671 DEFINE_NLITEM_CONSTANT (P_SEP_BY_SPACE
);
1673 #ifdef N_CS_PRECEDES
1674 DEFINE_NLITEM_CONSTANT (N_CS_PRECEDES
);
1676 #ifdef N_SEP_BY_SPACE
1677 DEFINE_NLITEM_CONSTANT (N_SEP_BY_SPACE
);
1680 DEFINE_NLITEM_CONSTANT (P_SIGN_POSN
);
1683 DEFINE_NLITEM_CONSTANT (N_SIGN_POSN
);
1685 #ifdef INT_P_CS_PRECEDES
1686 DEFINE_NLITEM_CONSTANT (INT_P_CS_PRECEDES
);
1688 #ifdef INT_P_SEP_BY_SPACE
1689 DEFINE_NLITEM_CONSTANT (INT_P_SEP_BY_SPACE
);
1691 #ifdef INT_N_CS_PRECEDES
1692 DEFINE_NLITEM_CONSTANT (INT_N_CS_PRECEDES
);
1694 #ifdef INT_N_SEP_BY_SPACE
1695 DEFINE_NLITEM_CONSTANT (INT_N_SEP_BY_SPACE
);
1697 #ifdef INT_P_SIGN_POSN
1698 DEFINE_NLITEM_CONSTANT (INT_P_SIGN_POSN
);
1700 #ifdef INT_N_SIGN_POSN
1701 DEFINE_NLITEM_CONSTANT (INT_N_SIGN_POSN
);
1704 #undef DEFINE_NLITEM_CONSTANT
1706 #endif /* HAVE_NL_TYPES_H */
1713 SCM global_locale_smob
;
1715 #ifdef HAVE_NL_LANGINFO
1716 scm_add_feature ("nl-langinfo");
1717 define_langinfo_items ();
1720 #include "libguile/i18n.x"
1722 #ifndef USE_GNU_LOCALE_API
1723 scm_set_smob_mark (scm_tc16_locale_smob_type
, smob_locale_mark
);
1726 /* Initialize the global locale object with a special `locale' SMOB. */
1727 SCM_NEWSMOB (global_locale_smob
, scm_tc16_locale_smob_type
, NULL
);
1728 SCM_VARIABLE_SET (scm_global_locale
, global_locale_smob
);