Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | /* classes: src_files */ |
2 | ||
36284627 | 3 | /* Copyright (C) 1994,1996,1997,1999,2000,2001 Free Software Foundation, Inc. |
0f2d19dd | 4 | |
73be1d9e MV |
5 | * This library is free software; you can redistribute it and/or |
6 | * modify it under the terms of the GNU Lesser General Public | |
7 | * License as published by the Free Software Foundation; either | |
8 | * version 2.1 of the License, or (at your option) any later version. | |
9 | * | |
10 | * This library 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 GNU | |
13 | * Lesser General Public License for more details. | |
14 | * | |
15 | * You should have received a copy of the GNU Lesser General Public | |
16 | * License along with this library; if not, write to the Free Software | |
17 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
18 | */ | |
0f2d19dd JB |
19 | |
20 | \f | |
6ada43c9 RB |
21 | #if HAVE_CONFIG_H |
22 | # include <config.h> | |
23 | #endif | |
0f2d19dd | 24 | |
e6e2e95a MD |
25 | #include <errno.h> |
26 | ||
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 | /* |
5ad8ab0a | 42 | xSCM_DEFINE (scm_i_index, "i-index", 2, 2, 0, |
6552dbf7 | 43 | (SCM str, SCM chr, SCM frm, SCM to), |
9401323e | 44 | "@deftypefn {Internal C Function} {static int} scm_i_index (SCM *@var{str},\n" |
6552dbf7 GB |
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" | |
2b7b76d5 | 47 | "@code{rindex} function, depending on the value of @var{direction}." |
6552dbf7 | 48 | */ |
03bc4386 | 49 | /* implements index if direction > 0 otherwise rindex. */ |
c014a02e | 50 | static long |
5ad8ab0a | 51 | scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, |
99a9952d | 52 | SCM sub_end, const char *why) |
0f2d19dd JB |
53 | { |
54 | unsigned char * p; | |
c014a02e ML |
55 | long x; |
56 | long lower; | |
57 | long upper; | |
0f2d19dd JB |
58 | int ch; |
59 | ||
a6d9e5ab | 60 | SCM_ASSERT (SCM_STRINGP (*str), *str, SCM_ARG1, why); |
7866a09b | 61 | SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); |
0f2d19dd | 62 | |
7888309b | 63 | if (scm_is_false (sub_start)) |
93ccaef0 | 64 | sub_start = SCM_I_MAKINUM (0); |
03bc4386 | 65 | |
99a9952d | 66 | SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); |
03bc4386 | 67 | lower = SCM_INUM (sub_start); |
a6d9e5ab | 68 | if (lower < 0 || lower > SCM_STRING_LENGTH (*str)) |
03bc4386 | 69 | scm_out_of_range (why, sub_start); |
0f2d19dd | 70 | |
7888309b | 71 | if (scm_is_false (sub_end)) |
93ccaef0 | 72 | sub_end = SCM_I_MAKINUM (SCM_STRING_LENGTH (*str)); |
03bc4386 | 73 | |
99a9952d | 74 | SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); |
03bc4386 | 75 | upper = SCM_INUM (sub_end); |
a6d9e5ab | 76 | if (upper < SCM_INUM (sub_start) || upper > SCM_STRING_LENGTH (*str)) |
03bc4386 GH |
77 | scm_out_of_range (why, sub_end); |
78 | ||
79 | if (direction > 0) | |
80 | { | |
34f0f2b8 | 81 | p = SCM_STRING_UCHARS (*str) + lower; |
7866a09b | 82 | ch = SCM_CHAR (chr); |
03bc4386 GH |
83 | |
84 | for (x = SCM_INUM (sub_start); x < upper; ++x, ++p) | |
85 | if (*p == ch) | |
86 | return x; | |
87 | } | |
0f2d19dd | 88 | else |
03bc4386 | 89 | { |
34f0f2b8 | 90 | p = upper - 1 + SCM_STRING_UCHARS (*str); |
7866a09b | 91 | ch = SCM_CHAR (chr); |
03bc4386 GH |
92 | for (x = upper - 1; x >= lower; --x, --p) |
93 | if (*p == ch) | |
94 | return x; | |
95 | } | |
0f2d19dd JB |
96 | |
97 | return -1; | |
98 | } | |
99 | ||
5ad8ab0a | 100 | SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0, |
1bbd0b84 | 101 | (SCM str, SCM chr, SCM frm, SCM to), |
5352393c MG |
102 | "Return the index of the first occurrence of @var{chr} in\n" |
103 | "@var{str}. The optional integer arguments @var{frm} and\n" | |
104 | "@var{to} limit the search to a portion of the string. This\n" | |
105 | "procedure essentially implements the @code{index} or\n" | |
1e6808ea MG |
106 | "@code{strchr} functions from the C library.\n" |
107 | "\n" | |
108 | "@lisp\n" | |
1670bef9 | 109 | "(string-index \"weiner\" #\\e)\n" |
6552dbf7 | 110 | "@result{} 1\n\n" |
1670bef9 | 111 | "(string-index \"weiner\" #\\e 2)\n" |
6552dbf7 | 112 | "@result{} 4\n\n" |
1670bef9 | 113 | "(string-index \"weiner\" #\\e 2 4)\n" |
6552dbf7 | 114 | "@result{} #f\n" |
1e6808ea | 115 | "@end lisp") |
1bbd0b84 | 116 | #define FUNC_NAME s_scm_string_index |
0f2d19dd | 117 | { |
c014a02e | 118 | long pos; |
5ad8ab0a | 119 | |
54778cd3 | 120 | if (SCM_UNBNDP (frm)) |
0f2d19dd | 121 | frm = SCM_BOOL_F; |
54778cd3 | 122 | if (SCM_UNBNDP (to)) |
0f2d19dd | 123 | to = SCM_BOOL_F; |
1bbd0b84 | 124 | pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME); |
0f2d19dd JB |
125 | return (pos < 0 |
126 | ? SCM_BOOL_F | |
93ccaef0 | 127 | : SCM_I_MAKINUM (pos)); |
0f2d19dd | 128 | } |
1bbd0b84 | 129 | #undef FUNC_NAME |
0f2d19dd | 130 | |
5ad8ab0a | 131 | SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0, |
1bbd0b84 | 132 | (SCM str, SCM chr, SCM frm, SCM to), |
1e6808ea MG |
133 | "Like @code{string-index}, but search from the right of the\n" |
134 | "string rather than from the left. This procedure essentially\n" | |
135 | "implements the @code{rindex} or @code{strrchr} functions from\n" | |
136 | "the C library.\n" | |
137 | "\n" | |
138 | "@lisp\n" | |
1670bef9 | 139 | "(string-rindex \"weiner\" #\\e)\n" |
6552dbf7 | 140 | "@result{} 4\n\n" |
1670bef9 | 141 | "(string-rindex \"weiner\" #\\e 2 4)\n" |
6552dbf7 | 142 | "@result{} #f\n\n" |
1670bef9 | 143 | "(string-rindex \"weiner\" #\\e 2 5)\n" |
6552dbf7 | 144 | "@result{} 4\n" |
1e6808ea | 145 | "@end lisp") |
1bbd0b84 | 146 | #define FUNC_NAME s_scm_string_rindex |
0f2d19dd | 147 | { |
c014a02e | 148 | long pos; |
5ad8ab0a | 149 | |
54778cd3 | 150 | if (SCM_UNBNDP (frm)) |
0f2d19dd | 151 | frm = SCM_BOOL_F; |
54778cd3 | 152 | if (SCM_UNBNDP (to)) |
0f2d19dd | 153 | to = SCM_BOOL_F; |
1bbd0b84 | 154 | pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME); |
0f2d19dd JB |
155 | return (pos < 0 |
156 | ? SCM_BOOL_F | |
93ccaef0 | 157 | : SCM_I_MAKINUM (pos)); |
0f2d19dd | 158 | } |
1bbd0b84 GB |
159 | #undef FUNC_NAME |
160 | ||
5ad8ab0a | 161 | SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, |
1bbd0b84 | 162 | (SCM str1, SCM start1, SCM end1, SCM str2, SCM start2), |
b380b885 | 163 | "Copy the substring of @var{str1} bounded by @var{start1} and @var{end1}\n" |
5ad8ab0a | 164 | "into @var{str2} beginning at position @var{start2}.\n" |
0534158a | 165 | "@var{str1} and @var{str2} can be the same string.") |
1bbd0b84 | 166 | #define FUNC_NAME s_scm_substring_move_x |
0f2d19dd | 167 | { |
c014a02e | 168 | long s1, s2, e, len; |
99a9952d | 169 | |
34d19ef6 HWN |
170 | SCM_VALIDATE_STRING (1, str1); |
171 | SCM_VALIDATE_INUM_COPY (2, start1, s1); | |
172 | SCM_VALIDATE_INUM_COPY (3, end1, e); | |
173 | SCM_VALIDATE_STRING (4, str2); | |
174 | SCM_VALIDATE_INUM_COPY (5, start2, s2); | |
99a9952d | 175 | len = e - s1; |
34d19ef6 HWN |
176 | SCM_ASSERT_RANGE (3, end1, len >= 0); |
177 | SCM_ASSERT_RANGE (2, start1, s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0); | |
178 | SCM_ASSERT_RANGE (5, start2, s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0); | |
179 | SCM_ASSERT_RANGE (3, end1, e <= SCM_STRING_LENGTH (str1) && e >= 0); | |
180 | SCM_ASSERT_RANGE (5, start2, len+s2 <= SCM_STRING_LENGTH (str2)); | |
0f2d19dd | 181 | |
86c991c2 DH |
182 | SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), |
183 | (void *)(&(SCM_STRING_CHARS(str1)[s1])), | |
99a9952d | 184 | len)); |
5ad8ab0a | 185 | |
b1349e46 | 186 | return scm_return_first(SCM_UNSPECIFIED, str1, str2); |
0f2d19dd | 187 | } |
1bbd0b84 | 188 | #undef FUNC_NAME |
0f2d19dd JB |
189 | |
190 | ||
5ad8ab0a | 191 | SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0, |
1bbd0b84 | 192 | (SCM str, SCM start, SCM end, SCM fill), |
1e6808ea MG |
193 | "Change every character in @var{str} between @var{start} and\n" |
194 | "@var{end} to @var{fill}.\n" | |
195 | "\n" | |
196 | "@lisp\n" | |
6552dbf7 | 197 | "(define y \"abcdefg\")\n" |
1670bef9 | 198 | "(substring-fill! y 1 3 #\\r)\n" |
6552dbf7 GB |
199 | "y\n" |
200 | "@result{} \"arrdefg\"\n" | |
1e6808ea | 201 | "@end lisp") |
1bbd0b84 | 202 | #define FUNC_NAME s_scm_substring_fill_x |
0f2d19dd | 203 | { |
c014a02e | 204 | long i, e; |
0f2d19dd | 205 | char c; |
34d19ef6 HWN |
206 | SCM_VALIDATE_STRING (1, str); |
207 | SCM_VALIDATE_INUM_COPY (2, start, i); | |
208 | SCM_VALIDATE_INUM_COPY (3, end, e); | |
209 | SCM_VALIDATE_CHAR_COPY (4, fill, c); | |
210 | SCM_ASSERT_RANGE (2, start, i <= SCM_STRING_LENGTH (str) && i >= 0); | |
211 | SCM_ASSERT_RANGE (3, end, e <= SCM_STRING_LENGTH (str) && e >= 0); | |
86c991c2 | 212 | while (i<e) SCM_STRING_CHARS (str)[i++] = c; |
0f2d19dd JB |
213 | return SCM_UNSPECIFIED; |
214 | } | |
1bbd0b84 | 215 | #undef FUNC_NAME |
0f2d19dd JB |
216 | |
217 | ||
5ad8ab0a | 218 | SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, |
1bbd0b84 | 219 | (SCM str), |
9c4c86c6 | 220 | "Return @code{#t} if @var{str}'s length is zero, and\n" |
1e6808ea MG |
221 | "@code{#f} otherwise.\n" |
222 | "@lisp\n" | |
223 | "(string-null? \"\") @result{} #t\n" | |
224 | "y @result{} \"foo\"\n" | |
225 | "(string-null? y) @result{} #f\n" | |
226 | "@end lisp") | |
1bbd0b84 | 227 | #define FUNC_NAME s_scm_string_null_p |
0f2d19dd | 228 | { |
34d19ef6 | 229 | SCM_VALIDATE_STRING (1, str); |
7888309b | 230 | return scm_from_bool (SCM_STRING_LENGTH (str) == 0); |
0f2d19dd | 231 | } |
1bbd0b84 | 232 | #undef FUNC_NAME |
0f2d19dd JB |
233 | |
234 | ||
5ad8ab0a | 235 | SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, |
1bbd0b84 | 236 | (SCM str), |
91344ceb MG |
237 | "Return a newly allocated list of the characters that make up\n" |
238 | "the given string @var{str}. @code{string->list} and\n" | |
239 | "@code{list->string} are inverses as far as @samp{equal?} is\n" | |
240 | "concerned.") | |
1bbd0b84 | 241 | #define FUNC_NAME s_scm_string_to_list |
0f2d19dd | 242 | { |
c014a02e | 243 | long i; |
0f2d19dd JB |
244 | SCM res = SCM_EOL; |
245 | unsigned char *src; | |
34d19ef6 | 246 | SCM_VALIDATE_STRING (1, str); |
34f0f2b8 | 247 | src = SCM_STRING_UCHARS (str); |
a6d9e5ab | 248 | for (i = SCM_STRING_LENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res); |
0f2d19dd JB |
249 | return res; |
250 | } | |
1bbd0b84 | 251 | #undef FUNC_NAME |
0f2d19dd JB |
252 | |
253 | ||
a49af0c0 DH |
254 | /* Helper function for the string copy and string conversion functions. |
255 | * No argument checking is performed. */ | |
256 | static SCM | |
257 | string_copy (SCM str) | |
258 | { | |
36284627 DH |
259 | const char* chars = SCM_STRING_CHARS (str); |
260 | size_t length = SCM_STRING_LENGTH (str); | |
261 | SCM new_string = scm_mem2string (chars, length); | |
262 | scm_remember_upto_here_1 (str); | |
263 | return new_string; | |
a49af0c0 DH |
264 | } |
265 | ||
0f2d19dd | 266 | |
5ad8ab0a | 267 | SCM_DEFINE (scm_string_copy, "string-copy", 1, 0, 0, |
a49af0c0 | 268 | (SCM str), |
1e6808ea | 269 | "Return a newly allocated copy of the given @var{string}.") |
1bbd0b84 | 270 | #define FUNC_NAME s_scm_string_copy |
0f2d19dd | 271 | { |
d1ca2c64 | 272 | SCM_VALIDATE_STRING (1, str); |
a49af0c0 DH |
273 | |
274 | return string_copy (str); | |
0f2d19dd | 275 | } |
1bbd0b84 | 276 | #undef FUNC_NAME |
0f2d19dd JB |
277 | |
278 | ||
3b3b36dd | 279 | SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0, |
1bbd0b84 | 280 | (SCM str, SCM chr), |
1e6808ea MG |
281 | "Store @var{char} in every element of the given @var{string} and\n" |
282 | "return an unspecified value.") | |
1bbd0b84 | 283 | #define FUNC_NAME s_scm_string_fill_x |
0f2d19dd JB |
284 | { |
285 | register char *dst, c; | |
c014a02e | 286 | register long k; |
34d19ef6 HWN |
287 | SCM_VALIDATE_STRING_COPY (1, str, dst); |
288 | SCM_VALIDATE_CHAR_COPY (2, chr, c); | |
bfa974f0 | 289 | for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; |
0f2d19dd JB |
290 | return SCM_UNSPECIFIED; |
291 | } | |
1bbd0b84 | 292 | #undef FUNC_NAME |
0f2d19dd | 293 | |
a49af0c0 | 294 | |
5ad8ab0a | 295 | /* Helper function for the string uppercase conversion functions. |
a49af0c0 DH |
296 | * No argument checking is performed. */ |
297 | static SCM | |
298 | string_upcase_x (SCM v) | |
299 | { | |
c014a02e | 300 | unsigned long k; |
a49af0c0 DH |
301 | |
302 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) | |
84fad130 | 303 | SCM_STRING_UCHARS (v) [k] = scm_c_upcase (SCM_STRING_UCHARS (v) [k]); |
a49af0c0 DH |
304 | |
305 | return v; | |
306 | } | |
307 | ||
308 | ||
5ad8ab0a | 309 | SCM_DEFINE (scm_string_upcase_x, "string-upcase!", 1, 0, 0, |
a49af0c0 | 310 | (SCM str), |
91344ceb MG |
311 | "Destructively upcase every character in @var{str} and return\n" |
312 | "@var{str}.\n" | |
313 | "@lisp\n" | |
314 | "y @result{} \"arrdefg\"\n" | |
315 | "(string-upcase! y) @result{} \"ARRDEFG\"\n" | |
316 | "y @result{} \"ARRDEFG\"\n" | |
317 | "@end lisp") | |
1bbd0b84 | 318 | #define FUNC_NAME s_scm_string_upcase_x |
c101e39e | 319 | { |
a49af0c0 | 320 | SCM_VALIDATE_STRING (1, str); |
322ac0c5 | 321 | |
a49af0c0 | 322 | return string_upcase_x (str); |
c101e39e | 323 | } |
1bbd0b84 | 324 | #undef FUNC_NAME |
c101e39e | 325 | |
a49af0c0 | 326 | |
5ad8ab0a | 327 | SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0, |
a49af0c0 | 328 | (SCM str), |
91344ceb MG |
329 | "Return a freshly allocated string containing the characters of\n" |
330 | "@var{str} in upper case.") | |
1bbd0b84 | 331 | #define FUNC_NAME s_scm_string_upcase |
99a9952d | 332 | { |
a49af0c0 DH |
333 | SCM_VALIDATE_STRING (1, str); |
334 | ||
335 | return string_upcase_x (string_copy (str)); | |
99a9952d | 336 | } |
1bbd0b84 | 337 | #undef FUNC_NAME |
99a9952d | 338 | |
a49af0c0 | 339 | |
5ad8ab0a | 340 | /* Helper function for the string lowercase conversion functions. |
a49af0c0 DH |
341 | * No argument checking is performed. */ |
342 | static SCM | |
343 | string_downcase_x (SCM v) | |
344 | { | |
c014a02e | 345 | unsigned long k; |
a49af0c0 DH |
346 | |
347 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) | |
84fad130 | 348 | SCM_STRING_UCHARS (v) [k] = scm_c_downcase (SCM_STRING_UCHARS (v) [k]); |
a49af0c0 DH |
349 | |
350 | return v; | |
351 | } | |
352 | ||
353 | ||
5ad8ab0a | 354 | SCM_DEFINE (scm_string_downcase_x, "string-downcase!", 1, 0, 0, |
a49af0c0 | 355 | (SCM str), |
91344ceb MG |
356 | "Destructively downcase every character in @var{str} and return\n" |
357 | "@var{str}.\n" | |
358 | "@lisp\n" | |
359 | "y @result{} \"ARRDEFG\"\n" | |
360 | "(string-downcase! y) @result{} \"arrdefg\"\n" | |
361 | "y @result{} \"arrdefg\"\n" | |
362 | "@end lisp") | |
1bbd0b84 | 363 | #define FUNC_NAME s_scm_string_downcase_x |
c101e39e | 364 | { |
a49af0c0 | 365 | SCM_VALIDATE_STRING (1, str); |
322ac0c5 | 366 | |
a49af0c0 | 367 | return string_downcase_x (str); |
c101e39e | 368 | } |
1bbd0b84 | 369 | #undef FUNC_NAME |
0f2d19dd | 370 | |
a49af0c0 | 371 | |
5ad8ab0a | 372 | SCM_DEFINE (scm_string_downcase, "string-downcase", 1, 0, 0, |
a49af0c0 | 373 | (SCM str), |
91344ceb MG |
374 | "Return a freshly allocation string containing the characters in\n" |
375 | "@var{str} in lower case.") | |
1bbd0b84 | 376 | #define FUNC_NAME s_scm_string_downcase |
99a9952d | 377 | { |
a49af0c0 DH |
378 | SCM_VALIDATE_STRING (1, str); |
379 | ||
380 | return string_downcase_x (string_copy (str)); | |
99a9952d | 381 | } |
1bbd0b84 | 382 | #undef FUNC_NAME |
99a9952d | 383 | |
a49af0c0 | 384 | |
5ad8ab0a | 385 | /* Helper function for the string capitalization functions. |
a49af0c0 DH |
386 | * No argument checking is performed. */ |
387 | static SCM | |
388 | string_capitalize_x (SCM str) | |
99a9952d | 389 | { |
ff0a837c | 390 | unsigned char *sz; |
c014a02e | 391 | long i, len; |
1be6b49c | 392 | int in_word=0; |
a49af0c0 | 393 | |
bfa974f0 | 394 | len = SCM_STRING_LENGTH(str); |
ff0a837c | 395 | sz = SCM_STRING_UCHARS (str); |
99a9952d | 396 | for(i=0; i<len; i++) { |
7888309b | 397 | if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) { |
99a9952d | 398 | if(!in_word) { |
84fad130 | 399 | sz[i] = scm_c_upcase(sz[i]); |
99a9952d JB |
400 | in_word = 1; |
401 | } else { | |
84fad130 | 402 | sz[i] = scm_c_downcase(sz[i]); |
99a9952d JB |
403 | } |
404 | } | |
405 | else in_word = 0; | |
406 | } | |
6552dbf7 | 407 | return str; |
99a9952d | 408 | } |
a49af0c0 DH |
409 | |
410 | ||
5ad8ab0a | 411 | SCM_DEFINE (scm_string_capitalize_x, "string-capitalize!", 1, 0, 0, |
a49af0c0 | 412 | (SCM str), |
91344ceb MG |
413 | "Upcase the first character of every word in @var{str}\n" |
414 | "destructively and return @var{str}.\n" | |
415 | "\n" | |
416 | "@lisp\n" | |
dd85ce47 ML |
417 | "y @result{} \"hello world\"\n" |
418 | "(string-capitalize! y) @result{} \"Hello World\"\n" | |
419 | "y @result{} \"Hello World\"\n" | |
91344ceb | 420 | "@end lisp") |
a49af0c0 DH |
421 | #define FUNC_NAME s_scm_string_capitalize_x |
422 | { | |
423 | SCM_VALIDATE_STRING (1, str); | |
424 | ||
425 | return string_capitalize_x (str); | |
426 | } | |
1bbd0b84 | 427 | #undef FUNC_NAME |
99a9952d | 428 | |
a49af0c0 | 429 | |
5ad8ab0a | 430 | SCM_DEFINE (scm_string_capitalize, "string-capitalize", 1, 0, 0, |
a49af0c0 | 431 | (SCM str), |
91344ceb MG |
432 | "Return a freshly allocated string with the characters in\n" |
433 | "@var{str}, where the first character of every word is\n" | |
434 | "capitalized.") | |
1bbd0b84 | 435 | #define FUNC_NAME s_scm_string_capitalize |
99a9952d | 436 | { |
a49af0c0 DH |
437 | SCM_VALIDATE_STRING (1, str); |
438 | ||
439 | return string_capitalize_x (string_copy (str)); | |
99a9952d | 440 | } |
1bbd0b84 | 441 | #undef FUNC_NAME |
99a9952d | 442 | |
a49af0c0 | 443 | |
5ad8ab0a | 444 | SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0, |
dd2a6f3a MG |
445 | (SCM str, SCM chr), |
446 | "Split the string @var{str} into the a list of the substrings delimited\n" | |
447 | "by appearances of the character @var{chr}. Note that an empty substring\n" | |
448 | "between separator characters will result in an empty string in the\n" | |
449 | "result list.\n" | |
450 | "\n" | |
451 | "@lisp\n" | |
8f85c0c6 | 452 | "(string-split \"root:x:0:0:root:/root:/bin/bash\" #\\:)\n" |
dd2a6f3a MG |
453 | "@result{}\n" |
454 | "(\"root\" \"x\" \"0\" \"0\" \"root\" \"/root\" \"/bin/bash\")\n" | |
455 | "\n" | |
8f85c0c6 | 456 | "(string-split \"::\" #\\:)\n" |
dd2a6f3a MG |
457 | "@result{}\n" |
458 | "(\"\" \"\" \"\")\n" | |
459 | "\n" | |
8f85c0c6 | 460 | "(string-split \"\" #\\:)\n" |
dd2a6f3a MG |
461 | "@result{}\n" |
462 | "(\"\")\n" | |
463 | "@end lisp") | |
464 | #define FUNC_NAME s_scm_string_split | |
465 | { | |
c014a02e | 466 | long idx, last_idx; |
dd2a6f3a MG |
467 | char * p; |
468 | int ch; | |
469 | SCM res = SCM_EOL; | |
470 | ||
471 | SCM_VALIDATE_STRING (1, str); | |
472 | SCM_VALIDATE_CHAR (2, chr); | |
473 | ||
474 | idx = SCM_STRING_LENGTH (str); | |
475 | p = SCM_STRING_CHARS (str); | |
476 | ch = SCM_CHAR (chr); | |
477 | while (idx >= 0) | |
478 | { | |
479 | last_idx = idx; | |
480 | while (idx > 0 && p[idx - 1] != ch) | |
481 | idx--; | |
482 | if (idx >= 0) | |
483 | { | |
36284627 | 484 | res = scm_cons (scm_mem2string (p + idx, last_idx - idx), res); |
dd2a6f3a MG |
485 | idx--; |
486 | } | |
487 | } | |
36284627 | 488 | scm_remember_upto_here_1 (str); |
dd2a6f3a MG |
489 | return res; |
490 | } | |
491 | #undef FUNC_NAME | |
492 | ||
493 | ||
5ad8ab0a | 494 | SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, |
91344ceb MG |
495 | (SCM str), |
496 | "Return the symbol whose name is @var{str}. @var{str} is\n" | |
497 | "converted to lowercase before the conversion is done, if Guile\n" | |
8f85c0c6 | 498 | "is currently reading symbols case-insensitively.") |
1bbd0b84 | 499 | #define FUNC_NAME s_scm_string_ci_to_symbol |
99a9952d JB |
500 | { |
501 | return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P | |
502 | ? scm_string_downcase(str) | |
503 | : str); | |
504 | } | |
1bbd0b84 | 505 | #undef FUNC_NAME |
1cc91f1b | 506 | |
0f2d19dd JB |
507 | void |
508 | scm_init_strop () | |
0f2d19dd | 509 | { |
a0599745 | 510 | #include "libguile/strop.x" |
0f2d19dd | 511 | } |
89e00824 ML |
512 | |
513 | /* | |
514 | Local Variables: | |
515 | c-file-style: "gnu" | |
516 | End: | |
517 | */ |