1 /* Copyright (C) 1995,1996,1998, 2000 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. */
42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
43 gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
49 #include "libguile/_scm.h"
50 #include "libguile/validate.h"
52 #include "libguile/chars.h"
55 SCM_DEFINE (scm_char_p
, "char?", 1, 0, 0,
57 "Return @code{#t} iff @var{x} is a character, else @code{#f}.")
58 #define FUNC_NAME s_scm_char_p
60 return SCM_BOOL(SCM_CHARP(x
));
64 SCM_DEFINE1 (scm_char_eq_p
, "char=?", scm_tc7_rpsubr
,
66 "Return @code{#t} iff @var{x} is the same character as @var{y}, else @code{#f}.")
67 #define FUNC_NAME s_scm_char_eq_p
69 SCM_VALIDATE_CHAR (1, x
);
70 SCM_VALIDATE_CHAR (2, y
);
71 return SCM_BOOL (SCM_EQ_P (x
, y
));
76 SCM_DEFINE1 (scm_char_less_p
, "char<?", scm_tc7_rpsubr
,
78 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence,\n"
80 #define FUNC_NAME s_scm_char_less_p
82 SCM_VALIDATE_CHAR (1,x
);
83 SCM_VALIDATE_CHAR (2,y
);
84 return SCM_BOOL(SCM_CHAR(x
) < SCM_CHAR(y
));
88 SCM_DEFINE1 (scm_char_leq_p
, "char<=?", scm_tc7_rpsubr
,
90 "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
91 "ASCII sequence, else @code{#f}.")
92 #define FUNC_NAME s_scm_char_leq_p
94 SCM_VALIDATE_CHAR (1,x
);
95 SCM_VALIDATE_CHAR (2,y
);
96 return SCM_BOOL(SCM_CHAR(x
) <= SCM_CHAR(y
));
100 SCM_DEFINE1 (scm_char_gr_p
, "char>?", scm_tc7_rpsubr
,
102 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
103 "sequence, else @code{#f}.")
104 #define FUNC_NAME s_scm_char_gr_p
106 SCM_VALIDATE_CHAR (1,x
);
107 SCM_VALIDATE_CHAR (2,y
);
108 return SCM_BOOL(SCM_CHAR(x
) > SCM_CHAR(y
));
112 SCM_DEFINE1 (scm_char_geq_p
, "char>=?", scm_tc7_rpsubr
,
114 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
115 "ASCII sequence, else @code{#f}.")
116 #define FUNC_NAME s_scm_char_geq_p
118 SCM_VALIDATE_CHAR (1,x
);
119 SCM_VALIDATE_CHAR (2,y
);
120 return SCM_BOOL(SCM_CHAR(x
) >= SCM_CHAR(y
));
124 SCM_DEFINE1 (scm_char_ci_eq_p
, "char-ci=?", scm_tc7_rpsubr
,
126 "Return @code{#t} iff @var{x} is the same character as @var{y} ignoring\n"
127 "case, else @code{#f}.")
128 #define FUNC_NAME s_scm_char_ci_eq_p
130 SCM_VALIDATE_CHAR (1,x
);
131 SCM_VALIDATE_CHAR (2,y
);
132 return SCM_BOOL(scm_upcase(SCM_CHAR(x
))==scm_upcase(SCM_CHAR(y
)));
136 SCM_DEFINE1 (scm_char_ci_less_p
, "char-ci<?", scm_tc7_rpsubr
,
138 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence\n"
139 "ignoring case, else @code{#f}.")
140 #define FUNC_NAME s_scm_char_ci_less_p
142 SCM_VALIDATE_CHAR (1,x
);
143 SCM_VALIDATE_CHAR (2,y
);
144 return SCM_BOOL((scm_upcase(SCM_CHAR(x
))) < scm_upcase(SCM_CHAR(y
)));
148 SCM_DEFINE1 (scm_char_ci_leq_p
, "char-ci<=?", scm_tc7_rpsubr
,
150 "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
151 "ASCII sequence ignoring case, else @code{#f}.")
152 #define FUNC_NAME s_scm_char_ci_leq_p
154 SCM_VALIDATE_CHAR (1,x
);
155 SCM_VALIDATE_CHAR (2,y
);
156 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) <= scm_upcase(SCM_CHAR(y
)));
160 SCM_DEFINE1 (scm_char_ci_gr_p
, "char-ci>?", scm_tc7_rpsubr
,
162 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
163 "sequence ignoring case, else @code{#f}.")
164 #define FUNC_NAME s_scm_char_ci_gr_p
166 SCM_VALIDATE_CHAR (1,x
);
167 SCM_VALIDATE_CHAR (2,y
);
168 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) > scm_upcase(SCM_CHAR(y
)));
172 SCM_DEFINE1 (scm_char_ci_geq_p
, "char-ci>=?", scm_tc7_rpsubr
,
174 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
175 "ASCII sequence ignoring case, else @code{#f}.")
176 #define FUNC_NAME s_scm_char_ci_geq_p
178 SCM_VALIDATE_CHAR (1,x
);
179 SCM_VALIDATE_CHAR (2,y
);
180 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) >= scm_upcase(SCM_CHAR(y
)));
185 SCM_DEFINE (scm_char_alphabetic_p
, "char-alphabetic?", 1, 0, 0,
187 "Return @code{#t} iff @var{chr} is alphabetic, else @code{#f}.\n"
188 "Alphabetic means the same thing as the isalpha C library function.")
189 #define FUNC_NAME s_scm_char_alphabetic_p
191 SCM_VALIDATE_CHAR (1,chr
);
192 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isalpha(SCM_CHAR(chr
)));
196 SCM_DEFINE (scm_char_numeric_p
, "char-numeric?", 1, 0, 0,
198 "Return @code{#t} iff @var{chr} is numeric, else @code{#f}.\n"
199 "Numeric means the same thing as the isdigit C library function.")
200 #define FUNC_NAME s_scm_char_numeric_p
202 SCM_VALIDATE_CHAR (1,chr
);
203 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isdigit(SCM_CHAR(chr
)));
207 SCM_DEFINE (scm_char_whitespace_p
, "char-whitespace?", 1, 0, 0,
209 "Return @code{#t} iff @var{chr} is whitespace, else @code{#f}.\n"
210 "Whitespace means the same thing as the isspace C library function.")
211 #define FUNC_NAME s_scm_char_whitespace_p
213 SCM_VALIDATE_CHAR (1,chr
);
214 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isspace(SCM_CHAR(chr
)));
220 SCM_DEFINE (scm_char_upper_case_p
, "char-upper-case?", 1, 0, 0,
222 "Return @code{#t} iff @var{chr} is uppercase, else @code{#f}.\n"
223 "Uppercase means the same thing as the isupper C library function.")
224 #define FUNC_NAME s_scm_char_upper_case_p
226 SCM_VALIDATE_CHAR (1,chr
);
227 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isupper(SCM_CHAR(chr
)));
232 SCM_DEFINE (scm_char_lower_case_p
, "char-lower-case?", 1, 0, 0,
234 "Return @code{#t} iff @var{chr} is lowercase, else @code{#f}.\n"
235 "Lowercase means the same thing as the islower C library function.")
236 #define FUNC_NAME s_scm_char_lower_case_p
238 SCM_VALIDATE_CHAR (1,chr
);
239 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && islower(SCM_CHAR(chr
)));
245 SCM_DEFINE (scm_char_is_both_p
, "char-is-both?", 1, 0, 0,
247 "Return @code{#t} iff @var{chr} is either uppercase or lowercase, else @code{#f}.\n"
248 "Uppercase and lowercase are as defined by the isupper and islower\n"
249 "C library functions.")
250 #define FUNC_NAME s_scm_char_is_both_p
252 SCM_VALIDATE_CHAR (1,chr
);
253 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && (isupper(SCM_CHAR(chr
)) || islower(SCM_CHAR(chr
))));
260 SCM_DEFINE (scm_char_to_integer
, "char->integer", 1, 0, 0,
262 "Return the number corresponding to ordinal position of @var{chr} in the\n"
264 #define FUNC_NAME s_scm_char_to_integer
266 SCM_VALIDATE_CHAR (1,chr
);
267 return scm_ulong2num((unsigned long)SCM_CHAR(chr
));
273 SCM_DEFINE (scm_integer_to_char
, "integer->char", 1, 0, 0,
275 "Return the character at position @var{n} in the ASCII sequence.")
276 #define FUNC_NAME s_scm_integer_to_char
278 SCM_VALIDATE_INUM_RANGE (1, n
, 0, 256);
279 return SCM_MAKE_CHAR (SCM_INUM (n
));
284 SCM_DEFINE (scm_char_upcase
, "char-upcase", 1, 0, 0,
286 "Return the uppercase character version of @var{chr}.")
287 #define FUNC_NAME s_scm_char_upcase
289 SCM_VALIDATE_CHAR (1,chr
);
290 return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr
)));
295 SCM_DEFINE (scm_char_downcase
, "char-downcase", 1, 0, 0,
297 "Return the lowercase character version of @var{chr}.")
298 #define FUNC_NAME s_scm_char_downcase
300 SCM_VALIDATE_CHAR (1,chr
);
301 return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr
)));
309 static unsigned char scm_upcase_table
[SCM_CHAR_CODE_LIMIT
];
310 static unsigned char scm_downcase_table
[SCM_CHAR_CODE_LIMIT
];
311 static const unsigned char scm_lowers
[] = "abcdefghijklmnopqrstuvwxyz";
312 static const unsigned char scm_uppers
[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
316 scm_tables_prehistory ()
319 for (i
= 0; i
< SCM_CHAR_CODE_LIMIT
; i
++)
320 scm_upcase_table
[i
] = scm_downcase_table
[i
] = i
;
321 for (i
= 0; i
< (int) (sizeof scm_lowers
/ sizeof (scm_lowers
[0])); i
++)
323 scm_upcase_table
[scm_lowers
[i
]] = scm_uppers
[i
];
324 scm_downcase_table
[scm_uppers
[i
]] = scm_lowers
[i
];
330 scm_upcase (unsigned int c
)
332 if (c
< sizeof (scm_upcase_table
))
333 return scm_upcase_table
[c
];
340 scm_downcase (unsigned int c
)
342 if (c
< sizeof (scm_downcase_table
))
343 return scm_downcase_table
[c
];
352 # if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
354 # endif /* (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */
355 # if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
357 # endif /* (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */
358 #endif /* def _DCC */
362 char *const scm_charnames
[] =
364 "nul","soh","stx","etx", "pf", "ht", "lc","del",
365 0 , 0 ,"smm", "vt", "ff", "cr", "so", "si",
366 "dle","dc1","dc2","dc3","res", "nl", "bs", "il",
367 "can", "em", "cc", 0 ,"ifs","igs","irs","ius",
368 "ds","sos", "fs", 0 ,"byp", "lf","eob","pre",
369 0 , 0 , "sm", 0 , 0 ,"enq","ack","bel",
370 0 , 0 ,"syn", 0 , "pn", "rs", "uc","eot",
371 0 , 0 , 0 , 0 ,"dc4","nak", 0 ,"sub",
372 "space", scm_s_newline
, "tab", "backspace", "return", "page", "null"};
374 const char scm_charnums
[] =
375 "\000\001\002\003\004\005\006\007\
376 \010\011\012\013\014\015\016\017\
377 \020\021\022\023\024\025\026\027\
378 \030\031\032\033\034\035\036\037\
379 \040\041\042\043\044\045\046\047\
380 \050\051\052\053\054\055\056\057\
381 \060\061\062\063\064\065\066\067\
382 \070\071\072\073\074\075\076\077\
384 #endif /* def EBCDIC */
386 char *const scm_charnames
[] =
388 "nul","soh","stx","etx","eot","enq","ack","bel",
389 "bs", "ht", "newline", "vt", "np", "cr", "so", "si",
390 "dle","dc1","dc2","dc3","dc4","nak","syn","etb",
391 "can", "em","sub","esc", "fs", "gs", "rs", "us",
392 "space", "nl", "tab", "backspace", "return", "page", "null", "del"};
393 const char scm_charnums
[] =
394 "\000\001\002\003\004\005\006\007\
395 \010\011\012\013\014\015\016\017\
396 \020\021\022\023\024\025\026\027\
397 \030\031\032\033\034\035\036\037\
399 #endif /* def ASCII */
401 int scm_n_charnames
= sizeof (scm_charnames
) / sizeof (char *);
410 #ifndef SCM_MAGIC_SNARFER
411 #include "libguile/chars.x"