mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Replace global charnames variables with accessors
The global variables scm_charnames and scm_charnums are replaced with
the accessor functions scm_i_charname and scm_i_charname_to_num.
Also, the incomplete and broken EBCDIC support is removed.
* libguile/print.c (iprin1): use new func scm_i_charname
* libguile/read.c (scm_read_character): use new func
scm_i_charname_to_num
* libguile/chars.c (scm_i_charname): new function
(scm_i_charname_to_char): new function
(scm_charnames, scm_charnums): removed
* libguile/chars.h: new declarations
This commit is contained in:
Michael Gran
parent
e5dc27b86d
commit
77332b21a0
4 changed files with 105 additions and 64 deletions
141
libguile/chars.c
141
libguile/chars.c
|
|
@ -298,61 +298,108 @@ scm_c_downcase (unsigned int c)
|
|||
return 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. */
|
||||
|
||||
const char *const scm_r5rs_charnames[] =
|
||||
{
|
||||
"space", "newline"
|
||||
};
|
||||
|
||||
#ifdef EBCDIC
|
||||
char *const scm_charnames[] =
|
||||
const scm_t_uint32 const scm_r5rs_charnums[] =
|
||||
{
|
||||
0x20, 0x0A
|
||||
};
|
||||
|
||||
const int scm_n_r5rs_charnames = sizeof (scm_r5rs_charnames) / sizeof (char *);
|
||||
|
||||
/* The abbreviated names for control characters. */
|
||||
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"
|
||||
};
|
||||
|
||||
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
|
||||
};
|
||||
|
||||
int scm_n_C0_control_charnames = sizeof (scm_C0_control_charnames) / sizeof (char *);
|
||||
|
||||
const char *const scm_alt_charnames[] =
|
||||
{
|
||||
"null", "backspace", "tab", "nl", "newline", "np", "page", "return",
|
||||
};
|
||||
|
||||
const scm_t_uint32 const scm_alt_charnums[] =
|
||||
{
|
||||
0x00, 0x08, 0x09, 0x0a, 0x0a, 0x0c, 0x0c, 0x0d
|
||||
};
|
||||
|
||||
const int 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)
|
||||
{
|
||||
"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"};
|
||||
int c;
|
||||
scm_t_uint32 i = SCM_CHAR (chr);
|
||||
|
||||
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[] =
|
||||
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];
|
||||
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Return a character from a string charname. */
|
||||
SCM
|
||||
scm_i_charname_to_char (const char *charname, size_t charname_len)
|
||||
{
|
||||
"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 c;
|
||||
|
||||
int scm_n_charnames = sizeof (scm_charnames) / sizeof (char *);
|
||||
/* 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;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -34,12 +34,6 @@
|
|||
|
||||
|
||||
|
||||
SCM_API char *const scm_charnames[];
|
||||
SCM_API int scm_n_charnames;
|
||||
SCM_API const char scm_charnums[];
|
||||
|
||||
|
||||
|
||||
SCM_API SCM scm_char_p (SCM x);
|
||||
SCM_API SCM scm_char_eq_p (SCM x, SCM y);
|
||||
SCM_API SCM scm_char_less_p (SCM x, SCM y);
|
||||
|
|
@ -63,6 +57,9 @@ SCM_API SCM scm_char_upcase (SCM chr);
|
|||
SCM_API SCM scm_char_downcase (SCM chr);
|
||||
SCM_API int scm_c_upcase (unsigned int c);
|
||||
SCM_API int scm_c_downcase (unsigned int c);
|
||||
SCM_INTERNAL const char * scm_i_charname (SCM chr);
|
||||
SCM_INTERNAL SCM scm_i_charname_to_char (const char *charname,
|
||||
size_t charname_len);
|
||||
SCM_INTERNAL void scm_init_chars (void);
|
||||
|
||||
#endif /* SCM_CHARS_H */
|
||||
|
|
|
|||
|
|
@ -437,16 +437,14 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
|||
if (SCM_CHARP (exp))
|
||||
{
|
||||
long i = SCM_CHAR (exp);
|
||||
const char *name;
|
||||
|
||||
if (SCM_WRITINGP (pstate))
|
||||
{
|
||||
scm_puts ("#\\", port);
|
||||
if ((i >= 0) && (i <= ' ') && scm_charnames[i])
|
||||
scm_puts (scm_charnames[i], port);
|
||||
#ifndef EBCDIC
|
||||
else if (i == '\177')
|
||||
scm_puts (scm_charnames[scm_n_charnames - 1], port);
|
||||
#endif
|
||||
name = scm_i_charname (exp);
|
||||
if (name != NULL)
|
||||
scm_puts (name, port);
|
||||
else if (i < 0 || i > '\177')
|
||||
scm_intprint (i, 8, port);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -801,7 +801,7 @@ static SCM
|
|||
scm_read_character (int chr, SCM port)
|
||||
#define FUNC_NAME "scm_lreadr"
|
||||
{
|
||||
unsigned c;
|
||||
SCM ch;
|
||||
char charname[READER_CHAR_NAME_MAX_SIZE];
|
||||
size_t charname_len;
|
||||
|
||||
|
|
@ -834,10 +834,9 @@ scm_read_character (int chr, SCM port)
|
|||
return SCM_MAKE_CHAR (SCM_I_INUM (p));
|
||||
}
|
||||
|
||||
for (c = 0; c < scm_n_charnames; c++)
|
||||
if (scm_charnames[c]
|
||||
&& (!strncasecmp (scm_charnames[c], charname, charname_len)))
|
||||
return SCM_MAKE_CHAR (scm_charnums[c]);
|
||||
ch = scm_i_charname_to_char (charname, charname_len);
|
||||
if (scm_is_true (ch))
|
||||
return ch;
|
||||
|
||||
char_error:
|
||||
scm_i_input_error (FUNC_NAME, port, "unknown character name ~a",
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue