diff options
author | Andy Wingo <wingo@pobox.com> | 2014-09-12 17:00:59 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-09-12 17:00:59 +0200 |
commit | c5ea75534c683638fb1f3b328efe6ba0d242e485 (patch) | |
tree | 657b4fc7a585b54c4d05c8ec703241ca94562bd9 | |
parent | 7f5887e70b632d49b52679f383eff07d656e59a3 (diff) | |
download | guile-c5ea75534c683638fb1f3b328efe6ba0d242e485.tar.gz |
Add (ice-9 unicode) module
* libguile/unicode.c:
* libguile/unicode.h:
* test-suite/tests/unicode.test:
* module/ice-9/unicode.scm: New files.
* module/Makefile.am:
* libguile/Makefile.am:
* test-suite/Makefile.am:
* libguile/init.c: Wire new files into the build.
* doc/ref/api-data.texi: Add docs.
-rw-r--r-- | doc/ref/api-data.texi | 18 | ||||
-rw-r--r-- | libguile/Makefile.am | 4 | ||||
-rw-r--r-- | libguile/init.c | 2 | ||||
-rw-r--r-- | libguile/unicode.c | 95 | ||||
-rw-r--r-- | libguile/unicode.h | 37 | ||||
-rw-r--r-- | module/Makefile.am | 3 | ||||
-rw-r--r-- | module/ice-9/unicode.scm | 26 | ||||
-rw-r--r-- | test-suite/Makefile.am | 1 | ||||
-rw-r--r-- | test-suite/tests/unicode.test | 28 |
9 files changed, 213 insertions, 1 deletions
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 96f9fd017..23f3bfc73 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -2335,6 +2335,24 @@ lowercase, and titlecase forms respectively. The type @code{scm_t_wchar} is a signed, 32-bit integer. @end deftypefn +Characters also have ``formal names'', which are defined by Unicode. +These names can be accessed in Guile from the @code{(ice-9 unicode)} +module: + +@example +(use-modules (ice-9 unicode)) +@end example + +@deffn {Scheme Procedure} char->formal-name chr +Return the formal all-upper-case Unicode name of @var{ch}, +as a string, or @code{#f} if the character has no name. +@end deffn + +@deffn {Scheme Procedure} formal-name->char name +Return the character whose formal all-upper-case Unicode name is +@var{name}, or @code{#f} if no such character is known. +@end deffn + @node Character Sets @subsection Character Sets diff --git a/libguile/Makefile.am b/libguile/Makefile.am index df0c7ce01..8302a1805 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -215,6 +215,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ threads.c \ throw.c \ trees.c \ + unicode.c \ uniform.c \ values.c \ variable.c \ @@ -318,6 +319,7 @@ DOT_X_FILES = \ threads.x \ throw.x \ trees.x \ + unicode.x \ uniform.x \ values.x \ variable.x \ @@ -419,6 +421,7 @@ DOT_DOC_FILES = \ threads.doc \ throw.doc \ trees.doc \ + unicode.doc \ uniform.doc \ values.doc \ variable.doc \ @@ -664,6 +667,7 @@ modinclude_HEADERS = \ throw.h \ trees.h \ validate.h \ + unicode.h \ uniform.h \ values.h \ variable.h \ diff --git a/libguile/init.c b/libguile/init.c index b4c966caa..50ea1966f 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -128,6 +128,7 @@ #include "libguile/throw.h" #include "libguile/arrays.h" #include "libguile/trees.h" +#include "libguile/unicode.h" #include "libguile/values.h" #include "libguile/variable.h" #include "libguile/vectors.h" @@ -508,6 +509,7 @@ scm_i_init_guile (void *base) #endif scm_bootstrap_i18n (); scm_init_script (); + scm_init_unicode (); scm_init_goops (); diff --git a/libguile/unicode.c b/libguile/unicode.c new file mode 100644 index 000000000..65d319a1d --- /dev/null +++ b/libguile/unicode.c @@ -0,0 +1,95 @@ +/* Copyright (C) 2014 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 3 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, see + * <http://www.gnu.org/licenses/>. + */ + + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <ctype.h> +#include <limits.h> +#include <unicase.h> +#include <unictype.h> +#include <uniname.h> + +#include "libguile/_scm.h" +#include "libguile/validate.h" + +#include "libguile/unicode.h" + + + +SCM_DEFINE (scm_char_to_formal_name, "char->formal-name", 1, 0, 0, + (SCM ch), + "Return the formal all-upper-case unicode name of @var{ch},\n" + "as a string. If the character has no name, return @code{#f}.") +#define FUNC_NAME s_scm_char_to_formal_name +{ + char buf[UNINAME_MAX + 1]; + + SCM_VALIDATE_CHAR (1, ch); + + memset(buf, 0, UNINAME_MAX + 1); + + if (unicode_character_name (SCM_CHAR (ch), buf)) + return scm_from_latin1_string (buf); + + return SCM_BOOL_F; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_formal_name_to_char, "formal-name->char", 1, 0, 0, + (SCM name), + "Return the character whose formal all-upper-case unicode name is\n" + "@var{name}, or @code{#f} if no such character is known.") +#define FUNC_NAME s_scm_formal_name_to_char +{ + char *c_name; + scm_t_wchar ret; + + SCM_VALIDATE_STRING (1, name); + + c_name = scm_to_latin1_string (name); + ret = unicode_name_character (c_name); + free (c_name); + + return ret == UNINAME_INVALID ? SCM_BOOL_F : SCM_MAKE_CHAR (ret); +} +#undef FUNC_NAME + +static void +scm_load_unicode (void) +{ +#ifndef SCM_MAGIC_SNARFER +#include "libguile/unicode.x" +#endif +} + +void +scm_init_unicode (void) +{ + scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, + "scm_init_unicode", + (scm_t_extension_init_func)scm_load_unicode, + NULL); +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/unicode.h b/libguile/unicode.h new file mode 100644 index 000000000..88261c109 --- /dev/null +++ b/libguile/unicode.h @@ -0,0 +1,37 @@ +/* classes: h_files */ + +#ifndef SCM_UNICODE_H +#define SCM_UNICODE_H + +/* Copyright (C) 2014 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 3 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, see + * <http://www.gnu.org/licenses/>. + */ + + + +#include "libguile/__scm.h" + +SCM_INTERNAL SCM scm_formal_name_to_char (SCM); +SCM_INTERNAL SCM scm_char_to_formal_name (SCM); +SCM_INTERNAL void scm_init_unicode (void); + +#endif /* SCM_UNICODE_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/module/Makefile.am b/module/Makefile.am index aa7f8ee0b..8de297245 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -277,7 +277,8 @@ ICE_9_SOURCES = \ ice-9/weak-vector.scm \ ice-9/list.scm \ ice-9/serialize.scm \ - ice-9/local-eval.scm + ice-9/local-eval.scm \ + ice-9/unicode.scm if BUILD_ICE_9_POPEN diff --git a/module/ice-9/unicode.scm b/module/ice-9/unicode.scm new file mode 100644 index 000000000..534d9c480 --- /dev/null +++ b/module/ice-9/unicode.scm @@ -0,0 +1,26 @@ +;; unicode + +;;;; Copyright (C) 2014 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 3 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, see +;;;; <http://www.gnu.org/licenses/>. +;;;; + +(define-module (ice-9 unicode) + #:export (formal-name->char + char->formal-name)) + +(eval-when (expand load eval) + (load-extension (string-append "libguile-" (effective-version)) + "scm_init_unicode")) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index c38d12ba0..41c5549cc 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -180,6 +180,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/time.test \ tests/tree-il.test \ tests/types.test \ + tests/unicode.test \ tests/version.test \ tests/vectors.test \ tests/vlist.test \ diff --git a/test-suite/tests/unicode.test b/test-suite/tests/unicode.test new file mode 100644 index 000000000..5cfafca26 --- /dev/null +++ b/test-suite/tests/unicode.test @@ -0,0 +1,28 @@ +;;;; unicode.test -*- scheme -*- +;;;; +;;;; Copyright (C) 2014 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 3 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, see +;;;; <http://www.gnu.org/licenses/>. +;;;; + +(define-module (test-suite test-unicode) + #:use-module (test-suite lib) + #:use-module (ice-9 unicode)) + +(pass-if-equal "LATIN SMALL LETTER A" (char->formal-name #\a)) +(pass-if-equal #\a (formal-name->char "LATIN SMALL LETTER A")) + +(pass-if-equal #f (char->formal-name #\nul)) +(pass-if-equal #f (formal-name->char "not a known formal name")) |