diff options
Diffstat (limited to 'libguile/chars.c')
| -rw-r--r-- | libguile/chars.c | 94 |
1 files changed, 62 insertions, 32 deletions
diff --git a/libguile/chars.c b/libguile/chars.c index 16a2b90d6..2322db858 100644 --- a/libguile/chars.c +++ b/libguile/chars.c @@ -32,7 +32,7 @@ #include "libguile/chars.h" #include "libguile/srfi-14.h" - +#include "libguile/private-options.h" SCM_DEFINE (scm_char_p, "char?", 1, 0, 0, @@ -561,6 +561,18 @@ static const scm_t_uint32 const scm_alt_charnums[] = { #define SCM_N_ALT_CHARNAMES (sizeof (scm_alt_charnames) / sizeof (char *)) +static const char *const scm_r6rs_charnames[] = { + "nul", "alarm", "backspace", "tab", "linefeed", "newline", + "vtab", "page", "return", "esc", "space", "delete" +}; + +static const scm_t_uint32 const scm_r6rs_charnums[] = { + 0x00, 0x07, 0x08, 0x09, 0x0A, 0x0A, + 0x0B, 0x0C, 0x0D, 0x1B, 0x20, 0x7F +}; + +#define SCM_N_R6RS_CHARNAMES (sizeof (scm_r6rs_charnames) / sizeof (char *)) + /* Returns the string charname for a character if it exists, or NULL otherwise. */ const char * @@ -569,18 +581,25 @@ scm_i_charname (SCM chr) size_t c; scm_t_uint32 i = SCM_CHAR (chr); - for (c = 0; c < SCM_N_R5RS_CHARNAMES; c++) - if (scm_r5rs_charnums[c] == i) - return scm_r5rs_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]; - - for (c = 0; c < SCM_N_ALT_CHARNAMES; c++) - if (scm_alt_charnums[c] == i) - return scm_alt_charnames[i]; - + if (!SCM_R6RS_STRINGS_P) + { + for (c = 0; c < SCM_N_R5RS_CHARNAMES; c++) + if (scm_r5rs_charnums[c] == i) + return scm_r5rs_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]; + + for (c = 0; c < SCM_N_ALT_CHARNAMES; c++) + if (scm_alt_charnums[c] == i) + return scm_alt_charnames[i]; + } + else + for (c = 0; c < SCM_N_R6RS_CHARNAMES; c++) + if (scm_r6rs_charnums[c] == i) + return scm_r6rs_charnames[c]; + return NULL; } @@ -590,25 +609,36 @@ scm_i_charname_to_char (const char *charname, size_t charname_len) { size_t c; - /* The R5RS charnames. These are supposed to be case - insensitive. */ - for (c = 0; c < SCM_N_R5RS_CHARNAMES; c++) - if ((strlen (scm_r5rs_charnames[c]) == charname_len) - && (!strncasecmp (scm_r5rs_charnames[c], charname, charname_len))) - return SCM_MAKE_CHAR (scm_r5rs_charnums[c]); - - /* Then come the controls. These are not case sensitive. */ - for (c = 0; c < SCM_N_C0_CONTROL_CHARNAMES; c++) - if ((strlen (scm_C0_control_charnames[c]) == charname_len) - && (!strncasecmp (scm_C0_control_charnames[c], charname, charname_len))) - return SCM_MAKE_CHAR (scm_C0_control_charnums[c]); - - /* Lastly are some old names carried over for compatibility. */ - for (c = 0; c < SCM_N_ALT_CHARNAMES; c++) - if ((strlen (scm_alt_charnames[c]) == charname_len) - && (!strncasecmp (scm_alt_charnames[c], charname, charname_len))) - return SCM_MAKE_CHAR (scm_alt_charnums[c]); - + if (!SCM_R6RS_STRINGS_P) + { + /* The R5RS charnames. These are supposed to be case + insensitive. */ + for (c = 0; c < SCM_N_R5RS_CHARNAMES; c++) + if ((strlen (scm_r5rs_charnames[c]) == charname_len) + && (!strncasecmp (scm_r5rs_charnames[c], charname, + charname_len))) + return SCM_MAKE_CHAR (scm_r5rs_charnums[c]); + + /* Then come the controls. These are not case sensitive. */ + for (c = 0; c < SCM_N_C0_CONTROL_CHARNAMES; c++) + if ((strlen (scm_C0_control_charnames[c]) == charname_len) + && (!strncasecmp (scm_C0_control_charnames[c], charname, + charname_len))) + return SCM_MAKE_CHAR (scm_C0_control_charnums[c]); + + /* Lastly are some old names carried over for compatibility. */ + for (c = 0; c < SCM_N_ALT_CHARNAMES; c++) + if ((strlen (scm_alt_charnames[c]) == charname_len) + && (!strncasecmp (scm_alt_charnames[c], charname, charname_len))) + return SCM_MAKE_CHAR (scm_alt_charnums[c]); + } + else + /* The strict R6RS charnames. These are case sensitive. */ + for (c = 0; c < SCM_N_R6RS_CHARNAMES; c++) + if ((strlen (scm_r6rs_charnames[c]) == charname_len) + && (!strncmp (scm_r6rs_charnames[c], charname, charname_len))) + return SCM_MAKE_CHAR (scm_r6rs_charnums[c]); + return SCM_BOOL_F; } |