1 /* Copyright (C) 1995,1996,1998, 2000, 2001 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program 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
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
46 #include "libguile/_scm.h"
47 #include "libguile/validate.h"
49 #include "libguile/chars.h"
52 SCM_DEFINE (scm_char_p
, "char?", 1, 0, 0,
54 "Return @code{#t} iff @var{x} is a character, else @code{#f}.")
55 #define FUNC_NAME s_scm_char_p
57 return SCM_BOOL(SCM_CHARP(x
));
61 SCM_DEFINE1 (scm_char_eq_p
, "char=?", scm_tc7_rpsubr
,
63 "Return @code{#t} iff @var{x} is the same character as @var{y}, else @code{#f}.")
64 #define FUNC_NAME s_scm_char_eq_p
66 SCM_VALIDATE_CHAR (1, x
);
67 SCM_VALIDATE_CHAR (2, y
);
68 return SCM_BOOL (SCM_EQ_P (x
, y
));
73 SCM_DEFINE1 (scm_char_less_p
, "char<?", scm_tc7_rpsubr
,
75 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence,\n"
77 #define FUNC_NAME s_scm_char_less_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_leq_p
, "char<=?", scm_tc7_rpsubr
,
87 "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
88 "ASCII sequence, else @code{#f}.")
89 #define FUNC_NAME s_scm_char_leq_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_gr_p
, "char>?", scm_tc7_rpsubr
,
99 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
100 "sequence, else @code{#f}.")
101 #define FUNC_NAME s_scm_char_gr_p
103 SCM_VALIDATE_CHAR (1, x
);
104 SCM_VALIDATE_CHAR (2, y
);
105 return SCM_BOOL(SCM_CHAR(x
) > SCM_CHAR(y
));
109 SCM_DEFINE1 (scm_char_geq_p
, "char>=?", scm_tc7_rpsubr
,
111 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
112 "ASCII sequence, else @code{#f}.")
113 #define FUNC_NAME s_scm_char_geq_p
115 SCM_VALIDATE_CHAR (1, x
);
116 SCM_VALIDATE_CHAR (2, y
);
117 return SCM_BOOL(SCM_CHAR(x
) >= SCM_CHAR(y
));
121 SCM_DEFINE1 (scm_char_ci_eq_p
, "char-ci=?", scm_tc7_rpsubr
,
123 "Return @code{#t} iff @var{x} is the same character as @var{y} ignoring\n"
124 "case, else @code{#f}.")
125 #define FUNC_NAME s_scm_char_ci_eq_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_less_p
, "char-ci<?", scm_tc7_rpsubr
,
135 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence\n"
136 "ignoring case, else @code{#f}.")
137 #define FUNC_NAME s_scm_char_ci_less_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_leq_p
, "char-ci<=?", scm_tc7_rpsubr
,
147 "Return @code{#t} iff @var{x} is less 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_leq_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
)));
157 SCM_DEFINE1 (scm_char_ci_gr_p
, "char-ci>?", scm_tc7_rpsubr
,
159 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
160 "sequence ignoring case, else @code{#f}.")
161 #define FUNC_NAME s_scm_char_ci_gr_p
163 SCM_VALIDATE_CHAR (1, x
);
164 SCM_VALIDATE_CHAR (2, y
);
165 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) > scm_upcase(SCM_CHAR(y
)));
169 SCM_DEFINE1 (scm_char_ci_geq_p
, "char-ci>=?", scm_tc7_rpsubr
,
171 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
172 "ASCII sequence ignoring case, else @code{#f}.")
173 #define FUNC_NAME s_scm_char_ci_geq_p
175 SCM_VALIDATE_CHAR (1, x
);
176 SCM_VALIDATE_CHAR (2, y
);
177 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) >= scm_upcase(SCM_CHAR(y
)));
182 SCM_DEFINE (scm_char_alphabetic_p
, "char-alphabetic?", 1, 0, 0,
184 "Return @code{#t} iff @var{chr} is alphabetic, else @code{#f}.\n"
185 "Alphabetic means the same thing as the isalpha C library function.")
186 #define FUNC_NAME s_scm_char_alphabetic_p
188 SCM_VALIDATE_CHAR (1, chr
);
189 return SCM_BOOL(isalpha(SCM_CHAR(chr
)));
193 SCM_DEFINE (scm_char_numeric_p
, "char-numeric?", 1, 0, 0,
195 "Return @code{#t} iff @var{chr} is numeric, else @code{#f}.\n"
196 "Numeric means the same thing as the isdigit C library function.")
197 #define FUNC_NAME s_scm_char_numeric_p
199 SCM_VALIDATE_CHAR (1, chr
);
200 return SCM_BOOL(isdigit(SCM_CHAR(chr
)));
204 SCM_DEFINE (scm_char_whitespace_p
, "char-whitespace?", 1, 0, 0,
206 "Return @code{#t} iff @var{chr} is whitespace, else @code{#f}.\n"
207 "Whitespace means the same thing as the isspace C library function.")
208 #define FUNC_NAME s_scm_char_whitespace_p
210 SCM_VALIDATE_CHAR (1, chr
);
211 return SCM_BOOL(isspace(SCM_CHAR(chr
)));
217 SCM_DEFINE (scm_char_upper_case_p
, "char-upper-case?", 1, 0, 0,
219 "Return @code{#t} iff @var{chr} is uppercase, else @code{#f}.\n"
220 "Uppercase means the same thing as the isupper C library function.")
221 #define FUNC_NAME s_scm_char_upper_case_p
223 SCM_VALIDATE_CHAR (1, chr
);
224 return SCM_BOOL(isupper(SCM_CHAR(chr
)));
229 SCM_DEFINE (scm_char_lower_case_p
, "char-lower-case?", 1, 0, 0,
231 "Return @code{#t} iff @var{chr} is lowercase, else @code{#f}.\n"
232 "Lowercase means the same thing as the islower C library function.")
233 #define FUNC_NAME s_scm_char_lower_case_p
235 SCM_VALIDATE_CHAR (1, chr
);
236 return SCM_BOOL(islower(SCM_CHAR(chr
)));
242 SCM_DEFINE (scm_char_is_both_p
, "char-is-both?", 1, 0, 0,
244 "Return @code{#t} iff @var{chr} is either uppercase or lowercase, else @code{#f}.\n"
245 "Uppercase and lowercase are as defined by the isupper and islower\n"
246 "C library functions.")
247 #define FUNC_NAME s_scm_char_is_both_p
249 SCM_VALIDATE_CHAR (1, chr
);
250 return SCM_BOOL((isupper(SCM_CHAR(chr
)) || islower(SCM_CHAR(chr
))));
257 SCM_DEFINE (scm_char_to_integer
, "char->integer", 1, 0, 0,
259 "Return the number corresponding to ordinal position of @var{chr} in the\n"
261 #define FUNC_NAME s_scm_char_to_integer
263 SCM_VALIDATE_CHAR (1, chr
);
264 return scm_ulong2num((unsigned long)SCM_CHAR(chr
));
270 SCM_DEFINE (scm_integer_to_char
, "integer->char", 1, 0, 0,
272 "Return the character at position @var{n} in the ASCII sequence.")
273 #define FUNC_NAME s_scm_integer_to_char
275 SCM_VALIDATE_INUM_RANGE (1, n
, 0, 256);
276 return SCM_MAKE_CHAR (SCM_INUM (n
));
281 SCM_DEFINE (scm_char_upcase
, "char-upcase", 1, 0, 0,
283 "Return the uppercase character version of @var{chr}.")
284 #define FUNC_NAME s_scm_char_upcase
286 SCM_VALIDATE_CHAR (1, chr
);
287 return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr
)));
292 SCM_DEFINE (scm_char_downcase
, "char-downcase", 1, 0, 0,
294 "Return the lowercase character version of @var{chr}.")
295 #define FUNC_NAME s_scm_char_downcase
297 SCM_VALIDATE_CHAR (1, chr
);
298 return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr
)));
306 static unsigned char scm_upcase_table
[SCM_CHAR_CODE_LIMIT
];
307 static unsigned char scm_downcase_table
[SCM_CHAR_CODE_LIMIT
];
308 static const unsigned char scm_lowers
[] = "abcdefghijklmnopqrstuvwxyz";
309 static const unsigned char scm_uppers
[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
313 scm_tables_prehistory ()
316 for (i
= 0; i
< SCM_CHAR_CODE_LIMIT
; i
++)
317 scm_upcase_table
[i
] = scm_downcase_table
[i
] = i
;
318 for (i
= 0; i
< (int) (sizeof scm_lowers
/ sizeof (scm_lowers
[0])); i
++)
320 scm_upcase_table
[scm_lowers
[i
]] = scm_uppers
[i
];
321 scm_downcase_table
[scm_uppers
[i
]] = scm_lowers
[i
];
327 scm_upcase (unsigned int c
)
329 if (c
< sizeof (scm_upcase_table
))
330 return scm_upcase_table
[c
];
337 scm_downcase (unsigned int c
)
339 if (c
< sizeof (scm_downcase_table
))
340 return scm_downcase_table
[c
];
349 # if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
351 # endif /* (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */
352 # if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
354 # endif /* (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */
355 #endif /* def _DCC */
359 char *const scm_charnames
[] =
361 "nul", "soh", "stx", "etx", "pf", "ht", "lc", "del",
362 0 , 0 , "smm", "vt", "ff", "cr", "so", "si",
363 "dle", "dc1", "dc2", "dc3", "res", "nl", "bs", "il",
364 "can", "em", "cc", 0 , "ifs", "igs", "irs", "ius",
365 "ds", "sos", "fs", 0 , "byp", "lf", "eob", "pre",
366 0 , 0 , "sm", 0 , 0 , "enq", "ack", "bel",
367 0 , 0 , "syn", 0 , "pn", "rs", "uc", "eot",
368 0 , 0 , 0 , 0 , "dc4", "nak", 0 , "sub",
369 "space", scm_s_newline
, "tab", "backspace", "return", "page", "null"};
371 const char scm_charnums
[] =
372 "\000\001\002\003\004\005\006\007\
373 \010\011\012\013\014\015\016\017\
374 \020\021\022\023\024\025\026\027\
375 \030\031\032\033\034\035\036\037\
376 \040\041\042\043\044\045\046\047\
377 \050\051\052\053\054\055\056\057\
378 \060\061\062\063\064\065\066\067\
379 \070\071\072\073\074\075\076\077\
381 #endif /* def EBCDIC */
383 char *const scm_charnames
[] =
385 "nul","soh","stx","etx","eot","enq","ack","bel",
386 "bs", "ht", "newline", "vt", "np", "cr", "so", "si",
387 "dle","dc1","dc2","dc3","dc4","nak","syn","etb",
388 "can", "em","sub","esc", "fs", "gs", "rs", "us",
389 "space", "nl", "tab", "backspace", "return", "page", "null", "del"};
390 const char scm_charnums
[] =
391 "\000\001\002\003\004\005\006\007\
392 \010\011\012\013\014\015\016\017\
393 \020\021\022\023\024\025\026\027\
394 \030\031\032\033\034\035\036\037\
396 #endif /* def ASCII */
398 int scm_n_charnames
= sizeof (scm_charnames
) / sizeof (char *);
407 #include "libguile/chars.x"