1 /* Copyright (C) 1995,1996,1998, 2000, 2001 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22 #include "libguile/_scm.h"
23 #include "libguile/validate.h"
25 #include "libguile/chars.h"
28 SCM_DEFINE (scm_char_p
, "char?", 1, 0, 0,
30 "Return @code{#t} iff @var{x} is a character, else @code{#f}.")
31 #define FUNC_NAME s_scm_char_p
33 return SCM_BOOL(SCM_CHARP(x
));
37 SCM_DEFINE1 (scm_char_eq_p
, "char=?", scm_tc7_rpsubr
,
39 "Return @code{#t} iff @var{x} is the same character as @var{y}, else @code{#f}.")
40 #define FUNC_NAME s_scm_char_eq_p
42 SCM_VALIDATE_CHAR (1, x
);
43 SCM_VALIDATE_CHAR (2, y
);
44 return SCM_BOOL (SCM_EQ_P (x
, y
));
49 SCM_DEFINE1 (scm_char_less_p
, "char<?", scm_tc7_rpsubr
,
51 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence,\n"
53 #define FUNC_NAME s_scm_char_less_p
55 SCM_VALIDATE_CHAR (1, x
);
56 SCM_VALIDATE_CHAR (2, y
);
57 return SCM_BOOL(SCM_CHAR(x
) < SCM_CHAR(y
));
61 SCM_DEFINE1 (scm_char_leq_p
, "char<=?", scm_tc7_rpsubr
,
63 "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
64 "ASCII sequence, else @code{#f}.")
65 #define FUNC_NAME s_scm_char_leq_p
67 SCM_VALIDATE_CHAR (1, x
);
68 SCM_VALIDATE_CHAR (2, y
);
69 return SCM_BOOL(SCM_CHAR(x
) <= SCM_CHAR(y
));
73 SCM_DEFINE1 (scm_char_gr_p
, "char>?", scm_tc7_rpsubr
,
75 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
76 "sequence, else @code{#f}.")
77 #define FUNC_NAME s_scm_char_gr_p
79 SCM_VALIDATE_CHAR (1, x
);
80 SCM_VALIDATE_CHAR (2, y
);
81 return SCM_BOOL(SCM_CHAR(x
) > SCM_CHAR(y
));
85 SCM_DEFINE1 (scm_char_geq_p
, "char>=?", scm_tc7_rpsubr
,
87 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
88 "ASCII sequence, else @code{#f}.")
89 #define FUNC_NAME s_scm_char_geq_p
91 SCM_VALIDATE_CHAR (1, x
);
92 SCM_VALIDATE_CHAR (2, y
);
93 return SCM_BOOL(SCM_CHAR(x
) >= SCM_CHAR(y
));
97 SCM_DEFINE1 (scm_char_ci_eq_p
, "char-ci=?", scm_tc7_rpsubr
,
99 "Return @code{#t} iff @var{x} is the same character as @var{y} ignoring\n"
100 "case, else @code{#f}.")
101 #define FUNC_NAME s_scm_char_ci_eq_p
103 SCM_VALIDATE_CHAR (1, x
);
104 SCM_VALIDATE_CHAR (2, y
);
105 return SCM_BOOL(scm_upcase(SCM_CHAR(x
))==scm_upcase(SCM_CHAR(y
)));
109 SCM_DEFINE1 (scm_char_ci_less_p
, "char-ci<?", scm_tc7_rpsubr
,
111 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence\n"
112 "ignoring case, else @code{#f}.")
113 #define FUNC_NAME s_scm_char_ci_less_p
115 SCM_VALIDATE_CHAR (1, x
);
116 SCM_VALIDATE_CHAR (2, y
);
117 return SCM_BOOL((scm_upcase(SCM_CHAR(x
))) < scm_upcase(SCM_CHAR(y
)));
121 SCM_DEFINE1 (scm_char_ci_leq_p
, "char-ci<=?", scm_tc7_rpsubr
,
123 "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
124 "ASCII sequence ignoring case, else @code{#f}.")
125 #define FUNC_NAME s_scm_char_ci_leq_p
127 SCM_VALIDATE_CHAR (1, x
);
128 SCM_VALIDATE_CHAR (2, y
);
129 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) <= scm_upcase(SCM_CHAR(y
)));
133 SCM_DEFINE1 (scm_char_ci_gr_p
, "char-ci>?", scm_tc7_rpsubr
,
135 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
136 "sequence ignoring case, else @code{#f}.")
137 #define FUNC_NAME s_scm_char_ci_gr_p
139 SCM_VALIDATE_CHAR (1, x
);
140 SCM_VALIDATE_CHAR (2, y
);
141 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) > scm_upcase(SCM_CHAR(y
)));
145 SCM_DEFINE1 (scm_char_ci_geq_p
, "char-ci>=?", scm_tc7_rpsubr
,
147 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
148 "ASCII sequence ignoring case, else @code{#f}.")
149 #define FUNC_NAME s_scm_char_ci_geq_p
151 SCM_VALIDATE_CHAR (1, x
);
152 SCM_VALIDATE_CHAR (2, y
);
153 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) >= scm_upcase(SCM_CHAR(y
)));
158 SCM_DEFINE (scm_char_alphabetic_p
, "char-alphabetic?", 1, 0, 0,
160 "Return @code{#t} iff @var{chr} is alphabetic, else @code{#f}.\n"
161 "Alphabetic means the same thing as the isalpha C library function.")
162 #define FUNC_NAME s_scm_char_alphabetic_p
164 SCM_VALIDATE_CHAR (1, chr
);
165 return SCM_BOOL(isalpha(SCM_CHAR(chr
)));
169 SCM_DEFINE (scm_char_numeric_p
, "char-numeric?", 1, 0, 0,
171 "Return @code{#t} iff @var{chr} is numeric, else @code{#f}.\n"
172 "Numeric means the same thing as the isdigit C library function.")
173 #define FUNC_NAME s_scm_char_numeric_p
175 SCM_VALIDATE_CHAR (1, chr
);
176 return SCM_BOOL(isdigit(SCM_CHAR(chr
)));
180 SCM_DEFINE (scm_char_whitespace_p
, "char-whitespace?", 1, 0, 0,
182 "Return @code{#t} iff @var{chr} is whitespace, else @code{#f}.\n"
183 "Whitespace means the same thing as the isspace C library function.")
184 #define FUNC_NAME s_scm_char_whitespace_p
186 SCM_VALIDATE_CHAR (1, chr
);
187 return SCM_BOOL(isspace(SCM_CHAR(chr
)));
193 SCM_DEFINE (scm_char_upper_case_p
, "char-upper-case?", 1, 0, 0,
195 "Return @code{#t} iff @var{chr} is uppercase, else @code{#f}.\n"
196 "Uppercase means the same thing as the isupper C library function.")
197 #define FUNC_NAME s_scm_char_upper_case_p
199 SCM_VALIDATE_CHAR (1, chr
);
200 return SCM_BOOL(isupper(SCM_CHAR(chr
)));
205 SCM_DEFINE (scm_char_lower_case_p
, "char-lower-case?", 1, 0, 0,
207 "Return @code{#t} iff @var{chr} is lowercase, else @code{#f}.\n"
208 "Lowercase means the same thing as the islower C library function.")
209 #define FUNC_NAME s_scm_char_lower_case_p
211 SCM_VALIDATE_CHAR (1, chr
);
212 return SCM_BOOL(islower(SCM_CHAR(chr
)));
218 SCM_DEFINE (scm_char_is_both_p
, "char-is-both?", 1, 0, 0,
220 "Return @code{#t} iff @var{chr} is either uppercase or lowercase, else @code{#f}.\n"
221 "Uppercase and lowercase are as defined by the isupper and islower\n"
222 "C library functions.")
223 #define FUNC_NAME s_scm_char_is_both_p
225 SCM_VALIDATE_CHAR (1, chr
);
226 return SCM_BOOL((isupper(SCM_CHAR(chr
)) || islower(SCM_CHAR(chr
))));
233 SCM_DEFINE (scm_char_to_integer
, "char->integer", 1, 0, 0,
235 "Return the number corresponding to ordinal position of @var{chr} in the\n"
237 #define FUNC_NAME s_scm_char_to_integer
239 SCM_VALIDATE_CHAR (1, chr
);
240 return scm_ulong2num((unsigned long)SCM_CHAR(chr
));
246 SCM_DEFINE (scm_integer_to_char
, "integer->char", 1, 0, 0,
248 "Return the character at position @var{n} in the ASCII sequence.")
249 #define FUNC_NAME s_scm_integer_to_char
251 SCM_VALIDATE_INUM_RANGE (1, n
, 0, 256);
252 return SCM_MAKE_CHAR (SCM_INUM (n
));
257 SCM_DEFINE (scm_char_upcase
, "char-upcase", 1, 0, 0,
259 "Return the uppercase character version of @var{chr}.")
260 #define FUNC_NAME s_scm_char_upcase
262 SCM_VALIDATE_CHAR (1, chr
);
263 return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr
)));
268 SCM_DEFINE (scm_char_downcase
, "char-downcase", 1, 0, 0,
270 "Return the lowercase character version of @var{chr}.")
271 #define FUNC_NAME s_scm_char_downcase
273 SCM_VALIDATE_CHAR (1, chr
);
274 return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr
)));
282 static unsigned char scm_upcase_table
[SCM_CHAR_CODE_LIMIT
];
283 static unsigned char scm_downcase_table
[SCM_CHAR_CODE_LIMIT
];
284 static const unsigned char scm_lowers
[] = "abcdefghijklmnopqrstuvwxyz";
285 static const unsigned char scm_uppers
[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
289 scm_tables_prehistory ()
292 for (i
= 0; i
< SCM_CHAR_CODE_LIMIT
; i
++)
293 scm_upcase_table
[i
] = scm_downcase_table
[i
] = i
;
294 for (i
= 0; i
< (int) (sizeof scm_lowers
/ sizeof (scm_lowers
[0])); i
++)
296 scm_upcase_table
[scm_lowers
[i
]] = scm_uppers
[i
];
297 scm_downcase_table
[scm_uppers
[i
]] = scm_lowers
[i
];
303 scm_upcase (unsigned int c
)
305 if (c
< sizeof (scm_upcase_table
))
306 return scm_upcase_table
[c
];
313 scm_downcase (unsigned int c
)
315 if (c
< sizeof (scm_downcase_table
))
316 return scm_downcase_table
[c
];
325 # if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
327 # endif /* (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */
328 # if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
330 # endif /* (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */
331 #endif /* def _DCC */
335 char *const scm_charnames
[] =
337 "nul", "soh", "stx", "etx", "pf", "ht", "lc", "del",
338 0 , 0 , "smm", "vt", "ff", "cr", "so", "si",
339 "dle", "dc1", "dc2", "dc3", "res", "nl", "bs", "il",
340 "can", "em", "cc", 0 , "ifs", "igs", "irs", "ius",
341 "ds", "sos", "fs", 0 , "byp", "lf", "eob", "pre",
342 0 , 0 , "sm", 0 , 0 , "enq", "ack", "bel",
343 0 , 0 , "syn", 0 , "pn", "rs", "uc", "eot",
344 0 , 0 , 0 , 0 , "dc4", "nak", 0 , "sub",
345 "space", scm_s_newline
, "tab", "backspace", "return", "page", "null"};
347 const char scm_charnums
[] =
348 "\000\001\002\003\004\005\006\007\
349 \010\011\012\013\014\015\016\017\
350 \020\021\022\023\024\025\026\027\
351 \030\031\032\033\034\035\036\037\
352 \040\041\042\043\044\045\046\047\
353 \050\051\052\053\054\055\056\057\
354 \060\061\062\063\064\065\066\067\
355 \070\071\072\073\074\075\076\077\
357 #endif /* def EBCDIC */
359 char *const scm_charnames
[] =
361 "nul","soh","stx","etx","eot","enq","ack","bel",
362 "bs", "ht", "newline", "vt", "np", "cr", "so", "si",
363 "dle","dc1","dc2","dc3","dc4","nak","syn","etb",
364 "can", "em","sub","esc", "fs", "gs", "rs", "us",
365 "space", "nl", "tab", "backspace", "return", "page", "null", "del"};
366 const char scm_charnums
[] =
367 "\000\001\002\003\004\005\006\007\
368 \010\011\012\013\014\015\016\017\
369 \020\021\022\023\024\025\026\027\
370 \030\031\032\033\034\035\036\037\
372 #endif /* def ASCII */
374 int scm_n_charnames
= sizeof (scm_charnames
) / sizeof (char *);
383 #include "libguile/chars.x"