diff options
author | Ludovic Courtès <ludo@gnu.org> | 2006-11-18 18:18:23 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2006-11-18 18:18:23 +0000 |
commit | 5b3a39c7ff472eee3978784549a6902c09600810 (patch) | |
tree | 5c24f2d19bf5ac9760d5c73b78a8cac70ffe36b4 | |
parent | b89c494395ce659d04508f47ea489d4fd1002182 (diff) | |
download | guile-5b3a39c7ff472eee3978784549a6902c09600810.tar.gz |
Added missing files for `(ice-9 i18n)'.
-rw-r--r-- | ice-9/i18n.scm | 67 | ||||
-rw-r--r-- | libguile/gettext.c | 331 | ||||
-rw-r--r-- | libguile/libgettext.h | 69 | ||||
-rw-r--r-- | libguile/locale-categories.h | 47 | ||||
-rw-r--r-- | test-suite/tests/i18n.test | 143 |
5 files changed, 657 insertions, 0 deletions
diff --git a/ice-9/i18n.scm b/ice-9/i18n.scm new file mode 100644 index 000000000..e782ee21a --- /dev/null +++ b/ice-9/i18n.scm @@ -0,0 +1,67 @@ +;;;; i18n.scm --- internationalization support + +;;;; Copyright (C) 2006 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2.1 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Author: Ludovic Courtès <ludovic.courtes@laas.fr> + +;;; Commentary: +;;; +;;; This module provides a number of routines that support +;;; internationalization (e.g., locale-dependent text collation, character +;;; mapping, etc.). It also defines `locale' objects, representing locale +;;; settings, that may be passed around to most of these procedures. +;;; + +;;; Code: + +(define-module (ice-9 i18n) + :export (;; `locale' type + make-locale locale? + + ;; locale category masks (standard) + LC_ALL_MASK + LC_COLLATE_MASK LC_CTYPE_MASK LC_MESSAGES_MASK + LC_MONETARY_MASK LC_NUMERIC_MASK LC_TIME_MASK + + ;; locale category masks (non-standard) + LC_PAPER_MASK LC_NAME_MASK LC_ADDRESS_MASK + LC_TELEPHONE_MASK LC_MEASUREMENT_MASK + LC_IDENTIFICATION_MASK + + ;; text collation + string-locale<? string-locale>? + string-locale-ci<? string-locale-ci>? string-locale-ci=? + + char-locale<? char-locale>? + char-locale-ci<? char-locale-ci>? char-locale-ci=? + + ;; character mapping + char-locale-downcase char-locale-upcase + string-locale-downcase string-locale-upcase + + ;; reading numbers + locale-string->integer locale-string->inexact)) + + +(load-extension "libguile-i18n-v-0" "scm_init_i18n") + + +;;; Local Variables: +;;; coding: latin-1 +;;; End: + +;;; i18n.scm ends here diff --git a/libguile/gettext.c b/libguile/gettext.c new file mode 100644 index 000000000..91a51439c --- /dev/null +++ b/libguile/gettext.c @@ -0,0 +1,331 @@ +/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + + +#if HAVE_CONFIG_H +# include <config.h> +#endif + +#include "libguile/_scm.h" +#include "libguile/feature.h" +#include "libguile/strings.h" +#include "libguile/dynwind.h" + +#include "libguile/gettext.h" +#include "libgettext.h" +#include <locale.h> + + +int +scm_i_to_lc_category (SCM category, int allow_lc_all) +{ + int c_category = scm_to_int (category); + switch (c_category) + { +#ifdef LC_CTYPE + case LC_CTYPE: +#endif +#ifdef LC_NUMERIC + case LC_NUMERIC: +#endif +#ifdef LC_COLLATE + case LC_COLLATE: +#endif +#ifdef LC_TIME + case LC_TIME: +#endif +#ifdef LC_MONETARY + case LC_MONETARY: +#endif +#ifdef LC_MESSAGES + case LC_MESSAGES: +#endif +#ifdef LC_PAPER + case LC_PAPER: +#endif +#ifdef LC_NAME + case LC_NAME: +#endif +#ifdef LC_ADDRESS + case LC_ADDRESS: +#endif +#ifdef LC_TELEPHONE + case LC_TELEPHONE: +#endif +#ifdef LC_MEASUREMENT + case LC_MEASUREMENT: +#endif +#ifdef LC_IDENTIFICATION + case LC_IDENTIFICATION: +#endif + return c_category; +#ifdef LC_ALL + case LC_ALL: + if (allow_lc_all) + return c_category; +#endif + } + scm_wrong_type_arg (0, 0, category); +} + +SCM_DEFINE (scm_gettext, "gettext", 1, 2, 0, + (SCM msgid, SCM domain, SCM category), + "Return the translation of @var{msgid} in the message domain " + "@var{domain}. @var{domain} is optional and defaults to the " + "domain set through (textdomain). @var{category} is optional " + "and defaults to LC_MESSAGES.") +#define FUNC_NAME s_scm_gettext +{ + char *c_msgid; + char const *c_result; + SCM result; + + scm_dynwind_begin (0); + + c_msgid = scm_to_locale_string (msgid); + scm_dynwind_free (c_msgid); + + if (SCM_UNBNDP (domain)) + { + /* 1 argument case. */ + c_result = gettext (c_msgid); + } + else + { + char *c_domain; + + c_domain = scm_to_locale_string (domain); + scm_dynwind_free (c_domain); + + if (SCM_UNBNDP (category)) + { + /* 2 argument case. */ + c_result = dgettext (c_domain, c_msgid); + } + else + { + /* 3 argument case. */ + int c_category; + + c_category = scm_i_to_lc_category (category, 0); + c_result = dcgettext (c_domain, c_msgid, c_category); + } + } + + if (c_result == c_msgid) + result = msgid; + else + result = scm_from_locale_string (c_result); + + scm_dynwind_end (); + return result; +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_ngettext, "ngettext", 3, 2, 0, + (SCM msgid, SCM msgid_plural, SCM n, SCM domain, SCM category), + "Return the translation of @var{msgid}/@var{msgid_plural} in the " + "message domain @var{domain}, with the plural form being chosen " + "appropriately for the number @var{n}. @var{domain} is optional " + "and defaults to the domain set through (textdomain). " + "@var{category} is optional and defaults to LC_MESSAGES.") +#define FUNC_NAME s_scm_ngettext +{ + char *c_msgid; + char *c_msgid_plural; + unsigned long c_n; + const char *c_result; + SCM result; + + scm_dynwind_begin (0); + + c_msgid = scm_to_locale_string (msgid); + scm_dynwind_free (c_msgid); + + c_msgid_plural = scm_to_locale_string (msgid_plural); + scm_dynwind_free (c_msgid_plural); + + c_n = scm_to_ulong (n); + + if (SCM_UNBNDP (domain)) + { + /* 3 argument case. */ + c_result = ngettext (c_msgid, c_msgid_plural, c_n); + } + else + { + char *c_domain; + + c_domain = scm_to_locale_string (domain); + scm_dynwind_free (c_domain); + + if (SCM_UNBNDP (category)) + { + /* 4 argument case. */ + c_result = dngettext (c_domain, c_msgid, c_msgid_plural, c_n); + } + else + { + /* 5 argument case. */ + int c_category; + + c_category = scm_i_to_lc_category (category, 0); + c_result = dcngettext (c_domain, c_msgid, c_msgid_plural, c_n, + c_category); + } + } + + if (c_result == c_msgid) + result = msgid; + else if (c_result == c_msgid_plural) + result = msgid_plural; + else + result = scm_from_locale_string (c_result); + + scm_dynwind_end (); + return result; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_textdomain, "textdomain", 0, 1, 0, + (SCM domainname), + "If optional parameter @var{domainname} is supplied, " + "set the textdomain. " + "Return the textdomain.") +#define FUNC_NAME s_scm_textdomain +{ + char const *c_result; + char *c_domain; + SCM result = SCM_BOOL_F; + + scm_dynwind_begin (0); + + if (SCM_UNBNDP (domainname)) + c_domain = NULL; + else + { + c_domain = scm_to_locale_string (domainname); + scm_dynwind_free (c_domain); + } + + c_result = textdomain (c_domain); + if (c_result != NULL) + result = scm_from_locale_string (c_result); + else if (!SCM_UNBNDP (domainname)) + SCM_SYSERROR; + + scm_dynwind_end (); + return result; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_bindtextdomain, "bindtextdomain", 1, 1, 0, + (SCM domainname, SCM directory), + "If optional parameter @var{directory} is supplied, " + "set message catalogs to directory @var{directory}. " + "Return the directory bound to @var{domainname}.") +#define FUNC_NAME s_scm_bindtextdomain +{ + char *c_domain; + char *c_directory; + char const *c_result; + SCM result; + + scm_dynwind_begin (0); + + if (SCM_UNBNDP (directory)) + c_directory = NULL; + else + { + c_directory = scm_to_locale_string (directory); + scm_dynwind_free (c_directory); + } + + c_domain = scm_to_locale_string (domainname); + scm_dynwind_free (c_domain); + + c_result = bindtextdomain (c_domain, c_directory); + + if (c_result != NULL) + result = scm_from_locale_string (c_result); + else if (!SCM_UNBNDP (directory)) + SCM_SYSERROR; + else + result = SCM_BOOL_F; + + scm_dynwind_end (); + return result; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_bind_textdomain_codeset, "bind-textdomain-codeset", 1, 1, 0, + (SCM domainname, SCM encoding), + "If optional parameter @var{encoding} is supplied, " + "set encoding for message catalogs of @var{domainname}. " + "Return the encoding of @var{domainname}.") +#define FUNC_NAME s_scm_bind_textdomain_codeset +{ + char *c_domain; + char *c_encoding; + char const *c_result; + SCM result; + + scm_dynwind_begin (0); + + if (SCM_UNBNDP (encoding)) + c_encoding = NULL; + else + { + c_encoding = scm_to_locale_string (encoding); + scm_dynwind_free (c_encoding); + } + + c_domain = scm_to_locale_string (domainname); + scm_dynwind_free (c_domain); + + c_result = bind_textdomain_codeset (c_domain, c_encoding); + + if (c_result != NULL) + result = scm_from_locale_string (c_result); + else if (!SCM_UNBNDP (encoding)) + SCM_SYSERROR; + else + result = SCM_BOOL_F; + + scm_dynwind_end (); + return result; +} +#undef FUNC_NAME + +void +scm_init_gettext () +{ + /* When gettext support was first added (in 1.8.0), it provided feature + `i18n'. We keep this as is although the name is a bit misleading + now. */ + scm_add_feature ("i18n"); + +#include "libguile/gettext.x" +} + + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/libgettext.h b/libguile/libgettext.h new file mode 100644 index 000000000..f54b6bff7 --- /dev/null +++ b/libguile/libgettext.h @@ -0,0 +1,69 @@ +/* Convenience header for conditional use of GNU <libintl.h>. + Copyright (C) 1995-1998, 2000-2002, 2006 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published + by the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, + USA. */ + +#ifndef _LIBGETTEXT_H +#define _LIBGETTEXT_H 1 + +/* NLS can be disabled through the configure --disable-nls option. */ +#if ENABLE_NLS + +/* Get declarations of GNU message catalog functions. */ +# include <libintl.h> + +#else + +/* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which + chokes if dcgettext is defined as a macro. So include it now, to make + later inclusions of <locale.h> a NOP. We don't include <libintl.h> + as well because people using "gettext.h" will not include <libintl.h>, + and also including <libintl.h> would fail on SunOS 4, whereas <locale.h> + is OK. */ +#if defined(__sun) +# include <locale.h> +#endif + +/* Disabled NLS. + The casts to 'const char *' serve the purpose of producing warnings + for invalid uses of the value returned from these functions. + On pre-ANSI systems without 'const', the config.h file is supposed to + contain "#define const". */ +# define gettext(Msgid) ((const char *) (Msgid)) +# define dgettext(Domainname, Msgid) ((const char *) (Msgid)) +# define dcgettext(Domainname, Msgid, Category) ((const char *) (Msgid)) +# define ngettext(Msgid1, Msgid2, N) \ + ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2)) +# define dngettext(Domainname, Msgid1, Msgid2, N) \ + ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2)) +# define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \ + ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2)) +# define textdomain(Domainname) ((const char *) (Domainname)) +# define bindtextdomain(Domainname, Dirname) ((const char *) (Dirname)) +# define bind_textdomain_codeset(Domainname, Codeset) ((const char *) (Codeset)) + +#endif + +/* A pseudo function call that serves as a marker for the automated + extraction of messages, but does not call gettext(). The run-time + translation is done at a different place in the code. + The argument, String, should be a literal string. Concatenated strings + and other string expressions won't work. + The macro's expansion is not parenthesized, so that it is suitable as + initializer for static 'char[]' or 'const char[]' variables. */ +#define gettext_noop(String) String + +#endif /* _LIBGETTEXT_H */ diff --git a/libguile/locale-categories.h b/libguile/locale-categories.h new file mode 100644 index 000000000..cec91fb91 --- /dev/null +++ b/libguile/locale-categories.h @@ -0,0 +1,47 @@ +/* Copyright (C) 2006 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +/* A list of all available locale categories, not including `ALL'. */ + + +/* The six standard categories, as defined in IEEE Std 1003.1-2001. */ +SCM_DEFINE_LOCALE_CATEGORY (COLLATE) +SCM_DEFINE_LOCALE_CATEGORY (CTYPE) +SCM_DEFINE_LOCALE_CATEGORY (MESSAGES) +SCM_DEFINE_LOCALE_CATEGORY (MONETARY) +SCM_DEFINE_LOCALE_CATEGORY (NUMERIC) +SCM_DEFINE_LOCALE_CATEGORY (TIME) + +/* Additional non-standard categories. */ +#ifdef LC_PAPER +SCM_DEFINE_LOCALE_CATEGORY (PAPER) +#endif +#ifdef LC_NAME +SCM_DEFINE_LOCALE_CATEGORY (NAME) +#endif +#ifdef LC_ADDRESS +SCM_DEFINE_LOCALE_CATEGORY (ADDRESS) +#endif +#ifdef LC_TELEPHONE +SCM_DEFINE_LOCALE_CATEGORY (TELEPHONE) +#endif +#ifdef LC_MEASUREMENT +SCM_DEFINE_LOCALE_CATEGORY (MEASUREMENT) +#endif +#ifdef LC_IDENTIFICATION +SCM_DEFINE_LOCALE_CATEGORY (IDENTIFICATION) +#endif diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test new file mode 100644 index 000000000..fca99c768 --- /dev/null +++ b/test-suite/tests/i18n.test @@ -0,0 +1,143 @@ +;;;; i18n.test --- Exercise the i18n API. +;;;; +;;;; Copyright (C) 2006 Free Software Foundation, Inc. +;;;; Ludovic Courtès +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2.1 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-suite i18n) + :use-module (ice-9 i18n) + :use-module (test-suite lib)) + +;; Start from a pristine locale state. +(setlocale LC_ALL "C") + + +(with-test-prefix "locale objects" + + (pass-if "make-locale (2 args)" + (not (not (make-locale LC_ALL_MASK "C")))) + + (pass-if "make-locale (3 args)" + (not (not (make-locale LC_COLLATE_MASK "C" + (make-locale LC_MESSAGES_MASK "C"))))) + + (pass-if "locale?" + (and (locale? (make-locale LC_ALL_MASK "C")) + (locale? (make-locale (logior LC_MESSAGES_MASK LC_NUMERIC_MASK) "C" + (make-locale LC_CTYPE_MASK "C")))))) + + + +(with-test-prefix "text collation (English)" + + (pass-if "string-locale<?" + (and (string-locale<? "hello" "world") + (string-locale<? "hello" "world" + (make-locale LC_COLLATE_MASK "C")))) + + (pass-if "char-locale<?" + (and (char-locale<? #\a #\b) + (char-locale<? #\a #\b (make-locale LC_COLLATE_MASK "C")))) + + (pass-if "string-locale-ci=?" + (and (string-locale-ci=? "Hello" "HELLO") + (string-locale-ci=? "Hello" "HELLO" + (make-locale LC_COLLATE_MASK "C")))) + + (pass-if "string-locale-ci<?" + (and (string-locale-ci<? "hello" "WORLD") + (string-locale-ci<? "hello" "WORLD" + (make-locale LC_COLLATE_MASK "C"))))) + + +(define %french-locale + (false-if-exception + (make-locale (logior LC_CTYPE_MASK LC_COLLATE_MASK) + "fr_FR.ISO-8859-1"))) + +(define (under-french-locale-or-unresolved thunk) + ;; On non-GNU systems, an exception may be raised only when the locale is + ;; actually used rather than at `make-locale'-time. Thus, we must guard + ;; against both. + (if %french-locale + (catch 'system-error thunk + (lambda (key . args) + (throw 'unresolved))) + (throw 'unresolved))) + +(with-test-prefix "text collation (French)" + + (pass-if "string-locale<?" + (under-french-locale-or-unresolved + (lambda () + (string-locale<? "été" "hiver" %french-locale)))) + + (pass-if "char-locale<?" + (under-french-locale-or-unresolved + (lambda () + (char-locale<? #\é #\h %french-locale)))) + + (pass-if "string-locale-ci=?" + (under-french-locale-or-unresolved + (lambda () + (string-locale-ci=? "ÉTÉ" "été" %french-locale)))) + + (pass-if "string-locale-ci<>?" + (under-french-locale-or-unresolved + (lambda () + (and (string-locale-ci<? "été" "Hiver" %french-locale) + (string-locale-ci>? "HiVeR" "été" %french-locale))))) + + (pass-if "char-locale-ci<>?" + (under-french-locale-or-unresolved + (lambda () + (and (char-locale-ci<? #\é #\H %french-locale) + (char-locale-ci>? #\h #\É %french-locale)))))) + + +(with-test-prefix "character mapping" + + (pass-if "char-locale-downcase" + (and (eq? #\a (char-locale-downcase #\A)) + (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL_MASK "C"))))) + + (pass-if "char-locale-upcase" + (and (eq? #\Z (char-locale-upcase #\z)) + (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL_MASK "C")))))) + + +(with-test-prefix "number parsing" + + (pass-if "locale-string->integer" + (call-with-values (lambda () (locale-string->integer "123")) + (lambda (result char-count) + (and (equal? result 123) + (equal? char-count 3))))) + + (pass-if "locale-string->inexact" + (call-with-values + (lambda () + (locale-string->inexact "123.456" + (make-locale LC_NUMERIC_MASK "C"))) + (lambda (result char-count) + (and (equal? result 123.456) + (equal? char-count 7)))))) + + +;;; Local Variables: +;;; coding: latin-1 +;;; mode: scheme +;;; End: |