Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | /* classes: src_files */ |
2 | ||
f2c9fcb0 | 3 | /* Copyright (C) 1994, 1996, 1997, 1999, 2000 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 | ||
a6d9e5ab | 64 | SCM_ASSERT (SCM_STRINGP (*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 | 71 | lower = SCM_INUM (sub_start); |
a6d9e5ab | 72 | if (lower < 0 || lower > SCM_STRING_LENGTH (*str)) |
03bc4386 | 73 | scm_out_of_range (why, sub_start); |
0f2d19dd | 74 | |
54778cd3 | 75 | if (SCM_FALSEP (sub_end)) |
a6d9e5ab | 76 | sub_end = SCM_MAKINUM (SCM_STRING_LENGTH (*str)); |
03bc4386 | 77 | |
99a9952d | 78 | SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); |
03bc4386 | 79 | upper = SCM_INUM (sub_end); |
a6d9e5ab | 80 | if (upper < SCM_INUM (sub_start) || upper > SCM_STRING_LENGTH (*str)) |
03bc4386 GH |
81 | scm_out_of_range (why, sub_end); |
82 | ||
83 | if (direction > 0) | |
84 | { | |
85 | p = (unsigned char *)SCM_ROCHARS (*str) + lower; | |
7866a09b | 86 | ch = SCM_CHAR (chr); |
03bc4386 GH |
87 | |
88 | for (x = SCM_INUM (sub_start); x < upper; ++x, ++p) | |
89 | if (*p == ch) | |
90 | return x; | |
91 | } | |
0f2d19dd | 92 | else |
03bc4386 GH |
93 | { |
94 | p = upper - 1 + (unsigned char *)SCM_ROCHARS (*str); | |
7866a09b | 95 | ch = SCM_CHAR (chr); |
03bc4386 GH |
96 | for (x = upper - 1; x >= lower; --x, --p) |
97 | if (*p == ch) | |
98 | return x; | |
99 | } | |
0f2d19dd JB |
100 | |
101 | return -1; | |
102 | } | |
103 | ||
3b3b36dd | 104 | SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0, |
1bbd0b84 | 105 | (SCM str, SCM chr, SCM frm, SCM to), |
b380b885 MD |
106 | "Return the index of the first occurrence of @var{chr} in @var{str}. The\n" |
107 | "optional integer arguments @var{frm} and @var{to} limit the search to\n" | |
108 | "a portion of the string. This procedure essentially implements the\n" | |
6552dbf7 GB |
109 | "@code{index} or @code{strchr} functions from the C library.\n\n" |
110 | "(qdocs:) Returns the index of @var{char} in @var{str}, or @code{#f} if the\n" | |
111 | "@var{char} isn't in @var{str}. If @var{frm} is given and not @code{#f},\n" | |
112 | "it is used as the starting index; if @var{to} is given and not @var{#f},\n" | |
113 | "it is used as the ending index (exclusive).\n\n" | |
114 | "@example\n" | |
1670bef9 | 115 | "(string-index \"weiner\" #\\e)\n" |
6552dbf7 | 116 | "@result{} 1\n\n" |
1670bef9 | 117 | "(string-index \"weiner\" #\\e 2)\n" |
6552dbf7 | 118 | "@result{} 4\n\n" |
1670bef9 | 119 | "(string-index \"weiner\" #\\e 2 4)\n" |
6552dbf7 GB |
120 | "@result{} #f\n" |
121 | "@end example") | |
1bbd0b84 | 122 | #define FUNC_NAME s_scm_string_index |
0f2d19dd JB |
123 | { |
124 | int pos; | |
125 | ||
54778cd3 | 126 | if (SCM_UNBNDP (frm)) |
0f2d19dd | 127 | frm = SCM_BOOL_F; |
54778cd3 | 128 | if (SCM_UNBNDP (to)) |
0f2d19dd | 129 | to = SCM_BOOL_F; |
1bbd0b84 | 130 | pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME); |
0f2d19dd JB |
131 | return (pos < 0 |
132 | ? SCM_BOOL_F | |
133 | : SCM_MAKINUM (pos)); | |
134 | } | |
1bbd0b84 | 135 | #undef FUNC_NAME |
0f2d19dd | 136 | |
3b3b36dd | 137 | SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0, |
1bbd0b84 | 138 | (SCM str, SCM chr, SCM frm, SCM to), |
b380b885 MD |
139 | "Like @code{string-index}, but search from the right of the string rather\n" |
140 | "than from the left. This procedure essentially implements the\n" | |
6552dbf7 GB |
141 | "@code{rindex} or @code{strrchr} functions from the C library.\n\n" |
142 | "(qdocs:) The same as @code{string-index}, except it gives the rightmost occurance\n" | |
143 | "of @var{char} in the range [@var{frm}, @var{to}-1], which defaults to\n" | |
144 | "the entire string.\n\n" | |
145 | "@example\n" | |
1670bef9 | 146 | "(string-rindex \"weiner\" #\\e)\n" |
6552dbf7 | 147 | "@result{} 4\n\n" |
1670bef9 | 148 | "(string-rindex \"weiner\" #\\e 2 4)\n" |
6552dbf7 | 149 | "@result{} #f\n\n" |
1670bef9 | 150 | "(string-rindex \"weiner\" #\\e 2 5)\n" |
6552dbf7 GB |
151 | "@result{} 4\n" |
152 | "@end example") | |
1bbd0b84 | 153 | #define FUNC_NAME s_scm_string_rindex |
0f2d19dd JB |
154 | { |
155 | int pos; | |
156 | ||
54778cd3 | 157 | if (SCM_UNBNDP (frm)) |
0f2d19dd | 158 | frm = SCM_BOOL_F; |
54778cd3 | 159 | if (SCM_UNBNDP (to)) |
0f2d19dd | 160 | to = SCM_BOOL_F; |
1bbd0b84 | 161 | pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME); |
0f2d19dd JB |
162 | return (pos < 0 |
163 | ? SCM_BOOL_F | |
164 | : SCM_MAKINUM (pos)); | |
165 | } | |
1bbd0b84 GB |
166 | #undef FUNC_NAME |
167 | ||
e41530ba | 168 | |
1bbd0b84 GB |
169 | SCM_REGISTER_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_x); |
170 | SCM_REGISTER_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_x); | |
e41530ba | 171 | |
6552dbf7 GB |
172 | /* |
173 | @defun substring-move-left! str1 start1 end1 str2 start2 | |
174 | @end defun | |
175 | @deftypefn {C Function} SCM scm_substring_move_left_x (SCM @var{str1}, SCM @var{start1}, SCM @var{end1}, SCM @var{str2}, SCM @var{start2}) | |
176 | [@strong{Note:} this is only valid if you've applied the strop patch]. | |
177 | ||
178 | Moves a substring of @var{str1}, from @var{start1} to @var{end1} | |
179 | (@var{end1} is exclusive), into @var{str2}, starting at | |
180 | @var{start2}. Allows overlapping strings. | |
181 | ||
182 | @example | |
183 | (define x (make-string 10 #\a)) | |
184 | (define y "bcd") | |
185 | (substring-move-left! x 2 5 y 0) | |
186 | y | |
187 | @result{} "aaa" | |
188 | ||
189 | x | |
190 | @result{} "aaaaaaaaaa" | |
191 | ||
192 | (define y "bcdefg") | |
193 | (substring-move-left! x 2 5 y 0) | |
194 | y | |
195 | @result{} "aaaefg" | |
196 | ||
197 | (define y "abcdefg") | |
198 | (substring-move-left! y 2 5 y 3) | |
199 | y | |
200 | @result{} "abccccg" | |
201 | @end example | |
202 | */ | |
203 | ||
204 | /* | |
205 | @defun substring-move-right! str1 start1 end1 str2 start2 | |
206 | @end defun | |
207 | @deftypefn {C Function} SCM scm_substring_move_right_x (SCM @var{str1}, SCM @var{start1}, SCM @var{end1}, SCM @var{str2}, SCM @var{start2}) | |
208 | [@strong{Note:} this is only valid if you've applied the strop patch, if | |
209 | it hasn't made it into the guile tree]. | |
210 | ||
211 | Does much the same thing as @code{substring-move-left!}, except it | |
212 | starts moving at the end of the sequence, rather than the beginning. | |
213 | @example | |
214 | (define y "abcdefg") | |
215 | (substring-move-right! y 2 5 y 0) | |
216 | y | |
217 | @result{} "ededefg" | |
218 | ||
219 | (define y "abcdefg") | |
220 | (substring-move-right! y 2 5 y 3) | |
221 | y | |
222 | @result{} "abccdeg" | |
223 | @end example | |
224 | */ | |
1cc91f1b | 225 | |
3b3b36dd | 226 | SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, |
1bbd0b84 | 227 | (SCM str1, SCM start1, SCM end1, SCM str2, SCM start2), |
11768c04 NJ |
228 | "@deffnx primitive substring-move-left! str1 start1 end1 str2 start2\n" |
229 | "@deffnx primitive substring-move-right! str1 start1 end1 str2 start2\n" | |
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 | 255 | SCM_ASSERT_RANGE (3,end1,len >= 0); |
bfa974f0 DH |
256 | SCM_ASSERT_RANGE (2,start1,s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0); |
257 | SCM_ASSERT_RANGE (5,start2,s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0); | |
258 | SCM_ASSERT_RANGE (3,end1,e <= SCM_STRING_LENGTH (str1) && e >= 0); | |
259 | SCM_ASSERT_RANGE (5,start2,len+s2 <= SCM_STRING_LENGTH (str2)); | |
0f2d19dd | 260 | |
86c991c2 DH |
261 | SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), |
262 | (void *)(&(SCM_STRING_CHARS(str1)[s1])), | |
99a9952d JB |
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" | |
1670bef9 | 277 | "(substring-fill! y 1 3 #\\r)\n" |
6552dbf7 GB |
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); |
bfa974f0 DH |
289 | SCM_ASSERT_RANGE (2,start,i <= SCM_STRING_LENGTH (str) && i >= 0); |
290 | SCM_ASSERT_RANGE (3,end,e <= SCM_STRING_LENGTH (str) && e >= 0); | |
86c991c2 | 291 | while (i<e) SCM_STRING_CHARS (str)[i++] = c; |
0f2d19dd JB |
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 | { |
a6d9e5ab DH |
310 | SCM_VALIDATE_STRING (1,str); |
311 | return SCM_NEGATE_BOOL (SCM_STRING_LENGTH (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; | |
a6d9e5ab | 329 | SCM_VALIDATE_STRING (1,str); |
0f2d19dd | 330 | src = SCM_ROUCHARS (str); |
a6d9e5ab | 331 | for (i = SCM_STRING_LENGTH (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 | { |
d1ca2c64 DH |
343 | SCM_VALIDATE_STRING (1, str); |
344 | return scm_makfromstr (SCM_ROCHARS (str), SCM_STRING_LENGTH (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); |
bfa974f0 | 359 | for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; |
0f2d19dd JB |
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 | 375 | { |
322ac0c5 DH |
376 | unsigned long k; |
377 | ||
378 | SCM_VALIDATE_STRING (1, v); | |
379 | ||
bfa974f0 | 380 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) |
322ac0c5 DH |
381 | SCM_STRING_UCHARS (v) [k] = scm_upcase (SCM_STRING_UCHARS (v) [k]); |
382 | ||
c101e39e GH |
383 | return v; |
384 | } | |
1bbd0b84 | 385 | #undef FUNC_NAME |
c101e39e | 386 | |
3b3b36dd | 387 | SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0, |
1bbd0b84 | 388 | (SCM str), |
6552dbf7 | 389 | "Upcase every character in @code{str}.") |
1bbd0b84 | 390 | #define FUNC_NAME s_scm_string_upcase |
99a9952d JB |
391 | { |
392 | return scm_string_upcase_x(scm_string_copy(str)); | |
393 | } | |
1bbd0b84 | 394 | #undef FUNC_NAME |
99a9952d | 395 | |
3b3b36dd | 396 | SCM_DEFINE (scm_string_downcase_x, "string-downcase!", 1, 0, 0, |
1bbd0b84 | 397 | (SCM v), |
6552dbf7 GB |
398 | "Destructively downcase every character in @code{str}.\n\n" |
399 | "(qdocs:) Converts each element in @var{str} to lower case.\n\n" | |
400 | "@example\n" | |
401 | "y\n" | |
402 | "@result{} \"ARRDEFG\"\n\n" | |
403 | "(string-downcase! y)\n" | |
404 | "@result{} \"arrdefg\"\n\n" | |
405 | "y\n" | |
406 | "@result{} \"arrdefg\"\n" | |
407 | "@end example") | |
1bbd0b84 | 408 | #define FUNC_NAME s_scm_string_downcase_x |
c101e39e | 409 | { |
322ac0c5 DH |
410 | unsigned long k; |
411 | ||
412 | SCM_VALIDATE_STRING (1, v); | |
413 | ||
bfa974f0 | 414 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) |
322ac0c5 DH |
415 | SCM_STRING_UCHARS (v) [k] = scm_downcase (SCM_STRING_UCHARS (v) [k]); |
416 | ||
c101e39e GH |
417 | return v; |
418 | } | |
1bbd0b84 | 419 | #undef FUNC_NAME |
0f2d19dd | 420 | |
3b3b36dd | 421 | SCM_DEFINE (scm_string_downcase, "string-downcase", 1, 0, 0, |
1bbd0b84 | 422 | (SCM str), |
6552dbf7 | 423 | "Downcase every character in @code{str}.") |
1bbd0b84 | 424 | #define FUNC_NAME s_scm_string_downcase |
99a9952d | 425 | { |
3b3b36dd | 426 | SCM_VALIDATE_STRING (1,str); |
99a9952d JB |
427 | return scm_string_downcase_x(scm_string_copy(str)); |
428 | } | |
1bbd0b84 | 429 | #undef FUNC_NAME |
99a9952d | 430 | |
3b3b36dd | 431 | SCM_DEFINE (scm_string_capitalize_x, "string-capitalize!", 1, 0, 0, |
6552dbf7 GB |
432 | (SCM str), |
433 | "Destructively capitalize every character in @code{str}.") | |
1bbd0b84 | 434 | #define FUNC_NAME s_scm_string_capitalize_x |
99a9952d | 435 | { |
6552dbf7 | 436 | char *sz; |
99a9952d | 437 | int i, len, in_word=0; |
6552dbf7 | 438 | SCM_VALIDATE_STRING (1,str); |
bfa974f0 | 439 | len = SCM_STRING_LENGTH(str); |
86c991c2 | 440 | sz = SCM_STRING_CHARS (str); |
99a9952d | 441 | for(i=0; i<len; i++) { |
7866a09b | 442 | if(SCM_NFALSEP(scm_char_alphabetic_p(SCM_MAKE_CHAR(sz[i])))) { |
99a9952d | 443 | if(!in_word) { |
6552dbf7 | 444 | sz[i] = scm_upcase(sz[i]); |
99a9952d JB |
445 | in_word = 1; |
446 | } else { | |
6552dbf7 | 447 | sz[i] = scm_downcase(sz[i]); |
99a9952d JB |
448 | } |
449 | } | |
450 | else in_word = 0; | |
451 | } | |
6552dbf7 | 452 | return str; |
99a9952d | 453 | } |
1bbd0b84 | 454 | #undef FUNC_NAME |
99a9952d | 455 | |
3b3b36dd | 456 | SCM_DEFINE (scm_string_capitalize, "string-capitalize", 1, 0, 0, |
6552dbf7 GB |
457 | (SCM str), |
458 | "Capitalize every character in @code{str}.") | |
1bbd0b84 | 459 | #define FUNC_NAME s_scm_string_capitalize |
99a9952d | 460 | { |
6552dbf7 GB |
461 | SCM_VALIDATE_STRING (1,str); |
462 | return scm_string_capitalize_x(scm_string_copy(str)); | |
99a9952d | 463 | } |
1bbd0b84 | 464 | #undef FUNC_NAME |
99a9952d | 465 | |
3b3b36dd | 466 | SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, |
1bbd0b84 | 467 | (SCM str), |
6552dbf7 | 468 | "Return the symbol whose name is @var{str}, downcased in necessary(???).") |
1bbd0b84 | 469 | #define FUNC_NAME s_scm_string_ci_to_symbol |
99a9952d JB |
470 | { |
471 | return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P | |
472 | ? scm_string_downcase(str) | |
473 | : str); | |
474 | } | |
1bbd0b84 | 475 | #undef FUNC_NAME |
1cc91f1b | 476 | |
0f2d19dd JB |
477 | void |
478 | scm_init_strop () | |
0f2d19dd | 479 | { |
8dc9439f | 480 | #ifndef SCM_MAGIC_SNARFER |
a0599745 | 481 | #include "libguile/strop.x" |
8dc9439f | 482 | #endif |
0f2d19dd | 483 | } |
89e00824 ML |
484 | |
485 | /* | |
486 | Local Variables: | |
487 | c-file-style: "gnu" | |
488 | End: | |
489 | */ |