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 */
48 #include "libguile/_scm.h"
49 #include "libguile/validate.h"
51 #include "libguile/chars.h"
54 SCM_DEFINE (scm_char_p
, "char?", 1, 0, 0,
56 "Return @code{#t} iff @var{x} is a character, else @code{#f}.")
57 #define FUNC_NAME s_scm_char_p
59 return SCM_BOOL(SCM_CHARP(x
));
63 SCM_DEFINE1 (scm_char_eq_p
, "char=?", scm_tc7_rpsubr
,
65 "Return @code{#t} iff @var{x} is the same character as @var{y}, else @code{#f}.")
66 #define FUNC_NAME s_scm_char_eq_p
68 SCM_VALIDATE_CHAR (1, x
);
69 SCM_VALIDATE_CHAR (2, y
);
70 return SCM_BOOL (SCM_EQ_P (x
, y
));
75 SCM_DEFINE1 (scm_char_less_p
, "char<?", scm_tc7_rpsubr
,
77 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence,\n"
79 #define FUNC_NAME s_scm_char_less_p
81 SCM_VALIDATE_CHAR (1,x
);
82 SCM_VALIDATE_CHAR (2,y
);
83 return SCM_BOOL(SCM_CHAR(x
) < SCM_CHAR(y
));
87 SCM_DEFINE1 (scm_char_leq_p
, "char<=?", scm_tc7_rpsubr
,
89 "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
90 "ASCII sequence, else @code{#f}.")
91 #define FUNC_NAME s_scm_char_leq_p
93 SCM_VALIDATE_CHAR (1,x
);
94 SCM_VALIDATE_CHAR (2,y
);
95 return SCM_BOOL(SCM_CHAR(x
) <= SCM_CHAR(y
));
99 SCM_DEFINE1 (scm_char_gr_p
, "char>?", scm_tc7_rpsubr
,
101 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
102 "sequence, else @code{#f}.")
103 #define FUNC_NAME s_scm_char_gr_p
105 SCM_VALIDATE_CHAR (1,x
);
106 SCM_VALIDATE_CHAR (2,y
);
107 return SCM_BOOL(SCM_CHAR(x
) > SCM_CHAR(y
));
111 SCM_DEFINE1 (scm_char_geq_p
, "char>=?", scm_tc7_rpsubr
,
113 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
114 "ASCII sequence, else @code{#f}.")
115 #define FUNC_NAME s_scm_char_geq_p
117 SCM_VALIDATE_CHAR (1,x
);
118 SCM_VALIDATE_CHAR (2,y
);
119 return SCM_BOOL(SCM_CHAR(x
) >= SCM_CHAR(y
));
123 SCM_DEFINE1 (scm_char_ci_eq_p
, "char-ci=?", scm_tc7_rpsubr
,
125 "Return @code{#t} iff @var{x} is the same character as @var{y} ignoring\n"
126 "case, else @code{#f}.")
127 #define FUNC_NAME s_scm_char_ci_eq_p
129 SCM_VALIDATE_CHAR (1,x
);
130 SCM_VALIDATE_CHAR (2,y
);
131 return SCM_BOOL(scm_upcase(SCM_CHAR(x
))==scm_upcase(SCM_CHAR(y
)));
135 SCM_DEFINE1 (scm_char_ci_less_p
, "char-ci<?", scm_tc7_rpsubr
,
137 "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence\n"
138 "ignoring case, else @code{#f}.")
139 #define FUNC_NAME s_scm_char_ci_less_p
141 SCM_VALIDATE_CHAR (1,x
);
142 SCM_VALIDATE_CHAR (2,y
);
143 return SCM_BOOL((scm_upcase(SCM_CHAR(x
))) < scm_upcase(SCM_CHAR(y
)));
147 SCM_DEFINE1 (scm_char_ci_leq_p
, "char-ci<=?", scm_tc7_rpsubr
,
149 "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
150 "ASCII sequence ignoring case, else @code{#f}.")
151 #define FUNC_NAME s_scm_char_ci_leq_p
153 SCM_VALIDATE_CHAR (1,x
);
154 SCM_VALIDATE_CHAR (2,y
);
155 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) <= scm_upcase(SCM_CHAR(y
)));
159 SCM_DEFINE1 (scm_char_ci_gr_p
, "char-ci>?", scm_tc7_rpsubr
,
161 "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
162 "sequence ignoring case, else @code{#f}.")
163 #define FUNC_NAME s_scm_char_ci_gr_p
165 SCM_VALIDATE_CHAR (1,x
);
166 SCM_VALIDATE_CHAR (2,y
);
167 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) > scm_upcase(SCM_CHAR(y
)));
171 SCM_DEFINE1 (scm_char_ci_geq_p
, "char-ci>=?", scm_tc7_rpsubr
,
173 "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
174 "ASCII sequence ignoring case, else @code{#f}.")
175 #define FUNC_NAME s_scm_char_ci_geq_p
177 SCM_VALIDATE_CHAR (1,x
);
178 SCM_VALIDATE_CHAR (2,y
);
179 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) >= scm_upcase(SCM_CHAR(y
)));
184 SCM_DEFINE (scm_char_alphabetic_p
, "char-alphabetic?", 1, 0, 0,
186 "Return @code{#t} iff @var{chr} is alphabetic, else @code{#f}.\n"
187 "Alphabetic means the same thing as the isalpha C library function.")
188 #define FUNC_NAME s_scm_char_alphabetic_p
190 SCM_VALIDATE_CHAR (1,chr
);
191 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isalpha(SCM_CHAR(chr
)));
195 SCM_DEFINE (scm_char_numeric_p
, "char-numeric?", 1, 0, 0,
197 "Return @code{#t} iff @var{chr} is numeric, else @code{#f}.\n"
198 "Numeric means the same thing as the isdigit C library function.")
199 #define FUNC_NAME s_scm_char_numeric_p
201 SCM_VALIDATE_CHAR (1,chr
);
202 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isdigit(SCM_CHAR(chr
)));
206 SCM_DEFINE (scm_char_whitespace_p
, "char-whitespace?", 1, 0, 0,
208 "Return @code{#t} iff @var{chr} is whitespace, else @code{#f}.\n"
209 "Whitespace means the same thing as the isspace C library function.")
210 #define FUNC_NAME s_scm_char_whitespace_p
212 SCM_VALIDATE_CHAR (1,chr
);
213 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isspace(SCM_CHAR(chr
)));
219 SCM_DEFINE (scm_char_upper_case_p
, "char-upper-case?", 1, 0, 0,
221 "Return @code{#t} iff @var{chr} is uppercase, else @code{#f}.\n"
222 "Uppercase means the same thing as the isupper C library function.")
223 #define FUNC_NAME s_scm_char_upper_case_p
225 SCM_VALIDATE_CHAR (1,chr
);
226 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isupper(SCM_CHAR(chr
)));
231 SCM_DEFINE (scm_char_lower_case_p
, "char-lower-case?", 1, 0, 0,
233 "Return @code{#t} iff @var{chr} is lowercase, else @code{#f}.\n"
234 "Lowercase means the same thing as the islower C library function.")
235 #define FUNC_NAME s_scm_char_lower_case_p
237 SCM_VALIDATE_CHAR (1,chr
);
238 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && islower(SCM_CHAR(chr
)));
244 SCM_DEFINE (scm_char_is_both_p
, "char-is-both?", 1, 0, 0,
246 "Return @code{#t} iff @var{chr} is either uppercase or lowercase, else @code{#f}.\n"
247 "Uppercase and lowercase are as defined by the isupper and islower\n"
248 "C library functions.")
249 #define FUNC_NAME s_scm_char_is_both_p
251 SCM_VALIDATE_CHAR (1,chr
);
252 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && (isupper(SCM_CHAR(chr
)) || islower(SCM_CHAR(chr
))));
259 SCM_DEFINE (scm_char_to_integer
, "char->integer", 1, 0, 0,
261 "Return the number corresponding to ordinal position of @var{chr} in the\n"
263 #define FUNC_NAME s_scm_char_to_integer
265 SCM_VALIDATE_CHAR (1,chr
);
266 return scm_ulong2num((unsigned long)SCM_CHAR(chr
));
272 SCM_DEFINE (scm_integer_to_char
, "integer->char", 1, 0, 0,
274 "Return the character at position @var{n} in the ASCII sequence.")
275 #define FUNC_NAME s_scm_integer_to_char
277 SCM_VALIDATE_INUM_RANGE (1, n
, 0, 256);
278 return SCM_MAKE_CHAR (SCM_INUM (n
));
283 SCM_DEFINE (scm_char_upcase
, "char-upcase", 1, 0, 0,
285 "Return the uppercase character version of @var{chr}.")
286 #define FUNC_NAME s_scm_char_upcase
288 SCM_VALIDATE_CHAR (1,chr
);
289 return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr
)));
294 SCM_DEFINE (scm_char_downcase
, "char-downcase", 1, 0, 0,
296 "Return the lowercase character version of @var{chr}.")
297 #define FUNC_NAME s_scm_char_downcase
299 SCM_VALIDATE_CHAR (1,chr
);
300 return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr
)));
308 static unsigned char scm_upcase_table
[SCM_CHAR_CODE_LIMIT
];
309 static unsigned char scm_downcase_table
[SCM_CHAR_CODE_LIMIT
];
310 static const unsigned char scm_lowers
[] = "abcdefghijklmnopqrstuvwxyz";
311 static const unsigned char scm_uppers
[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
315 scm_tables_prehistory ()
318 for (i
= 0; i
< SCM_CHAR_CODE_LIMIT
; i
++)
319 scm_upcase_table
[i
] = scm_downcase_table
[i
] = i
;
320 for (i
= 0; i
< (int) (sizeof scm_lowers
/ sizeof (scm_lowers
[0])); i
++)
322 scm_upcase_table
[scm_lowers
[i
]] = scm_uppers
[i
];
323 scm_downcase_table
[scm_uppers
[i
]] = scm_lowers
[i
];
329 scm_upcase (unsigned int c
)
331 if (c
< sizeof (scm_upcase_table
))
332 return scm_upcase_table
[c
];
339 scm_downcase (unsigned int c
)
341 if (c
< sizeof (scm_downcase_table
))
342 return scm_downcase_table
[c
];
351 # if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
353 # endif /* (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */
354 # if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
356 # endif /* (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */
357 #endif /* def _DCC */
361 char *const scm_charnames
[] =
363 "nul","soh","stx","etx", "pf", "ht", "lc","del",
364 0 , 0 ,"smm", "vt", "ff", "cr", "so", "si",
365 "dle","dc1","dc2","dc3","res", "nl", "bs", "il",
366 "can", "em", "cc", 0 ,"ifs","igs","irs","ius",
367 "ds","sos", "fs", 0 ,"byp", "lf","eob","pre",
368 0 , 0 , "sm", 0 , 0 ,"enq","ack","bel",
369 0 , 0 ,"syn", 0 , "pn", "rs", "uc","eot",
370 0 , 0 , 0 , 0 ,"dc4","nak", 0 ,"sub",
371 "space", scm_s_newline
, "tab", "backspace", "return", "page", "null"};
373 const char scm_charnums
[] =
374 "\000\001\002\003\004\005\006\007\
375 \010\011\012\013\014\015\016\017\
376 \020\021\022\023\024\025\026\027\
377 \030\031\032\033\034\035\036\037\
378 \040\041\042\043\044\045\046\047\
379 \050\051\052\053\054\055\056\057\
380 \060\061\062\063\064\065\066\067\
381 \070\071\072\073\074\075\076\077\
383 #endif /* def EBCDIC */
385 char *const scm_charnames
[] =
387 "nul","soh","stx","etx","eot","enq","ack","bel",
388 "bs", "ht", "newline", "vt", "np", "cr", "so", "si",
389 "dle","dc1","dc2","dc3","dc4","nak","syn","etb",
390 "can", "em","sub","esc", "fs", "gs", "rs", "us",
391 "space", "nl", "tab", "backspace", "return", "page", "null", "del"};
392 const char scm_charnums
[] =
393 "\000\001\002\003\004\005\006\007\
394 \010\011\012\013\014\015\016\017\
395 \020\021\022\023\024\025\026\027\
396 \030\031\032\033\034\035\036\037\
398 #endif /* def ASCII */
400 int scm_n_charnames
= sizeof (scm_charnames
) / sizeof (char *);
409 #ifndef SCM_MAGIC_SNARFER
410 #include "libguile/chars.x"