summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2014-01-12 04:36:57 -0500
committerMark H Weaver <mhw@netris.org>2014-01-14 02:24:44 -0500
commit394449d5d3922cab783d51398b7727ccaf07dd76 (patch)
tree6e473c905ca55e319e68e932baad79bdde1663a2
parent6579c3308d386ce74627e2cfb734898c9ed83d3a (diff)
Recognize 'escape' character name, per R7RS.
* libguile/chars.c (scm_r7rs_charnames, scm_r7rs_charnums): New static constants. (SCM_N_R7RS_CHARNAMES): New macro. (scm_i_charname, scm_i_charname_to_char): Adapt to new R7RS char names. * doc/ref/api-data.texi (Characters): Document #\escape. * test-suite/tests/reader.test ("reading"): Add test.
-rw-r--r--doc/ref/api-data.texi3
-rw-r--r--libguile/chars.c28
-rw-r--r--test-suite/tests/reader.test4
3 files changed, 32 insertions, 3 deletions
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 109b2288a..e711402f4 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -2066,6 +2066,9 @@ name for each character.
The short name for the ``delete'' character (code point U+007F) is
@code{#\del}.
+The R7RS name for the ``escape'' character (code point U+001B) is
+@code{#\escape}.
+
There are also a few alternative names left over for compatibility with
previous versions of Guile.
diff --git a/libguile/chars.c b/libguile/chars.c
index 2e1610566..697a5c401 100644
--- a/libguile/chars.c
+++ b/libguile/chars.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008, 2009,
+ * 2010, 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
@@ -554,6 +555,16 @@ static const scm_t_uint32 const scm_r6rs_charnums[] = {
#define SCM_N_R6RS_CHARNAMES (sizeof (scm_r6rs_charnames) / sizeof (char *))
+static const char *const scm_r7rs_charnames[] = {
+ "escape"
+};
+
+static const scm_t_uint32 const scm_r7rs_charnums[] = {
+ 0x1b
+};
+
+#define SCM_N_R7RS_CHARNAMES (sizeof (scm_r7rs_charnames) / sizeof (char *))
+
/* The abbreviated names for control characters. */
static const char *const scm_C0_control_charnames[] = {
/* C0 controls */
@@ -600,6 +611,10 @@ scm_i_charname (SCM chr)
if (scm_r6rs_charnums[c] == i)
return scm_r6rs_charnames[c];
+ for (c = 0; c < SCM_N_R7RS_CHARNAMES; c++)
+ if (scm_r7rs_charnums[c] == i)
+ return scm_r7rs_charnames[c];
+
for (c = 0; c < SCM_N_C0_CONTROL_CHARNAMES; c++)
if (scm_C0_control_charnums[c] == i)
return scm_C0_control_charnames[c];
@@ -625,13 +640,20 @@ scm_i_charname_to_char (const char *charname, size_t charname_len)
&& (!strncasecmp (scm_r5rs_charnames[c], charname, charname_len)))
return SCM_MAKE_CHAR (scm_r5rs_charnums[c]);
- /* The R6RS charnames. R6RS says that these should be case-sensitive. They
- are left as case-insensitive to avoid confusion. */
+ /* The R6RS charnames. R6RS says that these should be case-sensitive.
+ They are left as case-insensitive to avoid confusion. */
for (c = 0; c < SCM_N_R6RS_CHARNAMES; c++)
if ((strlen (scm_r6rs_charnames[c]) == charname_len)
&& (!strncasecmp (scm_r6rs_charnames[c], charname, charname_len)))
return SCM_MAKE_CHAR (scm_r6rs_charnums[c]);
+ /* The R7RS charnames. R7RS says that these should be case-sensitive.
+ They are left as case-insensitive to avoid confusion. */
+ for (c = 0; c < SCM_N_R7RS_CHARNAMES; c++)
+ if ((strlen (scm_r7rs_charnames[c]) == charname_len)
+ && (!strncasecmp (scm_r7rs_charnames[c], charname, charname_len)))
+ return SCM_MAKE_CHAR (scm_r7rs_charnums[c]);
+
/* Then come the controls. By Guile convention, these are not case
sensitive. */
for (c = 0; c < SCM_N_C0_CONTROL_CHARNAMES; c++)
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 56f6346f6..e0126fe40 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -78,6 +78,10 @@
"a|b"
(read-string "\"a\\|b\""))
+ (pass-if-equal "#\\escape"
+ '(a #\esc b)
+ (read-string "(a #\\escape b)"))
+
(pass-if-equal "#true"
'(a #t b)
(read-string "(a #true b)"))