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