diff options
Diffstat (limited to 'libguile/chars.c')
-rw-r--r-- | libguile/chars.c | 226 |
1 files changed, 141 insertions, 85 deletions
diff --git a/libguile/chars.c b/libguile/chars.c index 909e11d57..552a2d9c1 100644 --- a/libguile/chars.c +++ b/libguile/chars.c @@ -1,18 +1,19 @@ -/* Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008, 2009 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 2.1 of the License, or (at your option) any later version. + * 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 + * 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, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ @@ -23,6 +24,8 @@ #include <ctype.h> #include <limits.h> +#include <unicase.h> + #include "libguile/_scm.h" #include "libguile/validate.h" @@ -54,7 +57,7 @@ SCM_DEFINE1 (scm_char_eq_p, "char=?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr, (SCM x, SCM y), - "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence,\n" + "Return @code{#t} iff @var{x} is less than @var{y} in the Unicode sequence,\n" "else @code{#f}.") #define FUNC_NAME s_scm_char_less_p { @@ -67,7 +70,7 @@ SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr, (SCM x, SCM y), "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n" - "ASCII sequence, else @code{#f}.") + "Unicode sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_leq_p { SCM_VALIDATE_CHAR (1, x); @@ -78,7 +81,7 @@ SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr, (SCM x, SCM y), - "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n" + "Return @code{#t} iff @var{x} is greater than @var{y} in the Unicode\n" "sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_gr_p { @@ -91,7 +94,7 @@ SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr, (SCM x, SCM y), "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n" - "ASCII sequence, else @code{#f}.") + "Unicode sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_geq_p { SCM_VALIDATE_CHAR (1, x); @@ -103,7 +106,7 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, (SCM x, SCM y), "Return @code{#t} iff @var{x} is the same character as @var{y} ignoring\n" - "case, else @code{#f}.") + "case, else @code{#f}. Case is locale free and not context sensitive.") #define FUNC_NAME s_scm_char_ci_eq_p { SCM_VALIDATE_CHAR (1, x); @@ -114,8 +117,9 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr, (SCM x, SCM y), - "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence\n" - "ignoring case, else @code{#f}.") + "Return @code{#t} iff the Unicode uppercase form of @var{x} is less\n" + "than the Unicode uppercase form @var{y} in the Unicode sequence,\n" + "else @code{#f}.") #define FUNC_NAME s_scm_char_ci_less_p { SCM_VALIDATE_CHAR (1, x); @@ -126,8 +130,9 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr, (SCM x, SCM y), - "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n" - "ASCII sequence ignoring case, else @code{#f}.") + "Return @code{#t} iff the Unicode uppercase form of @var{x} is less\n" + "than or equal to the Unicode uppercase form of @var{y} in the\n" + "Unicode sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_leq_p { SCM_VALIDATE_CHAR (1, x); @@ -138,8 +143,9 @@ SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr, (SCM x, SCM y), - "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n" - "sequence ignoring case, else @code{#f}.") + "Return @code{#t} iff the Unicode uppercase form of @var{x} is greater\n" + "than the Unicode uppercase form of @var{y} in the Unicode\n" + "sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_gr_p { SCM_VALIDATE_CHAR (1, x); @@ -150,8 +156,9 @@ SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr, SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr, (SCM x, SCM y), - "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n" - "ASCII sequence ignoring case, else @code{#f}.") + "Return @code{#t} iff the Unicode uppercase form of @var{x} is greater\n" + "than or equal to the Unicode uppercase form of @var{y} in the\n" + "Unicode sequence, else @code{#f}.") #define FUNC_NAME s_scm_char_ci_geq_p { SCM_VALIDATE_CHAR (1, x); @@ -232,7 +239,7 @@ SCM_DEFINE (scm_char_to_integer, "char->integer", 1, 0, 0, #define FUNC_NAME s_scm_char_to_integer { SCM_VALIDATE_CHAR (1, chr); - return scm_from_ulong (SCM_CHAR(chr)); + return scm_from_uint32 (SCM_CHAR(chr)); } #undef FUNC_NAME @@ -243,7 +250,15 @@ SCM_DEFINE (scm_integer_to_char, "integer->char", 1, 0, 0, "Return the character at position @var{n} in the ASCII sequence.") #define FUNC_NAME s_scm_integer_to_char { - return SCM_MAKE_CHAR (scm_to_uchar (n)); + scm_t_wchar cn; + + cn = scm_to_wchar (n); + + /* Avoid the surrogates. */ + if (!SCM_IS_UNICODE_CHAR (cn)) + scm_out_of_range (FUNC_NAME, n); + + return SCM_MAKE_CHAR (cn); } #undef FUNC_NAME @@ -254,7 +269,7 @@ SCM_DEFINE (scm_char_upcase, "char-upcase", 1, 0, 0, #define FUNC_NAME s_scm_char_upcase { SCM_VALIDATE_CHAR (1, chr); - return SCM_MAKE_CHAR (toupper (SCM_CHAR (chr))); + return SCM_MAKE_CHAR (scm_c_upcase (SCM_CHAR (chr))); } #undef FUNC_NAME @@ -265,7 +280,7 @@ SCM_DEFINE (scm_char_downcase, "char-downcase", 1, 0, 0, #define FUNC_NAME s_scm_char_downcase { SCM_VALIDATE_CHAR (1, chr); - return SCM_MAKE_CHAR (tolower (SCM_CHAR(chr))); + return SCM_MAKE_CHAR (scm_c_downcase (SCM_CHAR(chr))); } #undef FUNC_NAME @@ -278,80 +293,121 @@ TODO: change name to scm_i_.. ? --hwn */ -int -scm_c_upcase (unsigned int c) +scm_t_wchar +scm_c_upcase (scm_t_wchar c) { - if (c <= UCHAR_MAX) - return toupper (c); - else + if (c > 255) return c; + + return toupper ((int) c); } -int -scm_c_downcase (unsigned int c) +scm_t_wchar +scm_c_downcase (scm_t_wchar c) { - if (c <= UCHAR_MAX) - return tolower (c); - else + if (c > 255) return c; + + return tolower ((int) c); } + -#ifdef _DCC -# define ASCII -#else -# if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) -# define EBCDIC -# endif /* (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */ -# if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) -# define ASCII -# endif /* (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */ -#endif /* def _DCC */ +/* There are a few sets of character names: R5RS, Guile + extensions for control characters, and leftover Guile extensions. + They are listed in order of precedence. */ + +static const char *const scm_r5rs_charnames[] = { + "space", "newline" +}; + +static const scm_t_uint32 const scm_r5rs_charnums[] = { + 0x20, 0x0A +}; + +#define SCM_N_R5RS_CHARNAMES (sizeof (scm_r5rs_charnames) / sizeof (char *)) + +/* The abbreviated names for control characters. */ +static const char *const scm_C0_control_charnames[] = { + /* C0 controls */ + "nul", "soh", "stx", "etx", "eot", "enq", "ack", "bel", + "bs", "ht", "lf", "vt", "ff", "cr", "so", "si", + "dle", "dc1", "dc2", "dc3", "dc4", "nak", "syn", "etb", + "can", "em", "sub", "esc", "fs", "gs", "rs", "us", + "sp", "del" +}; + +static const scm_t_uint32 const scm_C0_control_charnums[] = { + 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, + 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, + 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, + 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, + 0x20, 0x7f +}; + +#define SCM_N_C0_CONTROL_CHARNAMES (sizeof (scm_C0_control_charnames) / sizeof (char *)) + +static const char *const scm_alt_charnames[] = { + "null", "backspace", "tab", "nl", "newline", "np", "page", "return", +}; + +static const scm_t_uint32 const scm_alt_charnums[] = { + 0x00, 0x08, 0x09, 0x0a, 0x0a, 0x0c, 0x0c, 0x0d +}; + +#define SCM_N_ALT_CHARNAMES (sizeof (scm_alt_charnames) / sizeof (char *)) + +/* Returns the string charname for a character if it exists, or NULL + otherwise. */ +const char * +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]; -#ifdef EBCDIC -char *const scm_charnames[] = -{ - "nul", "soh", "stx", "etx", "pf", "ht", "lc", "del", - 0 , 0 , "smm", "vt", "ff", "cr", "so", "si", - "dle", "dc1", "dc2", "dc3", "res", "nl", "bs", "il", - "can", "em", "cc", 0 , "ifs", "igs", "irs", "ius", - "ds", "sos", "fs", 0 , "byp", "lf", "eob", "pre", - 0 , 0 , "sm", 0 , 0 , "enq", "ack", "bel", - 0 , 0 , "syn", 0 , "pn", "rs", "uc", "eot", - 0 , 0 , 0 , 0 , "dc4", "nak", 0 , "sub", - "space", scm_s_newline, "tab", "backspace", "return", "page", "null"}; - -const char scm_charnums[] = -"\000\001\002\003\004\005\006\007\ -\010\011\012\013\014\015\016\017\ -\020\021\022\023\024\025\026\027\ -\030\031\032\033\034\035\036\037\ -\040\041\042\043\044\045\046\047\ -\050\051\052\053\054\055\056\057\ -\060\061\062\063\064\065\066\067\ -\070\071\072\073\074\075\076\077\ - \n\t\b\r\f\0"; -#endif /* def EBCDIC */ -#ifdef ASCII -char *const scm_charnames[] = -{ - "nul","soh","stx","etx","eot","enq","ack","bel", - "bs", "ht", "newline", "vt", "np", "cr", "so", "si", - "dle","dc1","dc2","dc3","dc4","nak","syn","etb", - "can", "em","sub","esc", "fs", "gs", "rs", "us", - "space", "sp", "nl", "tab", "backspace", "return", "page", "null", "del"}; -const char scm_charnums[] = -"\000\001\002\003\004\005\006\007\ -\010\011\012\013\014\015\016\017\ -\020\021\022\023\024\025\026\027\ -\030\031\032\033\034\035\036\037\ - \n\t\b\r\f\0\177"; -#endif /* def ASCII */ - -int scm_n_charnames = sizeof (scm_charnames) / sizeof (char *); + 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]; + return NULL; +} + +/* Return a character from a string charname. */ +SCM +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]); + + return SCM_BOOL_F; +} |