summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-09-12 17:00:59 +0200
committerAndy Wingo <wingo@pobox.com>2014-09-12 17:00:59 +0200
commitc5ea75534c683638fb1f3b328efe6ba0d242e485 (patch)
tree657b4fc7a585b54c4d05c8ec703241ca94562bd9
parent7f5887e70b632d49b52679f383eff07d656e59a3 (diff)
downloadguile-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.texi18
-rw-r--r--libguile/Makefile.am4
-rw-r--r--libguile/init.c2
-rw-r--r--libguile/unicode.c95
-rw-r--r--libguile/unicode.h37
-rw-r--r--module/Makefile.am3
-rw-r--r--module/ice-9/unicode.scm26
-rw-r--r--test-suite/Makefile.am1
-rw-r--r--test-suite/tests/unicode.test28
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"))