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 | { |
a55c2b68 | 168 | unsigned long s1, s2, e, len; |
99a9952d | 169 | |
34d19ef6 | 170 | SCM_VALIDATE_STRING (1, str1); |
34d19ef6 | 171 | SCM_VALIDATE_STRING (4, str2); |
a55c2b68 MV |
172 | s1 = scm_to_unsigned_integer (start1, 0, SCM_STRING_LENGTH(str1)); |
173 | e = scm_to_unsigned_integer (end1, s1, SCM_STRING_LENGTH(str1)); | |
99a9952d | 174 | len = e - s1; |
a55c2b68 | 175 | s2 = scm_to_unsigned_integer (start2, 0, SCM_STRING_LENGTH(str2)-len); |
0f2d19dd | 176 | |
86c991c2 DH |
177 | SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), |
178 | (void *)(&(SCM_STRING_CHARS(str1)[s1])), | |
99a9952d | 179 | len)); |
5ad8ab0a | 180 | |
b1349e46 | 181 | return scm_return_first(SCM_UNSPECIFIED, str1, str2); |
0f2d19dd | 182 | } |
1bbd0b84 | 183 | #undef FUNC_NAME |
0f2d19dd JB |
184 | |
185 | ||
5ad8ab0a | 186 | SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0, |
1bbd0b84 | 187 | (SCM str, SCM start, SCM end, SCM fill), |
1e6808ea MG |
188 | "Change every character in @var{str} between @var{start} and\n" |
189 | "@var{end} to @var{fill}.\n" | |
190 | "\n" | |
191 | "@lisp\n" | |
6552dbf7 | 192 | "(define y \"abcdefg\")\n" |
1670bef9 | 193 | "(substring-fill! y 1 3 #\\r)\n" |
6552dbf7 GB |
194 | "y\n" |
195 | "@result{} \"arrdefg\"\n" | |
1e6808ea | 196 | "@end lisp") |
1bbd0b84 | 197 | #define FUNC_NAME s_scm_substring_fill_x |
0f2d19dd | 198 | { |
a55c2b68 | 199 | size_t i, e; |
0f2d19dd | 200 | char c; |
34d19ef6 | 201 | SCM_VALIDATE_STRING (1, str); |
a55c2b68 MV |
202 | i = scm_to_unsigned_integer (start, 0, SCM_STRING_LENGTH (str)); |
203 | e = scm_to_unsigned_integer (end, i, SCM_STRING_LENGTH (str)); | |
34d19ef6 | 204 | SCM_VALIDATE_CHAR_COPY (4, fill, c); |
86c991c2 | 205 | while (i<e) SCM_STRING_CHARS (str)[i++] = c; |
0f2d19dd JB |
206 | return SCM_UNSPECIFIED; |
207 | } | |
1bbd0b84 | 208 | #undef FUNC_NAME |
0f2d19dd JB |
209 | |
210 | ||
5ad8ab0a | 211 | SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, |
1bbd0b84 | 212 | (SCM str), |
9c4c86c6 | 213 | "Return @code{#t} if @var{str}'s length is zero, and\n" |
1e6808ea MG |
214 | "@code{#f} otherwise.\n" |
215 | "@lisp\n" | |
216 | "(string-null? \"\") @result{} #t\n" | |
217 | "y @result{} \"foo\"\n" | |
218 | "(string-null? y) @result{} #f\n" | |
219 | "@end lisp") | |
1bbd0b84 | 220 | #define FUNC_NAME s_scm_string_null_p |
0f2d19dd | 221 | { |
34d19ef6 | 222 | SCM_VALIDATE_STRING (1, str); |
7888309b | 223 | return scm_from_bool (SCM_STRING_LENGTH (str) == 0); |
0f2d19dd | 224 | } |
1bbd0b84 | 225 | #undef FUNC_NAME |
0f2d19dd JB |
226 | |
227 | ||
5ad8ab0a | 228 | SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, |
1bbd0b84 | 229 | (SCM str), |
91344ceb MG |
230 | "Return a newly allocated list of the characters that make up\n" |
231 | "the given string @var{str}. @code{string->list} and\n" | |
232 | "@code{list->string} are inverses as far as @samp{equal?} is\n" | |
233 | "concerned.") | |
1bbd0b84 | 234 | #define FUNC_NAME s_scm_string_to_list |
0f2d19dd | 235 | { |
c014a02e | 236 | long i; |
0f2d19dd JB |
237 | SCM res = SCM_EOL; |
238 | unsigned char *src; | |
34d19ef6 | 239 | SCM_VALIDATE_STRING (1, str); |
34f0f2b8 | 240 | src = SCM_STRING_UCHARS (str); |
a6d9e5ab | 241 | for (i = SCM_STRING_LENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res); |
0f2d19dd JB |
242 | return res; |
243 | } | |
1bbd0b84 | 244 | #undef FUNC_NAME |
0f2d19dd JB |
245 | |
246 | ||
a49af0c0 DH |
247 | /* Helper function for the string copy and string conversion functions. |
248 | * No argument checking is performed. */ | |
249 | static SCM | |
250 | string_copy (SCM str) | |
251 | { | |
36284627 DH |
252 | const char* chars = SCM_STRING_CHARS (str); |
253 | size_t length = SCM_STRING_LENGTH (str); | |
254 | SCM new_string = scm_mem2string (chars, length); | |
255 | scm_remember_upto_here_1 (str); | |
256 | return new_string; | |
a49af0c0 DH |
257 | } |
258 | ||
0f2d19dd | 259 | |
5ad8ab0a | 260 | SCM_DEFINE (scm_string_copy, "string-copy", 1, 0, 0, |
a49af0c0 | 261 | (SCM str), |
1e6808ea | 262 | "Return a newly allocated copy of the given @var{string}.") |
1bbd0b84 | 263 | #define FUNC_NAME s_scm_string_copy |
0f2d19dd | 264 | { |
d1ca2c64 | 265 | SCM_VALIDATE_STRING (1, str); |
a49af0c0 DH |
266 | |
267 | return string_copy (str); | |
0f2d19dd | 268 | } |
1bbd0b84 | 269 | #undef FUNC_NAME |
0f2d19dd JB |
270 | |
271 | ||
3b3b36dd | 272 | SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0, |
1bbd0b84 | 273 | (SCM str, SCM chr), |
1e6808ea MG |
274 | "Store @var{char} in every element of the given @var{string} and\n" |
275 | "return an unspecified value.") | |
1bbd0b84 | 276 | #define FUNC_NAME s_scm_string_fill_x |
0f2d19dd JB |
277 | { |
278 | register char *dst, c; | |
c014a02e | 279 | register long k; |
34d19ef6 HWN |
280 | SCM_VALIDATE_STRING_COPY (1, str, dst); |
281 | SCM_VALIDATE_CHAR_COPY (2, chr, c); | |
bfa974f0 | 282 | for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; |
0f2d19dd JB |
283 | return SCM_UNSPECIFIED; |
284 | } | |
1bbd0b84 | 285 | #undef FUNC_NAME |
0f2d19dd | 286 | |
a49af0c0 | 287 | |
5ad8ab0a | 288 | /* Helper function for the string uppercase conversion functions. |
a49af0c0 DH |
289 | * No argument checking is performed. */ |
290 | static SCM | |
291 | string_upcase_x (SCM v) | |
292 | { | |
c014a02e | 293 | unsigned long k; |
a49af0c0 DH |
294 | |
295 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) | |
84fad130 | 296 | SCM_STRING_UCHARS (v) [k] = scm_c_upcase (SCM_STRING_UCHARS (v) [k]); |
a49af0c0 DH |
297 | |
298 | return v; | |
299 | } | |
300 | ||
301 | ||
5ad8ab0a | 302 | SCM_DEFINE (scm_string_upcase_x, "string-upcase!", 1, 0, 0, |
a49af0c0 | 303 | (SCM str), |
91344ceb MG |
304 | "Destructively upcase every character in @var{str} and return\n" |
305 | "@var{str}.\n" | |
306 | "@lisp\n" | |
307 | "y @result{} \"arrdefg\"\n" | |
308 | "(string-upcase! y) @result{} \"ARRDEFG\"\n" | |
309 | "y @result{} \"ARRDEFG\"\n" | |
310 | "@end lisp") | |
1bbd0b84 | 311 | #define FUNC_NAME s_scm_string_upcase_x |
c101e39e | 312 | { |
a49af0c0 | 313 | SCM_VALIDATE_STRING (1, str); |
322ac0c5 | 314 | |
a49af0c0 | 315 | return string_upcase_x (str); |
c101e39e | 316 | } |
1bbd0b84 | 317 | #undef FUNC_NAME |
c101e39e | 318 | |
a49af0c0 | 319 | |
5ad8ab0a | 320 | SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0, |
a49af0c0 | 321 | (SCM str), |
91344ceb MG |
322 | "Return a freshly allocated string containing the characters of\n" |
323 | "@var{str} in upper case.") | |
1bbd0b84 | 324 | #define FUNC_NAME s_scm_string_upcase |
99a9952d | 325 | { |
a49af0c0 DH |
326 | SCM_VALIDATE_STRING (1, str); |
327 | ||
328 | return string_upcase_x (string_copy (str)); | |
99a9952d | 329 | } |
1bbd0b84 | 330 | #undef FUNC_NAME |
99a9952d | 331 | |
a49af0c0 | 332 | |
5ad8ab0a | 333 | /* Helper function for the string lowercase conversion functions. |
a49af0c0 DH |
334 | * No argument checking is performed. */ |
335 | static SCM | |
336 | string_downcase_x (SCM v) | |
337 | { | |
c014a02e | 338 | unsigned long k; |
a49af0c0 DH |
339 | |
340 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) | |
84fad130 | 341 | SCM_STRING_UCHARS (v) [k] = scm_c_downcase (SCM_STRING_UCHARS (v) [k]); |
a49af0c0 DH |
342 | |
343 | return v; | |
344 | } | |
345 | ||
346 | ||
5ad8ab0a | 347 | SCM_DEFINE (scm_string_downcase_x, "string-downcase!", 1, 0, 0, |
a49af0c0 | 348 | (SCM str), |
91344ceb MG |
349 | "Destructively downcase every character in @var{str} and return\n" |
350 | "@var{str}.\n" | |
351 | "@lisp\n" | |
352 | "y @result{} \"ARRDEFG\"\n" | |
353 | "(string-downcase! y) @result{} \"arrdefg\"\n" | |
354 | "y @result{} \"arrdefg\"\n" | |
355 | "@end lisp") | |
1bbd0b84 | 356 | #define FUNC_NAME s_scm_string_downcase_x |
c101e39e | 357 | { |
a49af0c0 | 358 | SCM_VALIDATE_STRING (1, str); |
322ac0c5 | 359 | |
a49af0c0 | 360 | return string_downcase_x (str); |
c101e39e | 361 | } |
1bbd0b84 | 362 | #undef FUNC_NAME |
0f2d19dd | 363 | |
a49af0c0 | 364 | |
5ad8ab0a | 365 | SCM_DEFINE (scm_string_downcase, "string-downcase", 1, 0, 0, |
a49af0c0 | 366 | (SCM str), |
91344ceb MG |
367 | "Return a freshly allocation string containing the characters in\n" |
368 | "@var{str} in lower case.") | |
1bbd0b84 | 369 | #define FUNC_NAME s_scm_string_downcase |
99a9952d | 370 | { |
a49af0c0 DH |
371 | SCM_VALIDATE_STRING (1, str); |
372 | ||
373 | return string_downcase_x (string_copy (str)); | |
99a9952d | 374 | } |
1bbd0b84 | 375 | #undef FUNC_NAME |
99a9952d | 376 | |
a49af0c0 | 377 | |
5ad8ab0a | 378 | /* Helper function for the string capitalization functions. |
a49af0c0 DH |
379 | * No argument checking is performed. */ |
380 | static SCM | |
381 | string_capitalize_x (SCM str) | |
99a9952d | 382 | { |
ff0a837c | 383 | unsigned char *sz; |
c014a02e | 384 | long i, len; |
1be6b49c | 385 | int in_word=0; |
a49af0c0 | 386 | |
bfa974f0 | 387 | len = SCM_STRING_LENGTH(str); |
ff0a837c | 388 | sz = SCM_STRING_UCHARS (str); |
99a9952d | 389 | for(i=0; i<len; i++) { |
7888309b | 390 | if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) { |
99a9952d | 391 | if(!in_word) { |
84fad130 | 392 | sz[i] = scm_c_upcase(sz[i]); |
99a9952d JB |
393 | in_word = 1; |
394 | } else { | |
84fad130 | 395 | sz[i] = scm_c_downcase(sz[i]); |
99a9952d JB |
396 | } |
397 | } | |
398 | else in_word = 0; | |
399 | } | |
6552dbf7 | 400 | return str; |
99a9952d | 401 | } |
a49af0c0 DH |
402 | |
403 | ||
5ad8ab0a | 404 | SCM_DEFINE (scm_string_capitalize_x, "string-capitalize!", 1, 0, 0, |
a49af0c0 | 405 | (SCM str), |
91344ceb MG |
406 | "Upcase the first character of every word in @var{str}\n" |
407 | "destructively and return @var{str}.\n" | |
408 | "\n" | |
409 | "@lisp\n" | |
dd85ce47 ML |
410 | "y @result{} \"hello world\"\n" |
411 | "(string-capitalize! y) @result{} \"Hello World\"\n" | |
412 | "y @result{} \"Hello World\"\n" | |
91344ceb | 413 | "@end lisp") |
a49af0c0 DH |
414 | #define FUNC_NAME s_scm_string_capitalize_x |
415 | { | |
416 | SCM_VALIDATE_STRING (1, str); | |
417 | ||
418 | return string_capitalize_x (str); | |
419 | } | |
1bbd0b84 | 420 | #undef FUNC_NAME |
99a9952d | 421 | |
a49af0c0 | 422 | |
5ad8ab0a | 423 | SCM_DEFINE (scm_string_capitalize, "string-capitalize", 1, 0, 0, |
a49af0c0 | 424 | (SCM str), |
91344ceb MG |
425 | "Return a freshly allocated string with the characters in\n" |
426 | "@var{str}, where the first character of every word is\n" | |
427 | "capitalized.") | |
1bbd0b84 | 428 | #define FUNC_NAME s_scm_string_capitalize |
99a9952d | 429 | { |
a49af0c0 DH |
430 | SCM_VALIDATE_STRING (1, str); |
431 | ||
432 | return string_capitalize_x (string_copy (str)); | |
99a9952d | 433 | } |
1bbd0b84 | 434 | #undef FUNC_NAME |
99a9952d | 435 | |
a49af0c0 | 436 | |
5ad8ab0a | 437 | SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0, |
dd2a6f3a MG |
438 | (SCM str, SCM chr), |
439 | "Split the string @var{str} into the a list of the substrings delimited\n" | |
440 | "by appearances of the character @var{chr}. Note that an empty substring\n" | |
441 | "between separator characters will result in an empty string in the\n" | |
442 | "result list.\n" | |
443 | "\n" | |
444 | "@lisp\n" | |
8f85c0c6 | 445 | "(string-split \"root:x:0:0:root:/root:/bin/bash\" #\\:)\n" |
dd2a6f3a MG |
446 | "@result{}\n" |
447 | "(\"root\" \"x\" \"0\" \"0\" \"root\" \"/root\" \"/bin/bash\")\n" | |
448 | "\n" | |
8f85c0c6 | 449 | "(string-split \"::\" #\\:)\n" |
dd2a6f3a MG |
450 | "@result{}\n" |
451 | "(\"\" \"\" \"\")\n" | |
452 | "\n" | |
8f85c0c6 | 453 | "(string-split \"\" #\\:)\n" |
dd2a6f3a MG |
454 | "@result{}\n" |
455 | "(\"\")\n" | |
456 | "@end lisp") | |
457 | #define FUNC_NAME s_scm_string_split | |
458 | { | |
c014a02e | 459 | long idx, last_idx; |
dd2a6f3a MG |
460 | char * p; |
461 | int ch; | |
462 | SCM res = SCM_EOL; | |
463 | ||
464 | SCM_VALIDATE_STRING (1, str); | |
465 | SCM_VALIDATE_CHAR (2, chr); | |
466 | ||
467 | idx = SCM_STRING_LENGTH (str); | |
468 | p = SCM_STRING_CHARS (str); | |
469 | ch = SCM_CHAR (chr); | |
470 | while (idx >= 0) | |
471 | { | |
472 | last_idx = idx; | |
473 | while (idx > 0 && p[idx - 1] != ch) | |
474 | idx--; | |
475 | if (idx >= 0) | |
476 | { | |
36284627 | 477 | res = scm_cons (scm_mem2string (p + idx, last_idx - idx), res); |
dd2a6f3a MG |
478 | idx--; |
479 | } | |
480 | } | |
36284627 | 481 | scm_remember_upto_here_1 (str); |
dd2a6f3a MG |
482 | return res; |
483 | } | |
484 | #undef FUNC_NAME | |
485 | ||
486 | ||
5ad8ab0a | 487 | SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, |
91344ceb MG |
488 | (SCM str), |
489 | "Return the symbol whose name is @var{str}. @var{str} is\n" | |
490 | "converted to lowercase before the conversion is done, if Guile\n" | |
8f85c0c6 | 491 | "is currently reading symbols case-insensitively.") |
1bbd0b84 | 492 | #define FUNC_NAME s_scm_string_ci_to_symbol |
99a9952d JB |
493 | { |
494 | return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P | |
495 | ? scm_string_downcase(str) | |
496 | : str); | |
497 | } | |
1bbd0b84 | 498 | #undef FUNC_NAME |
1cc91f1b | 499 | |
0f2d19dd JB |
500 | void |
501 | scm_init_strop () | |
0f2d19dd | 502 | { |
a0599745 | 503 | #include "libguile/strop.x" |
0f2d19dd | 504 | } |
89e00824 ML |
505 | |
506 | /* | |
507 | Local Variables: | |
508 | c-file-style: "gnu" | |
509 | End: | |
510 | */ |