1 /* Copyright (C) 1995,1996,1998 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 */
55 SCM_DEFINE (scm_char_p
, "char?", 1, 0, 0,
57 "Return #t iff X is a character, else #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 #t iff X is the same character as Y, else #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_CHAR(x
) == SCM_CHAR(y
));
76 SCM_DEFINE1 (scm_char_less_p
, "char<?", scm_tc7_rpsubr
,
78 "Return #t iff X is less than Y in the Ascii sequence, else #f.")
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 #t iff X is less than or equal to Y in the Ascii sequence, else #f.")
90 #define FUNC_NAME s_scm_char_leq_p
92 SCM_VALIDATE_CHAR (1,x
);
93 SCM_VALIDATE_CHAR (2,y
);
94 return SCM_BOOL(SCM_CHAR(x
) <= SCM_CHAR(y
));
98 SCM_DEFINE1 (scm_char_gr_p
, "char>?", scm_tc7_rpsubr
,
100 "Return #t iff X is greater than Y in the Ascii sequence, else #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 #t iff X is greater than or equal to Y in the Ascii sequence, else #f.")
112 #define FUNC_NAME s_scm_char_geq_p
114 SCM_VALIDATE_CHAR (1,x
);
115 SCM_VALIDATE_CHAR (2,y
);
116 return SCM_BOOL(SCM_CHAR(x
) >= SCM_CHAR(y
));
120 SCM_DEFINE1 (scm_char_ci_eq_p
, "char-ci=?", scm_tc7_rpsubr
,
122 "Return #t iff X is the same character as Y ignoring case, else #f.")
123 #define FUNC_NAME s_scm_char_ci_eq_p
125 SCM_VALIDATE_CHAR (1,x
);
126 SCM_VALIDATE_CHAR (2,y
);
127 return SCM_BOOL(scm_upcase(SCM_CHAR(x
))==scm_upcase(SCM_CHAR(y
)));
131 SCM_DEFINE1 (scm_char_ci_less_p
, "char-ci<?", scm_tc7_rpsubr
,
133 "Return #t iff X is less than Y in the Ascii sequence ignoring case, else #f.")
134 #define FUNC_NAME s_scm_char_ci_less_p
136 SCM_VALIDATE_CHAR (1,x
);
137 SCM_VALIDATE_CHAR (2,y
);
138 return SCM_BOOL((scm_upcase(SCM_CHAR(x
))) < scm_upcase(SCM_CHAR(y
)));
142 SCM_DEFINE1 (scm_char_ci_leq_p
, "char-ci<=?", scm_tc7_rpsubr
,
144 "Return #t iff X is less than or equal to Y in the Ascii sequence ignoring case, else #f.")
145 #define FUNC_NAME s_scm_char_ci_leq_p
147 SCM_VALIDATE_CHAR (1,x
);
148 SCM_VALIDATE_CHAR (2,y
);
149 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) <= scm_upcase(SCM_CHAR(y
)));
153 SCM_DEFINE1 (scm_char_ci_gr_p
, "char-ci>?", scm_tc7_rpsubr
,
155 "Return #t iff X is greater than Y in the Ascii sequence ignoring case, else #f.")
156 #define FUNC_NAME s_scm_char_ci_gr_p
158 SCM_VALIDATE_CHAR (1,x
);
159 SCM_VALIDATE_CHAR (2,y
);
160 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) > scm_upcase(SCM_CHAR(y
)));
164 SCM_DEFINE1 (scm_char_ci_geq_p
, "char-ci>=?", scm_tc7_rpsubr
,
166 "Return #t iff X is greater than or equal to Y in the Ascii sequence ignoring case, else #f.")
167 #define FUNC_NAME s_scm_char_ci_geq_p
169 SCM_VALIDATE_CHAR (1,x
);
170 SCM_VALIDATE_CHAR (2,y
);
171 return SCM_BOOL(scm_upcase(SCM_CHAR(x
)) >= scm_upcase(SCM_CHAR(y
)));
176 SCM_DEFINE (scm_char_alphabetic_p
, "char-alphabetic?", 1, 0, 0,
178 "Return #t iff CHR is alphabetic, else #f.\n"
179 "Alphabetic means the same thing as the isalpha C library function.")
180 #define FUNC_NAME s_scm_char_alphabetic_p
182 SCM_VALIDATE_CHAR (1,chr
);
183 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isalpha(SCM_CHAR(chr
)));
187 SCM_DEFINE (scm_char_numeric_p
, "char-numeric?", 1, 0, 0,
189 "Return #t iff CHR is numeric, else #f.\n"
190 "Numeric means the same thing as the isdigit C library function.")
191 #define FUNC_NAME s_scm_char_numeric_p
193 SCM_VALIDATE_CHAR (1,chr
);
194 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isdigit(SCM_CHAR(chr
)));
198 SCM_DEFINE (scm_char_whitespace_p
, "char-whitespace?", 1, 0, 0,
200 "Return #t iff CHR is whitespace, else #f.\n"
201 "Whitespace means the same thing as the isspace C library function.")
202 #define FUNC_NAME s_scm_char_whitespace_p
204 SCM_VALIDATE_CHAR (1,chr
);
205 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isspace(SCM_CHAR(chr
)));
211 SCM_DEFINE (scm_char_upper_case_p
, "char-upper-case?", 1, 0, 0,
213 "Return #t iff CHR is uppercase, else #f.\n"
214 "Uppercase means the same thing as the isupper C library function.")
215 #define FUNC_NAME s_scm_char_upper_case_p
217 SCM_VALIDATE_CHAR (1,chr
);
218 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && isupper(SCM_CHAR(chr
)));
223 SCM_DEFINE (scm_char_lower_case_p
, "char-lower-case?", 1, 0, 0,
225 "Return #t iff CHR is lowercase, else #f.\n"
226 "Lowercase means the same thing as the islower C library function.")
227 #define FUNC_NAME s_scm_char_lower_case_p
229 SCM_VALIDATE_CHAR (1,chr
);
230 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && islower(SCM_CHAR(chr
)));
236 SCM_DEFINE (scm_char_is_both_p
, "char-is-both?", 1, 0, 0,
238 "Return #t iff CHR is either uppercase or lowercase, else #f.\n"
239 "Uppercase and lowercase are as defined by the isupper and islower\n"
240 "C library functions.")
241 #define FUNC_NAME s_scm_char_is_both_p
243 SCM_VALIDATE_CHAR (1,chr
);
244 return SCM_BOOL(isascii(SCM_CHAR(chr
)) && (isupper(SCM_CHAR(chr
)) || islower(SCM_CHAR(chr
))));
251 SCM_DEFINE (scm_char_to_integer
, "char->integer", 1, 0, 0,
253 "Return the number corresponding to ordinal position of CHR in the Ascii sequence.")
254 #define FUNC_NAME s_scm_char_to_integer
256 SCM_VALIDATE_CHAR (1,chr
);
257 return scm_ulong2num((unsigned long)SCM_CHAR(chr
));
263 SCM_DEFINE (scm_integer_to_char
, "integer->char", 1, 0, 0,
265 "Return the character at position N in the Ascii sequence.")
266 #define FUNC_NAME s_scm_integer_to_char
268 SCM_VALIDATE_INUM_RANGE (1, n
, 0, 256);
269 return SCM_MAKE_CHAR (SCM_INUM (n
));
274 SCM_DEFINE (scm_char_upcase
, "char-upcase", 1, 0, 0,
276 "Return the uppercase character version of CHR.")
277 #define FUNC_NAME s_scm_char_upcase
279 SCM_VALIDATE_CHAR (1,chr
);
280 return SCM_MAKE_CHAR(scm_upcase(SCM_CHAR(chr
)));
285 SCM_DEFINE (scm_char_downcase
, "char-downcase", 1, 0, 0,
287 "Return the lowercase character version of CHR.")
288 #define FUNC_NAME s_scm_char_downcase
290 SCM_VALIDATE_CHAR (1,chr
);
291 return SCM_MAKE_CHAR(scm_downcase(SCM_CHAR(chr
)));
299 static unsigned char scm_upcase_table
[SCM_CHAR_CODE_LIMIT
];
300 static unsigned char scm_downcase_table
[SCM_CHAR_CODE_LIMIT
];
301 static const unsigned char scm_lowers
[] = "abcdefghijklmnopqrstuvwxyz";
302 static const unsigned char scm_uppers
[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
306 scm_tables_prehistory ()
309 for (i
= 0; i
< SCM_CHAR_CODE_LIMIT
; i
++)
310 scm_upcase_table
[i
] = scm_downcase_table
[i
] = i
;
311 for (i
= 0; i
< (int) (sizeof scm_lowers
/ sizeof (scm_lowers
[0])); i
++)
313 scm_upcase_table
[scm_lowers
[i
]] = scm_uppers
[i
];
314 scm_downcase_table
[scm_uppers
[i
]] = scm_lowers
[i
];
320 scm_upcase (unsigned int c
)
322 if (c
< sizeof (scm_upcase_table
))
323 return scm_upcase_table
[c
];
330 scm_downcase (unsigned int c
)
332 if (c
< sizeof (scm_downcase_table
))
333 return scm_downcase_table
[c
];
342 # if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
344 # endif /* (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */
345 # if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
347 # endif /* (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */
348 #endif /* def _DCC */
352 char *const scm_charnames
[] =
354 "nul","soh","stx","etx", "pf", "ht", "lc","del",
355 0 , 0 ,"smm", "vt", "ff", "cr", "so", "si",
356 "dle","dc1","dc2","dc3","res", "nl", "bs", "il",
357 "can", "em", "cc", 0 ,"ifs","igs","irs","ius",
358 "ds","sos", "fs", 0 ,"byp", "lf","eob","pre",
359 0 , 0 , "sm", 0 , 0 ,"enq","ack","bel",
360 0 , 0 ,"syn", 0 , "pn", "rs", "uc","eot",
361 0 , 0 , 0 , 0 ,"dc4","nak", 0 ,"sub",
362 "space", scm_s_newline
, "tab", "backspace", "return", "page", "null"};
364 const char scm_charnums
[] =
365 "\000\001\002\003\004\005\006\007\
366 \010\011\012\013\014\015\016\017\
367 \020\021\022\023\024\025\026\027\
368 \030\031\032\033\034\035\036\037\
369 \040\041\042\043\044\045\046\047\
370 \050\051\052\053\054\055\056\057\
371 \060\061\062\063\064\065\066\067\
372 \070\071\072\073\074\075\076\077\
374 #endif /* def EBCDIC */
376 char *const scm_charnames
[] =
378 "nul","soh","stx","etx","eot","enq","ack","bel",
379 "bs", "ht", "newline", "vt", "np", "cr", "so", "si",
380 "dle","dc1","dc2","dc3","dc4","nak","syn","etb",
381 "can", "em","sub","esc", "fs", "gs", "rs", "us",
382 "space", "nl", "tab", "backspace", "return", "page", "null", "del"};
383 const char scm_charnums
[] =
384 "\000\001\002\003\004\005\006\007\
385 \010\011\012\013\014\015\016\017\
386 \020\021\022\023\024\025\026\027\
387 \030\031\032\033\034\035\036\037\
389 #endif /* def ASCII */
391 int scm_n_charnames
= sizeof (scm_charnames
) / sizeof (char *);