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