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