mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
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.
This commit is contained in:
parent
7a71a45cfd
commit
3157d45503
9 changed files with 213 additions and 1 deletions
|
@ -2331,6 +2331,24 @@ lowercase, and titlecase forms respectively. The type
|
||||||
@code{scm_t_wchar} is a signed, 32-bit integer.
|
@code{scm_t_wchar} is a signed, 32-bit integer.
|
||||||
@end deftypefn
|
@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
|
@node Character Sets
|
||||||
@subsection Character Sets
|
@subsection Character Sets
|
||||||
|
|
||||||
|
|
|
@ -215,6 +215,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
|
||||||
threads.c \
|
threads.c \
|
||||||
throw.c \
|
throw.c \
|
||||||
trees.c \
|
trees.c \
|
||||||
|
unicode.c \
|
||||||
uniform.c \
|
uniform.c \
|
||||||
values.c \
|
values.c \
|
||||||
variable.c \
|
variable.c \
|
||||||
|
@ -312,6 +313,7 @@ DOT_X_FILES = \
|
||||||
threads.x \
|
threads.x \
|
||||||
throw.x \
|
throw.x \
|
||||||
trees.x \
|
trees.x \
|
||||||
|
unicode.x \
|
||||||
uniform.x \
|
uniform.x \
|
||||||
values.x \
|
values.x \
|
||||||
variable.x \
|
variable.x \
|
||||||
|
@ -413,6 +415,7 @@ DOT_DOC_FILES = \
|
||||||
threads.doc \
|
threads.doc \
|
||||||
throw.doc \
|
throw.doc \
|
||||||
trees.doc \
|
trees.doc \
|
||||||
|
unicode.doc \
|
||||||
uniform.doc \
|
uniform.doc \
|
||||||
values.doc \
|
values.doc \
|
||||||
variable.doc \
|
variable.doc \
|
||||||
|
@ -651,6 +654,7 @@ modinclude_HEADERS = \
|
||||||
throw.h \
|
throw.h \
|
||||||
trees.h \
|
trees.h \
|
||||||
validate.h \
|
validate.h \
|
||||||
|
unicode.h \
|
||||||
uniform.h \
|
uniform.h \
|
||||||
values.h \
|
values.h \
|
||||||
variable.h \
|
variable.h \
|
||||||
|
|
|
@ -129,6 +129,7 @@
|
||||||
#include "libguile/throw.h"
|
#include "libguile/throw.h"
|
||||||
#include "libguile/arrays.h"
|
#include "libguile/arrays.h"
|
||||||
#include "libguile/trees.h"
|
#include "libguile/trees.h"
|
||||||
|
#include "libguile/unicode.h"
|
||||||
#include "libguile/values.h"
|
#include "libguile/values.h"
|
||||||
#include "libguile/variable.h"
|
#include "libguile/variable.h"
|
||||||
#include "libguile/vectors.h"
|
#include "libguile/vectors.h"
|
||||||
|
@ -512,6 +513,7 @@ scm_i_init_guile (void *base)
|
||||||
#endif
|
#endif
|
||||||
scm_bootstrap_i18n ();
|
scm_bootstrap_i18n ();
|
||||||
scm_init_script ();
|
scm_init_script ();
|
||||||
|
scm_init_unicode ();
|
||||||
|
|
||||||
scm_init_goops ();
|
scm_init_goops ();
|
||||||
|
|
||||||
|
|
95
libguile/unicode.c
Normal file
95
libguile/unicode.c
Normal file
|
@ -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:
|
||||||
|
*/
|
37
libguile/unicode.h
Normal file
37
libguile/unicode.h
Normal file
|
@ -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:
|
||||||
|
*/
|
|
@ -255,7 +255,8 @@ ICE_9_SOURCES = \
|
||||||
ice-9/weak-vector.scm \
|
ice-9/weak-vector.scm \
|
||||||
ice-9/list.scm \
|
ice-9/list.scm \
|
||||||
ice-9/serialize.scm \
|
ice-9/serialize.scm \
|
||||||
ice-9/local-eval.scm
|
ice-9/local-eval.scm \
|
||||||
|
ice-9/unicode.scm
|
||||||
|
|
||||||
srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
|
srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
|
||||||
|
|
||||||
|
|
26
module/ice-9/unicode.scm
Normal file
26
module/ice-9/unicode.scm
Normal file
|
@ -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"))
|
|
@ -176,6 +176,7 @@ SCM_TESTS = tests/00-initial-env.test \
|
||||||
tests/time.test \
|
tests/time.test \
|
||||||
tests/tree-il.test \
|
tests/tree-il.test \
|
||||||
tests/types.test \
|
tests/types.test \
|
||||||
|
tests/unicode.test \
|
||||||
tests/version.test \
|
tests/version.test \
|
||||||
tests/vectors.test \
|
tests/vectors.test \
|
||||||
tests/vlist.test \
|
tests/vlist.test \
|
||||||
|
|
28
test-suite/tests/unicode.test
Normal file
28
test-suite/tests/unicode.test
Normal file
|
@ -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"))
|
Loading…
Add table
Add a link
Reference in a new issue