Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | /* classes: src_files */ |
2 | ||
5b20cc4b | 3 | /* Copyright (C) 1994, 1996, 1997, 1999 Free Software Foundation, Inc. |
0f2d19dd JB |
4 | |
5 | This program is free software; you can redistribute it and/or modify | |
6 | it under the terms of the GNU General Public License as published by | |
7 | the Free Software Foundation; either version 2, or (at your option) | |
8 | any later version. | |
9 | ||
10 | This program is distributed in the hope that it will be useful, | |
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | GNU General Public License for more details. | |
14 | ||
15 | You should have received a copy of the GNU General Public License | |
82892bed JB |
16 | along with this software; see the file COPYING. If not, write to the |
17 | Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA | |
18 | 02111-1307 USA */ | |
0f2d19dd | 19 | |
1bbd0b84 GB |
20 | /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, |
21 | gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ | |
22 | ||
23 | ||
0f2d19dd JB |
24 | \f |
25 | ||
26 | #include <stdio.h> | |
27 | #include "_scm.h" | |
20e6290e | 28 | #include "chars.h" |
0f2d19dd | 29 | |
b6791b2e | 30 | #include "validate.h" |
20e6290e | 31 | #include "strop.h" |
99a9952d | 32 | #include "read.h" /*For SCM_CASE_INSENSITIVE_P*/ |
bd9e24b3 GH |
33 | |
34 | #ifdef HAVE_STRING_H | |
35 | #include <string.h> | |
36 | #endif | |
37 | ||
0f2d19dd JB |
38 | \f |
39 | ||
6552dbf7 | 40 | /* |
0821c4f6 | 41 | xSCM_DEFINE (scm_i_index, "i-index", 2, 2, 0, |
6552dbf7 GB |
42 | (SCM str, SCM chr, SCM frm, SCM to), |
43 | "@deftypefn {Internal C Function} {static int} scm_i_index (SCM *@var{str}, \n" | |
44 | "SCM @var{chr}, int @var{direction}, SCM @var{sub_start}, SCM @var{sub_end}, char *@var{why}) | |
45 | "This is a workhorse function that performs either an @code{index} or\n" | |
46 | "@code{rindex} function, depending on the value of @var{direction}. I'm\n" | |
47 | "not at all clear on the usage of the pos arguments, though the purpose\n" | |
48 | "seems to be correct reporting of which argument values are reporting\n" | |
49 | "errors. Why you would do that, rather than just use @code{SCM_ARG[1234]}\n" | |
50 | "explicitly is beyond me. Anyone holding any enlightenment?" | |
51 | */ | |
03bc4386 GH |
52 | /* implements index if direction > 0 otherwise rindex. */ |
53 | static int | |
99a9952d JB |
54 | scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, |
55 | SCM sub_end, const char *why) | |
0f2d19dd JB |
56 | { |
57 | unsigned char * p; | |
58 | int x; | |
03bc4386 GH |
59 | int lower; |
60 | int upper; | |
0f2d19dd JB |
61 | int ch; |
62 | ||
0c95b57d | 63 | SCM_ASSERT (SCM_ROSTRINGP (*str), *str, SCM_ARG1, why); |
7866a09b | 64 | SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); |
0f2d19dd JB |
65 | |
66 | if (sub_start == SCM_BOOL_F) | |
67 | sub_start = SCM_MAKINUM (0); | |
03bc4386 | 68 | |
99a9952d | 69 | SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); |
03bc4386 GH |
70 | lower = SCM_INUM (sub_start); |
71 | if (lower < 0 | |
67ec3667 | 72 | || lower > SCM_ROLENGTH (*str)) |
03bc4386 | 73 | scm_out_of_range (why, sub_start); |
0f2d19dd JB |
74 | |
75 | if (sub_end == SCM_BOOL_F) | |
76 | sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str)); | |
03bc4386 | 77 | |
99a9952d | 78 | SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); |
03bc4386 GH |
79 | upper = SCM_INUM (sub_end); |
80 | if (upper < SCM_INUM (sub_start) | |
81 | || upper > SCM_ROLENGTH (*str)) | |
82 | scm_out_of_range (why, sub_end); | |
83 | ||
84 | if (direction > 0) | |
85 | { | |
86 | p = (unsigned char *)SCM_ROCHARS (*str) + lower; | |
7866a09b | 87 | ch = SCM_CHAR (chr); |
03bc4386 GH |
88 | |
89 | for (x = SCM_INUM (sub_start); x < upper; ++x, ++p) | |
90 | if (*p == ch) | |
91 | return x; | |
92 | } | |
0f2d19dd | 93 | else |
03bc4386 GH |
94 | { |
95 | p = upper - 1 + (unsigned char *)SCM_ROCHARS (*str); | |
7866a09b | 96 | ch = SCM_CHAR (chr); |
03bc4386 GH |
97 | for (x = upper - 1; x >= lower; --x, --p) |
98 | if (*p == ch) | |
99 | return x; | |
100 | } | |
0f2d19dd JB |
101 | |
102 | return -1; | |
103 | } | |
104 | ||
3b3b36dd | 105 | SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0, |
1bbd0b84 | 106 | (SCM str, SCM chr, SCM frm, SCM to), |
b380b885 MD |
107 | "Return the index of the first occurrence of @var{chr} in @var{str}. The\n" |
108 | "optional integer arguments @var{frm} and @var{to} limit the search to\n" | |
109 | "a portion of the string. This procedure essentially implements the\n" | |
6552dbf7 GB |
110 | "@code{index} or @code{strchr} functions from the C library.\n\n" |
111 | "(qdocs:) Returns the index of @var{char} in @var{str}, or @code{#f} if the\n" | |
112 | "@var{char} isn't in @var{str}. If @var{frm} is given and not @code{#f},\n" | |
113 | "it is used as the starting index; if @var{to} is given and not @var{#f},\n" | |
114 | "it is used as the ending index (exclusive).\n\n" | |
115 | "@example\n" | |
116 | "(string-index "weiner" #\e)\n" | |
117 | "@result{} 1\n\n" | |
118 | "(string-index "weiner" #\e 2)\n" | |
119 | "@result{} 4\n\n" | |
120 | "(string-index "weiner" #\e 2 4)\n" | |
121 | "@result{} #f\n" | |
122 | "@end example") | |
1bbd0b84 | 123 | #define FUNC_NAME s_scm_string_index |
0f2d19dd JB |
124 | { |
125 | int pos; | |
126 | ||
127 | if (frm == SCM_UNDEFINED) | |
128 | frm = SCM_BOOL_F; | |
129 | if (to == SCM_UNDEFINED) | |
130 | to = SCM_BOOL_F; | |
1bbd0b84 | 131 | pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME); |
0f2d19dd JB |
132 | return (pos < 0 |
133 | ? SCM_BOOL_F | |
134 | : SCM_MAKINUM (pos)); | |
135 | } | |
1bbd0b84 | 136 | #undef FUNC_NAME |
0f2d19dd | 137 | |
3b3b36dd | 138 | SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0, |
1bbd0b84 | 139 | (SCM str, SCM chr, SCM frm, SCM to), |
b380b885 MD |
140 | "Like @code{string-index}, but search from the right of the string rather\n" |
141 | "than from the left. This procedure essentially implements the\n" | |
6552dbf7 GB |
142 | "@code{rindex} or @code{strrchr} functions from the C library.\n\n" |
143 | "(qdocs:) The same as @code{string-index}, except it gives the rightmost occurance\n" | |
144 | "of @var{char} in the range [@var{frm}, @var{to}-1], which defaults to\n" | |
145 | "the entire string.\n\n" | |
146 | "@example\n" | |
147 | "(string-rindex "weiner" #\e)\n" | |
148 | "@result{} 4\n\n" | |
149 | "(string-rindex "weiner" #\e 2 4)\n" | |
150 | "@result{} #f\n\n" | |
151 | "(string-rindex "weiner" #\e 2 5)\n" | |
152 | "@result{} 4\n" | |
153 | "@end example") | |
1bbd0b84 | 154 | #define FUNC_NAME s_scm_string_rindex |
0f2d19dd JB |
155 | { |
156 | int pos; | |
157 | ||
158 | if (frm == SCM_UNDEFINED) | |
159 | frm = SCM_BOOL_F; | |
160 | if (to == SCM_UNDEFINED) | |
161 | to = SCM_BOOL_F; | |
1bbd0b84 | 162 | pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME); |
0f2d19dd JB |
163 | return (pos < 0 |
164 | ? SCM_BOOL_F | |
165 | : SCM_MAKINUM (pos)); | |
166 | } | |
1bbd0b84 GB |
167 | #undef FUNC_NAME |
168 | ||
e41530ba | 169 | |
1bbd0b84 GB |
170 | SCM_REGISTER_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_x); |
171 | SCM_REGISTER_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_x); | |
e41530ba | 172 | |
6552dbf7 GB |
173 | /* |
174 | @defun substring-move-left! str1 start1 end1 str2 start2 | |
175 | @end defun | |
176 | @deftypefn {C Function} SCM scm_substring_move_left_x (SCM @var{str1}, SCM @var{start1}, SCM @var{end1}, SCM @var{str2}, SCM @var{start2}) | |
177 | [@strong{Note:} this is only valid if you've applied the strop patch]. | |
178 | ||
179 | Moves a substring of @var{str1}, from @var{start1} to @var{end1} | |
180 | (@var{end1} is exclusive), into @var{str2}, starting at | |
181 | @var{start2}. Allows overlapping strings. | |
182 | ||
183 | @example | |
184 | (define x (make-string 10 #\a)) | |
185 | (define y "bcd") | |
186 | (substring-move-left! x 2 5 y 0) | |
187 | y | |
188 | @result{} "aaa" | |
189 | ||
190 | x | |
191 | @result{} "aaaaaaaaaa" | |
192 | ||
193 | (define y "bcdefg") | |
194 | (substring-move-left! x 2 5 y 0) | |
195 | y | |
196 | @result{} "aaaefg" | |
197 | ||
198 | (define y "abcdefg") | |
199 | (substring-move-left! y 2 5 y 3) | |
200 | y | |
201 | @result{} "abccccg" | |
202 | @end example | |
203 | */ | |
204 | ||
205 | /* | |
206 | @defun substring-move-right! str1 start1 end1 str2 start2 | |
207 | @end defun | |
208 | @deftypefn {C Function} SCM scm_substring_move_right_x (SCM @var{str1}, SCM @var{start1}, SCM @var{end1}, SCM @var{str2}, SCM @var{start2}) | |
209 | [@strong{Note:} this is only valid if you've applied the strop patch, if | |
210 | it hasn't made it into the guile tree]. | |
211 | ||
212 | Does much the same thing as @code{substring-move-left!}, except it | |
213 | starts moving at the end of the sequence, rather than the beginning. | |
214 | @example | |
215 | (define y "abcdefg") | |
216 | (substring-move-right! y 2 5 y 0) | |
217 | y | |
218 | @result{} "ededefg" | |
219 | ||
220 | (define y "abcdefg") | |
221 | (substring-move-right! y 2 5 y 3) | |
222 | y | |
223 | @result{} "abccdeg" | |
224 | @end example | |
225 | */ | |
1cc91f1b | 226 | |
3b3b36dd | 227 | SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, |
1bbd0b84 | 228 | (SCM str1, SCM start1, SCM end1, SCM str2, SCM start2), |
b380b885 MD |
229 | "Copy the substring of @var{str1} bounded by @var{start1} and @var{end1}\n" |
230 | "into @var{str2} beginning at position @var{end2}.\n" | |
231 | "@code{substring-move-right!} begins copying from the rightmost character\n" | |
232 | "and moves left, and @code{substring-move-left!} copies from the leftmost\n" | |
233 | "character moving right.\n\n" | |
234 | "It is useful to have two functions that copy in different directions so\n" | |
235 | "that substrings can be copied back and forth within a single string. If\n" | |
236 | "you wish to copy text from the left-hand side of a string to the\n" | |
237 | "right-hand side of the same string, and the source and destination\n" | |
238 | "overlap, you must be careful to copy the rightmost characters of the\n" | |
239 | "text first, to avoid clobbering your data. Hence, when @var{str1} and\n" | |
240 | "@var{str2} are the same string, you should use\n" | |
241 | "@code{substring-move-right!} when moving text from left to right, and\n" | |
242 | "@code{substring-move-left!} otherwise. If @code{str1} and @samp{str2}\n" | |
243 | "are different strings, it does not matter which function you use.") | |
1bbd0b84 | 244 | #define FUNC_NAME s_scm_substring_move_x |
0f2d19dd | 245 | { |
99a9952d JB |
246 | long s1, s2, e, len; |
247 | ||
3b3b36dd GB |
248 | SCM_VALIDATE_STRING (1,str1); |
249 | SCM_VALIDATE_INUM_COPY (2,start1,s1); | |
250 | SCM_VALIDATE_INUM_COPY (3,end1,e); | |
251 | SCM_VALIDATE_STRING (4,str2); | |
252 | SCM_VALIDATE_INUM_COPY (5,start2,s2); | |
99a9952d | 253 | len = e - s1; |
1bbd0b84 GB |
254 | SCM_ASSERT_RANGE (3,end1,len >= 0); |
255 | SCM_ASSERT_RANGE (2,start1,s1 <= SCM_LENGTH (str1) && s1 >= 0); | |
256 | SCM_ASSERT_RANGE (5,start2,s2 <= SCM_LENGTH (str2) && s2 >= 0); | |
257 | SCM_ASSERT_RANGE (3,end1,e <= SCM_LENGTH (str1) && e >= 0); | |
258 | SCM_ASSERT_RANGE (5,start2,len+s2 <= SCM_LENGTH (str2)); | |
0f2d19dd | 259 | |
99a9952d JB |
260 | SCM_SYSCALL(memmove((void *)(&(SCM_CHARS(str2)[s2])), |
261 | (void *)(&(SCM_CHARS(str1)[s1])), | |
262 | len)); | |
263 | ||
b1349e46 | 264 | return scm_return_first(SCM_UNSPECIFIED, str1, str2); |
0f2d19dd | 265 | } |
1bbd0b84 | 266 | #undef FUNC_NAME |
0f2d19dd JB |
267 | |
268 | ||
3b3b36dd | 269 | SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0, |
1bbd0b84 | 270 | (SCM str, SCM start, SCM end, SCM fill), |
b380b885 | 271 | "Change every character in @var{str} between @var{start} and @var{end} to\n" |
6552dbf7 GB |
272 | "@var{fill-char}.\n\n" |
273 | "(qdocs:) Destructively fills @var{str}, from @var{start} to @var{end}, with @var{fill}.\n\n" | |
274 | "@example\n" | |
275 | "(define y \"abcdefg\")\n" | |
276 | "(substring-fill! y 1 3 #\r)\n" | |
277 | "y\n" | |
278 | "@result{} \"arrdefg\"\n" | |
279 | "@end example") | |
1bbd0b84 | 280 | #define FUNC_NAME s_scm_substring_fill_x |
0f2d19dd | 281 | { |
0f2d19dd JB |
282 | long i, e; |
283 | char c; | |
3b3b36dd GB |
284 | SCM_VALIDATE_STRING (1,str); |
285 | SCM_VALIDATE_INUM_COPY (2,start,i); | |
286 | SCM_VALIDATE_INUM_COPY (3,end,e); | |
7866a09b | 287 | SCM_VALIDATE_CHAR_COPY (4,fill,c); |
1bbd0b84 GB |
288 | SCM_ASSERT_RANGE (2,start,i <= SCM_LENGTH (str) && i >= 0); |
289 | SCM_ASSERT_RANGE (3,end,e <= SCM_LENGTH (str) && e >= 0); | |
0f2d19dd JB |
290 | while (i<e) SCM_CHARS (str)[i++] = c; |
291 | return SCM_UNSPECIFIED; | |
292 | } | |
1bbd0b84 | 293 | #undef FUNC_NAME |
0f2d19dd JB |
294 | |
295 | ||
3b3b36dd | 296 | SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, |
1bbd0b84 | 297 | (SCM str), |
b380b885 | 298 | "Return @code{#t} if @var{str}'s length is nonzero, and @code{#f}\n" |
6552dbf7 GB |
299 | "otherwise.\n\n" |
300 | "(qdocs:) Returns @code{#t} if @var{str} is empty, else returns @code{#f}.\n\n" | |
301 | "@example\n" | |
302 | "(string-null? \"\")\n" | |
303 | "@result{} #t\n\n" | |
304 | "(string-null? y)\n" | |
305 | "@result{} #f\n" | |
306 | "@end example") | |
1bbd0b84 | 307 | #define FUNC_NAME s_scm_string_null_p |
0f2d19dd | 308 | { |
3b3b36dd | 309 | SCM_VALIDATE_ROSTRING (1,str); |
1bbd0b84 | 310 | return SCM_NEGATE_BOOL(SCM_ROLENGTH (str)); |
0f2d19dd | 311 | } |
1bbd0b84 | 312 | #undef FUNC_NAME |
0f2d19dd JB |
313 | |
314 | ||
3b3b36dd | 315 | SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, |
1bbd0b84 | 316 | (SCM str), |
6552dbf7 GB |
317 | "@samp{String->list} returns a newly allocated list of the\n" |
318 | "characters that make up the given string. @samp{List->string}\n" | |
319 | "returns a newly allocated string formed from the characters in the list\n" | |
320 | "@var{list}, which must be a list of characters. @samp{String->list}\n" | |
321 | "and @samp{list->string} are\n" | |
322 | "inverses so far as @samp{equal?} is concerned. (r5rs)") | |
1bbd0b84 | 323 | #define FUNC_NAME s_scm_string_to_list |
0f2d19dd JB |
324 | { |
325 | long i; | |
326 | SCM res = SCM_EOL; | |
327 | unsigned char *src; | |
3b3b36dd | 328 | SCM_VALIDATE_ROSTRING (1,str); |
0f2d19dd | 329 | src = SCM_ROUCHARS (str); |
7866a09b | 330 | for (i = SCM_ROLENGTH (str)-1;i >= 0;i--) res = scm_cons ((SCM)SCM_MAKE_CHAR (src[i]), res); |
0f2d19dd JB |
331 | return res; |
332 | } | |
1bbd0b84 | 333 | #undef FUNC_NAME |
0f2d19dd JB |
334 | |
335 | ||
336 | ||
3b3b36dd | 337 | SCM_DEFINE (scm_string_copy, "string-copy", 1, 0, 0, |
1bbd0b84 | 338 | (SCM str), |
6552dbf7 | 339 | "Returns a newly allocated copy of the given @var{string}. (r5rs)") |
1bbd0b84 | 340 | #define FUNC_NAME s_scm_string_copy |
0f2d19dd | 341 | { |
3b3b36dd | 342 | SCM_VALIDATE_STRINGORSUBSTR (1,str); |
3d8d56df | 343 | return scm_makfromstr (SCM_ROCHARS (str), (scm_sizet)SCM_ROLENGTH (str), 0); |
0f2d19dd | 344 | } |
1bbd0b84 | 345 | #undef FUNC_NAME |
0f2d19dd JB |
346 | |
347 | ||
3b3b36dd | 348 | SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0, |
1bbd0b84 | 349 | (SCM str, SCM chr), |
6552dbf7 GB |
350 | "Stores @var{char} in every element of the given @var{string} and returns an\n" |
351 | "unspecified value. (r5rs)") | |
1bbd0b84 | 352 | #define FUNC_NAME s_scm_string_fill_x |
0f2d19dd JB |
353 | { |
354 | register char *dst, c; | |
355 | register long k; | |
3b3b36dd | 356 | SCM_VALIDATE_STRING_COPY (1,str,dst); |
7866a09b | 357 | SCM_VALIDATE_CHAR_COPY (2,chr,c); |
0f2d19dd JB |
358 | for (k = SCM_LENGTH (str)-1;k >= 0;k--) dst[k] = c; |
359 | return SCM_UNSPECIFIED; | |
360 | } | |
1bbd0b84 | 361 | #undef FUNC_NAME |
0f2d19dd | 362 | |
3b3b36dd | 363 | SCM_DEFINE (scm_string_upcase_x, "string-upcase!", 1, 0, 0, |
1bbd0b84 | 364 | (SCM v), |
6552dbf7 GB |
365 | "Destructively upcase every character in @code{str}.\n\n" |
366 | "(qdocs:) Converts each element in @var{str} to upper case.\n\n" | |
367 | "@example\n" | |
368 | "(string-upcase! y)\n" | |
369 | "@result{} \"ARRDEFG\"\n\n" | |
370 | "y\n" | |
371 | "@result{} \"ARRDEFG\"\n" | |
372 | "@end example") | |
1bbd0b84 | 373 | #define FUNC_NAME s_scm_string_upcase_x |
c101e39e GH |
374 | { |
375 | register long k; | |
376 | register unsigned char *cs; | |
377 | SCM_ASRTGO (SCM_NIMP (v), badarg1); | |
378 | k = SCM_LENGTH (v); | |
379 | switch SCM_TYP7 | |
380 | (v) | |
381 | { | |
382 | case scm_tc7_string: | |
383 | cs = SCM_UCHARS (v); | |
384 | while (k--) | |
385 | cs[k] = scm_upcase(cs[k]); | |
386 | break; | |
387 | default: | |
1bbd0b84 | 388 | badarg1:SCM_WTA (1,v); |
c101e39e GH |
389 | } |
390 | return v; | |
391 | } | |
1bbd0b84 | 392 | #undef FUNC_NAME |
c101e39e | 393 | |
3b3b36dd | 394 | SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0, |
1bbd0b84 | 395 | (SCM str), |
6552dbf7 | 396 | "Upcase every character in @code{str}.") |
1bbd0b84 | 397 | #define FUNC_NAME s_scm_string_upcase |
99a9952d JB |
398 | { |
399 | return scm_string_upcase_x(scm_string_copy(str)); | |
400 | } | |
1bbd0b84 | 401 | #undef FUNC_NAME |
99a9952d | 402 | |
3b3b36dd | 403 | SCM_DEFINE (scm_string_downcase_x, "string-downcase!", 1, 0, 0, |
1bbd0b84 | 404 | (SCM v), |
6552dbf7 GB |
405 | "Destructively downcase every character in @code{str}.\n\n" |
406 | "(qdocs:) Converts each element in @var{str} to lower case.\n\n" | |
407 | "@example\n" | |
408 | "y\n" | |
409 | "@result{} \"ARRDEFG\"\n\n" | |
410 | "(string-downcase! y)\n" | |
411 | "@result{} \"arrdefg\"\n\n" | |
412 | "y\n" | |
413 | "@result{} \"arrdefg\"\n" | |
414 | "@end example") | |
1bbd0b84 | 415 | #define FUNC_NAME s_scm_string_downcase_x |
c101e39e GH |
416 | { |
417 | register long k; | |
418 | register unsigned char *cs; | |
419 | SCM_ASRTGO (SCM_NIMP (v), badarg1); | |
420 | k = SCM_LENGTH (v); | |
99a9952d | 421 | switch (SCM_TYP7(v)) |
c101e39e | 422 | { |
99a9952d JB |
423 | case scm_tc7_string: |
424 | cs = SCM_UCHARS (v); | |
425 | while (k--) | |
426 | cs[k] = scm_downcase(cs[k]); | |
427 | break; | |
428 | default: | |
1bbd0b84 | 429 | badarg1:SCM_WTA (1,v); |
c101e39e GH |
430 | } |
431 | return v; | |
432 | } | |
1bbd0b84 | 433 | #undef FUNC_NAME |
0f2d19dd | 434 | |
3b3b36dd | 435 | SCM_DEFINE (scm_string_downcase, "string-downcase", 1, 0, 0, |
1bbd0b84 | 436 | (SCM str), |
6552dbf7 | 437 | "Downcase every character in @code{str}.") |
1bbd0b84 | 438 | #define FUNC_NAME s_scm_string_downcase |
99a9952d | 439 | { |
3b3b36dd | 440 | SCM_VALIDATE_STRING (1,str); |
99a9952d JB |
441 | return scm_string_downcase_x(scm_string_copy(str)); |
442 | } | |
1bbd0b84 | 443 | #undef FUNC_NAME |
99a9952d | 444 | |
3b3b36dd | 445 | SCM_DEFINE (scm_string_capitalize_x, "string-capitalize!", 1, 0, 0, |
6552dbf7 GB |
446 | (SCM str), |
447 | "Destructively capitalize every character in @code{str}.") | |
1bbd0b84 | 448 | #define FUNC_NAME s_scm_string_capitalize_x |
99a9952d | 449 | { |
6552dbf7 | 450 | char *sz; |
99a9952d | 451 | int i, len, in_word=0; |
6552dbf7 GB |
452 | SCM_VALIDATE_STRING (1,str); |
453 | len = SCM_LENGTH(str); | |
454 | sz = SCM_CHARS(str); | |
99a9952d | 455 | for(i=0; i<len; i++) { |
7866a09b | 456 | if(SCM_NFALSEP(scm_char_alphabetic_p(SCM_MAKE_CHAR(sz[i])))) { |
99a9952d | 457 | if(!in_word) { |
6552dbf7 | 458 | sz[i] = scm_upcase(sz[i]); |
99a9952d JB |
459 | in_word = 1; |
460 | } else { | |
6552dbf7 | 461 | sz[i] = scm_downcase(sz[i]); |
99a9952d JB |
462 | } |
463 | } | |
464 | else in_word = 0; | |
465 | } | |
6552dbf7 | 466 | return str; |
99a9952d | 467 | } |
1bbd0b84 | 468 | #undef FUNC_NAME |
99a9952d | 469 | |
3b3b36dd | 470 | SCM_DEFINE (scm_string_capitalize, "string-capitalize", 1, 0, 0, |
6552dbf7 GB |
471 | (SCM str), |
472 | "Capitalize every character in @code{str}.") | |
1bbd0b84 | 473 | #define FUNC_NAME s_scm_string_capitalize |
99a9952d | 474 | { |
6552dbf7 GB |
475 | SCM_VALIDATE_STRING (1,str); |
476 | return scm_string_capitalize_x(scm_string_copy(str)); | |
99a9952d | 477 | } |
1bbd0b84 | 478 | #undef FUNC_NAME |
99a9952d | 479 | |
3b3b36dd | 480 | SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, |
1bbd0b84 | 481 | (SCM str), |
6552dbf7 | 482 | "Return the symbol whose name is @var{str}, downcased in necessary(???).") |
1bbd0b84 | 483 | #define FUNC_NAME s_scm_string_ci_to_symbol |
99a9952d JB |
484 | { |
485 | return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P | |
486 | ? scm_string_downcase(str) | |
487 | : str); | |
488 | } | |
1bbd0b84 | 489 | #undef FUNC_NAME |
1cc91f1b | 490 | |
0f2d19dd JB |
491 | void |
492 | scm_init_strop () | |
0f2d19dd JB |
493 | { |
494 | #include "strop.x" | |
495 | } |