diff options
author | Mark H Weaver <mhw@netris.org> | 2014-01-12 04:36:57 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2014-01-14 02:24:44 -0500 |
commit | 394449d5d3922cab783d51398b7727ccaf07dd76 (patch) | |
tree | 6e473c905ca55e319e68e932baad79bdde1663a2 | |
parent | 6579c3308d386ce74627e2cfb734898c9ed83d3a (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.texi | 3 | ||||
-rw-r--r-- | libguile/chars.c | 28 | ||||
-rw-r--r-- | test-suite/tests/reader.test | 4 |
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)")) |