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 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 | |
c22adbeb MV |
18 | 02111-1307 USA |
19 | ||
20 | As a special exception, the Free Software Foundation gives permission | |
21 | for additional uses of the text contained in its release of GUILE. | |
22 | ||
23 | The exception is that, if you link the GUILE library with other files | |
24 | to produce an executable, this does not by itself cause the | |
25 | resulting executable to be covered by the GNU General Public License. | |
26 | Your use of that executable is in no way restricted on account of | |
27 | linking the GUILE library code into it. | |
28 | ||
29 | This exception does not however invalidate any other reasons why | |
30 | the executable file might be covered by the GNU General Public License. | |
31 | ||
32 | This exception applies only to the code released by the | |
33 | Free Software Foundation under the name GUILE. If you copy | |
34 | code from other Free Software Foundation releases into a copy of | |
35 | GUILE, as the General Public License permits, the exception does | |
36 | not apply to the code that you add in this way. To avoid misleading | |
37 | anyone as to the status of such modified files, you must delete | |
38 | this exception notice from them. | |
39 | ||
40 | If you write modifications of your own for GUILE, it is your choice | |
41 | whether to permit this exception to apply to your modifications. | |
42 | If you do not wish that, delete this exception notice. */ | |
0f2d19dd | 43 | |
1bbd0b84 GB |
44 | |
45 | ||
0f2d19dd JB |
46 | \f |
47 | ||
e6e2e95a MD |
48 | #include <errno.h> |
49 | ||
a0599745 MD |
50 | #include "libguile/_scm.h" |
51 | #include "libguile/chars.h" | |
52 | #include "libguile/strings.h" | |
0f2d19dd | 53 | |
a0599745 MD |
54 | #include "libguile/validate.h" |
55 | #include "libguile/strop.h" | |
56 | #include "libguile/read.h" /*For SCM_CASE_INSENSITIVE_P*/ | |
bd9e24b3 GH |
57 | |
58 | #ifdef HAVE_STRING_H | |
59 | #include <string.h> | |
60 | #endif | |
61 | ||
0f2d19dd JB |
62 | \f |
63 | ||
6552dbf7 | 64 | /* |
5ad8ab0a | 65 | xSCM_DEFINE (scm_i_index, "i-index", 2, 2, 0, |
6552dbf7 | 66 | (SCM str, SCM chr, SCM frm, SCM to), |
9401323e | 67 | "@deftypefn {Internal C Function} {static int} scm_i_index (SCM *@var{str},\n" |
6552dbf7 GB |
68 | "SCM @var{chr}, int @var{direction}, SCM @var{sub_start}, SCM @var{sub_end}, char *@var{why}) |
69 | "This is a workhorse function that performs either an @code{index} or\n" | |
2b7b76d5 | 70 | "@code{rindex} function, depending on the value of @var{direction}." |
6552dbf7 | 71 | */ |
03bc4386 | 72 | /* implements index if direction > 0 otherwise rindex. */ |
c014a02e | 73 | static long |
5ad8ab0a | 74 | scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, |
99a9952d | 75 | SCM sub_end, const char *why) |
0f2d19dd JB |
76 | { |
77 | unsigned char * p; | |
c014a02e ML |
78 | long x; |
79 | long lower; | |
80 | long upper; | |
0f2d19dd JB |
81 | int ch; |
82 | ||
a6d9e5ab | 83 | SCM_ASSERT (SCM_STRINGP (*str), *str, SCM_ARG1, why); |
7866a09b | 84 | SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); |
0f2d19dd | 85 | |
54778cd3 | 86 | if (SCM_FALSEP (sub_start)) |
0f2d19dd | 87 | sub_start = SCM_MAKINUM (0); |
03bc4386 | 88 | |
99a9952d | 89 | SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); |
03bc4386 | 90 | lower = SCM_INUM (sub_start); |
a6d9e5ab | 91 | if (lower < 0 || lower > SCM_STRING_LENGTH (*str)) |
03bc4386 | 92 | scm_out_of_range (why, sub_start); |
0f2d19dd | 93 | |
54778cd3 | 94 | if (SCM_FALSEP (sub_end)) |
a6d9e5ab | 95 | sub_end = SCM_MAKINUM (SCM_STRING_LENGTH (*str)); |
03bc4386 | 96 | |
99a9952d | 97 | SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); |
03bc4386 | 98 | upper = SCM_INUM (sub_end); |
a6d9e5ab | 99 | if (upper < SCM_INUM (sub_start) || upper > SCM_STRING_LENGTH (*str)) |
03bc4386 GH |
100 | scm_out_of_range (why, sub_end); |
101 | ||
102 | if (direction > 0) | |
103 | { | |
34f0f2b8 | 104 | p = SCM_STRING_UCHARS (*str) + lower; |
7866a09b | 105 | ch = SCM_CHAR (chr); |
03bc4386 GH |
106 | |
107 | for (x = SCM_INUM (sub_start); x < upper; ++x, ++p) | |
108 | if (*p == ch) | |
109 | return x; | |
110 | } | |
0f2d19dd | 111 | else |
03bc4386 | 112 | { |
34f0f2b8 | 113 | p = upper - 1 + SCM_STRING_UCHARS (*str); |
7866a09b | 114 | ch = SCM_CHAR (chr); |
03bc4386 GH |
115 | for (x = upper - 1; x >= lower; --x, --p) |
116 | if (*p == ch) | |
117 | return x; | |
118 | } | |
0f2d19dd JB |
119 | |
120 | return -1; | |
121 | } | |
122 | ||
5ad8ab0a | 123 | SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0, |
1bbd0b84 | 124 | (SCM str, SCM chr, SCM frm, SCM to), |
5352393c MG |
125 | "Return the index of the first occurrence of @var{chr} in\n" |
126 | "@var{str}. The optional integer arguments @var{frm} and\n" | |
127 | "@var{to} limit the search to a portion of the string. This\n" | |
128 | "procedure essentially implements the @code{index} or\n" | |
1e6808ea MG |
129 | "@code{strchr} functions from the C library.\n" |
130 | "\n" | |
131 | "@lisp\n" | |
1670bef9 | 132 | "(string-index \"weiner\" #\\e)\n" |
6552dbf7 | 133 | "@result{} 1\n\n" |
1670bef9 | 134 | "(string-index \"weiner\" #\\e 2)\n" |
6552dbf7 | 135 | "@result{} 4\n\n" |
1670bef9 | 136 | "(string-index \"weiner\" #\\e 2 4)\n" |
6552dbf7 | 137 | "@result{} #f\n" |
1e6808ea | 138 | "@end lisp") |
1bbd0b84 | 139 | #define FUNC_NAME s_scm_string_index |
0f2d19dd | 140 | { |
c014a02e | 141 | long pos; |
5ad8ab0a | 142 | |
54778cd3 | 143 | if (SCM_UNBNDP (frm)) |
0f2d19dd | 144 | frm = SCM_BOOL_F; |
54778cd3 | 145 | if (SCM_UNBNDP (to)) |
0f2d19dd | 146 | to = SCM_BOOL_F; |
1bbd0b84 | 147 | pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME); |
0f2d19dd JB |
148 | return (pos < 0 |
149 | ? SCM_BOOL_F | |
150 | : SCM_MAKINUM (pos)); | |
151 | } | |
1bbd0b84 | 152 | #undef FUNC_NAME |
0f2d19dd | 153 | |
5ad8ab0a | 154 | SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0, |
1bbd0b84 | 155 | (SCM str, SCM chr, SCM frm, SCM to), |
1e6808ea MG |
156 | "Like @code{string-index}, but search from the right of the\n" |
157 | "string rather than from the left. This procedure essentially\n" | |
158 | "implements the @code{rindex} or @code{strrchr} functions from\n" | |
159 | "the C library.\n" | |
160 | "\n" | |
161 | "@lisp\n" | |
1670bef9 | 162 | "(string-rindex \"weiner\" #\\e)\n" |
6552dbf7 | 163 | "@result{} 4\n\n" |
1670bef9 | 164 | "(string-rindex \"weiner\" #\\e 2 4)\n" |
6552dbf7 | 165 | "@result{} #f\n\n" |
1670bef9 | 166 | "(string-rindex \"weiner\" #\\e 2 5)\n" |
6552dbf7 | 167 | "@result{} 4\n" |
1e6808ea | 168 | "@end lisp") |
1bbd0b84 | 169 | #define FUNC_NAME s_scm_string_rindex |
0f2d19dd | 170 | { |
c014a02e | 171 | long pos; |
5ad8ab0a | 172 | |
54778cd3 | 173 | if (SCM_UNBNDP (frm)) |
0f2d19dd | 174 | frm = SCM_BOOL_F; |
54778cd3 | 175 | if (SCM_UNBNDP (to)) |
0f2d19dd | 176 | to = SCM_BOOL_F; |
1bbd0b84 | 177 | pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME); |
0f2d19dd JB |
178 | return (pos < 0 |
179 | ? SCM_BOOL_F | |
180 | : SCM_MAKINUM (pos)); | |
181 | } | |
1bbd0b84 GB |
182 | #undef FUNC_NAME |
183 | ||
5ad8ab0a | 184 | SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, |
1bbd0b84 | 185 | (SCM str1, SCM start1, SCM end1, SCM str2, SCM start2), |
b380b885 | 186 | "Copy the substring of @var{str1} bounded by @var{start1} and @var{end1}\n" |
5ad8ab0a | 187 | "into @var{str2} beginning at position @var{start2}.\n" |
0534158a | 188 | "@var{str1} and @var{str2} can be the same string.") |
1bbd0b84 | 189 | #define FUNC_NAME s_scm_substring_move_x |
0f2d19dd | 190 | { |
c014a02e | 191 | long s1, s2, e, len; |
99a9952d | 192 | |
34d19ef6 HWN |
193 | SCM_VALIDATE_STRING (1, str1); |
194 | SCM_VALIDATE_INUM_COPY (2, start1, s1); | |
195 | SCM_VALIDATE_INUM_COPY (3, end1, e); | |
196 | SCM_VALIDATE_STRING (4, str2); | |
197 | SCM_VALIDATE_INUM_COPY (5, start2, s2); | |
99a9952d | 198 | len = e - s1; |
34d19ef6 HWN |
199 | SCM_ASSERT_RANGE (3, end1, len >= 0); |
200 | SCM_ASSERT_RANGE (2, start1, s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0); | |
201 | SCM_ASSERT_RANGE (5, start2, s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0); | |
202 | SCM_ASSERT_RANGE (3, end1, e <= SCM_STRING_LENGTH (str1) && e >= 0); | |
203 | SCM_ASSERT_RANGE (5, start2, len+s2 <= SCM_STRING_LENGTH (str2)); | |
0f2d19dd | 204 | |
86c991c2 DH |
205 | SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), |
206 | (void *)(&(SCM_STRING_CHARS(str1)[s1])), | |
99a9952d | 207 | len)); |
5ad8ab0a | 208 | |
b1349e46 | 209 | return scm_return_first(SCM_UNSPECIFIED, str1, str2); |
0f2d19dd | 210 | } |
1bbd0b84 | 211 | #undef FUNC_NAME |
0f2d19dd JB |
212 | |
213 | ||
5ad8ab0a | 214 | SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0, |
1bbd0b84 | 215 | (SCM str, SCM start, SCM end, SCM fill), |
1e6808ea MG |
216 | "Change every character in @var{str} between @var{start} and\n" |
217 | "@var{end} to @var{fill}.\n" | |
218 | "\n" | |
219 | "@lisp\n" | |
6552dbf7 | 220 | "(define y \"abcdefg\")\n" |
1670bef9 | 221 | "(substring-fill! y 1 3 #\\r)\n" |
6552dbf7 GB |
222 | "y\n" |
223 | "@result{} \"arrdefg\"\n" | |
1e6808ea | 224 | "@end lisp") |
1bbd0b84 | 225 | #define FUNC_NAME s_scm_substring_fill_x |
0f2d19dd | 226 | { |
c014a02e | 227 | long i, e; |
0f2d19dd | 228 | char c; |
34d19ef6 HWN |
229 | SCM_VALIDATE_STRING (1, str); |
230 | SCM_VALIDATE_INUM_COPY (2, start, i); | |
231 | SCM_VALIDATE_INUM_COPY (3, end, e); | |
232 | SCM_VALIDATE_CHAR_COPY (4, fill, c); | |
233 | SCM_ASSERT_RANGE (2, start, i <= SCM_STRING_LENGTH (str) && i >= 0); | |
234 | SCM_ASSERT_RANGE (3, end, e <= SCM_STRING_LENGTH (str) && e >= 0); | |
86c991c2 | 235 | while (i<e) SCM_STRING_CHARS (str)[i++] = c; |
0f2d19dd JB |
236 | return SCM_UNSPECIFIED; |
237 | } | |
1bbd0b84 | 238 | #undef FUNC_NAME |
0f2d19dd JB |
239 | |
240 | ||
5ad8ab0a | 241 | SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, |
1bbd0b84 | 242 | (SCM str), |
9c4c86c6 | 243 | "Return @code{#t} if @var{str}'s length is zero, and\n" |
1e6808ea MG |
244 | "@code{#f} otherwise.\n" |
245 | "@lisp\n" | |
246 | "(string-null? \"\") @result{} #t\n" | |
247 | "y @result{} \"foo\"\n" | |
248 | "(string-null? y) @result{} #f\n" | |
249 | "@end lisp") | |
1bbd0b84 | 250 | #define FUNC_NAME s_scm_string_null_p |
0f2d19dd | 251 | { |
34d19ef6 | 252 | SCM_VALIDATE_STRING (1, str); |
36284627 | 253 | return SCM_BOOL (SCM_STRING_LENGTH (str) == 0); |
0f2d19dd | 254 | } |
1bbd0b84 | 255 | #undef FUNC_NAME |
0f2d19dd JB |
256 | |
257 | ||
5ad8ab0a | 258 | SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, |
1bbd0b84 | 259 | (SCM str), |
91344ceb MG |
260 | "Return a newly allocated list of the characters that make up\n" |
261 | "the given string @var{str}. @code{string->list} and\n" | |
262 | "@code{list->string} are inverses as far as @samp{equal?} is\n" | |
263 | "concerned.") | |
1bbd0b84 | 264 | #define FUNC_NAME s_scm_string_to_list |
0f2d19dd | 265 | { |
c014a02e | 266 | long i; |
0f2d19dd JB |
267 | SCM res = SCM_EOL; |
268 | unsigned char *src; | |
34d19ef6 | 269 | SCM_VALIDATE_STRING (1, str); |
34f0f2b8 | 270 | src = SCM_STRING_UCHARS (str); |
a6d9e5ab | 271 | for (i = SCM_STRING_LENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res); |
0f2d19dd JB |
272 | return res; |
273 | } | |
1bbd0b84 | 274 | #undef FUNC_NAME |
0f2d19dd JB |
275 | |
276 | ||
a49af0c0 DH |
277 | /* Helper function for the string copy and string conversion functions. |
278 | * No argument checking is performed. */ | |
279 | static SCM | |
280 | string_copy (SCM str) | |
281 | { | |
36284627 DH |
282 | const char* chars = SCM_STRING_CHARS (str); |
283 | size_t length = SCM_STRING_LENGTH (str); | |
284 | SCM new_string = scm_mem2string (chars, length); | |
285 | scm_remember_upto_here_1 (str); | |
286 | return new_string; | |
a49af0c0 DH |
287 | } |
288 | ||
0f2d19dd | 289 | |
5ad8ab0a | 290 | SCM_DEFINE (scm_string_copy, "string-copy", 1, 0, 0, |
a49af0c0 | 291 | (SCM str), |
1e6808ea | 292 | "Return a newly allocated copy of the given @var{string}.") |
1bbd0b84 | 293 | #define FUNC_NAME s_scm_string_copy |
0f2d19dd | 294 | { |
d1ca2c64 | 295 | SCM_VALIDATE_STRING (1, str); |
a49af0c0 DH |
296 | |
297 | return string_copy (str); | |
0f2d19dd | 298 | } |
1bbd0b84 | 299 | #undef FUNC_NAME |
0f2d19dd JB |
300 | |
301 | ||
3b3b36dd | 302 | SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0, |
1bbd0b84 | 303 | (SCM str, SCM chr), |
1e6808ea MG |
304 | "Store @var{char} in every element of the given @var{string} and\n" |
305 | "return an unspecified value.") | |
1bbd0b84 | 306 | #define FUNC_NAME s_scm_string_fill_x |
0f2d19dd JB |
307 | { |
308 | register char *dst, c; | |
c014a02e | 309 | register long k; |
34d19ef6 HWN |
310 | SCM_VALIDATE_STRING_COPY (1, str, dst); |
311 | SCM_VALIDATE_CHAR_COPY (2, chr, c); | |
bfa974f0 | 312 | for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; |
0f2d19dd JB |
313 | return SCM_UNSPECIFIED; |
314 | } | |
1bbd0b84 | 315 | #undef FUNC_NAME |
0f2d19dd | 316 | |
a49af0c0 | 317 | |
5ad8ab0a | 318 | /* Helper function for the string uppercase conversion functions. |
a49af0c0 DH |
319 | * No argument checking is performed. */ |
320 | static SCM | |
321 | string_upcase_x (SCM v) | |
322 | { | |
c014a02e | 323 | unsigned long k; |
a49af0c0 DH |
324 | |
325 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) | |
326 | SCM_STRING_UCHARS (v) [k] = scm_upcase (SCM_STRING_UCHARS (v) [k]); | |
327 | ||
328 | return v; | |
329 | } | |
330 | ||
331 | ||
5ad8ab0a | 332 | SCM_DEFINE (scm_string_upcase_x, "string-upcase!", 1, 0, 0, |
a49af0c0 | 333 | (SCM str), |
91344ceb MG |
334 | "Destructively upcase every character in @var{str} and return\n" |
335 | "@var{str}.\n" | |
336 | "@lisp\n" | |
337 | "y @result{} \"arrdefg\"\n" | |
338 | "(string-upcase! y) @result{} \"ARRDEFG\"\n" | |
339 | "y @result{} \"ARRDEFG\"\n" | |
340 | "@end lisp") | |
1bbd0b84 | 341 | #define FUNC_NAME s_scm_string_upcase_x |
c101e39e | 342 | { |
a49af0c0 | 343 | SCM_VALIDATE_STRING (1, str); |
322ac0c5 | 344 | |
a49af0c0 | 345 | return string_upcase_x (str); |
c101e39e | 346 | } |
1bbd0b84 | 347 | #undef FUNC_NAME |
c101e39e | 348 | |
a49af0c0 | 349 | |
5ad8ab0a | 350 | SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0, |
a49af0c0 | 351 | (SCM str), |
91344ceb MG |
352 | "Return a freshly allocated string containing the characters of\n" |
353 | "@var{str} in upper case.") | |
1bbd0b84 | 354 | #define FUNC_NAME s_scm_string_upcase |
99a9952d | 355 | { |
a49af0c0 DH |
356 | SCM_VALIDATE_STRING (1, str); |
357 | ||
358 | return string_upcase_x (string_copy (str)); | |
99a9952d | 359 | } |
1bbd0b84 | 360 | #undef FUNC_NAME |
99a9952d | 361 | |
a49af0c0 | 362 | |
5ad8ab0a | 363 | /* Helper function for the string lowercase conversion functions. |
a49af0c0 DH |
364 | * No argument checking is performed. */ |
365 | static SCM | |
366 | string_downcase_x (SCM v) | |
367 | { | |
c014a02e | 368 | unsigned long k; |
a49af0c0 DH |
369 | |
370 | for (k = 0; k < SCM_STRING_LENGTH (v); ++k) | |
371 | SCM_STRING_UCHARS (v) [k] = scm_downcase (SCM_STRING_UCHARS (v) [k]); | |
372 | ||
373 | return v; | |
374 | } | |
375 | ||
376 | ||
5ad8ab0a | 377 | SCM_DEFINE (scm_string_downcase_x, "string-downcase!", 1, 0, 0, |
a49af0c0 | 378 | (SCM str), |
91344ceb MG |
379 | "Destructively downcase every character in @var{str} and return\n" |
380 | "@var{str}.\n" | |
381 | "@lisp\n" | |
382 | "y @result{} \"ARRDEFG\"\n" | |
383 | "(string-downcase! y) @result{} \"arrdefg\"\n" | |
384 | "y @result{} \"arrdefg\"\n" | |
385 | "@end lisp") | |
1bbd0b84 | 386 | #define FUNC_NAME s_scm_string_downcase_x |
c101e39e | 387 | { |
a49af0c0 | 388 | SCM_VALIDATE_STRING (1, str); |
322ac0c5 | 389 | |
a49af0c0 | 390 | return string_downcase_x (str); |
c101e39e | 391 | } |
1bbd0b84 | 392 | #undef FUNC_NAME |
0f2d19dd | 393 | |
a49af0c0 | 394 | |
5ad8ab0a | 395 | SCM_DEFINE (scm_string_downcase, "string-downcase", 1, 0, 0, |
a49af0c0 | 396 | (SCM str), |
91344ceb MG |
397 | "Return a freshly allocation string containing the characters in\n" |
398 | "@var{str} in lower case.") | |
1bbd0b84 | 399 | #define FUNC_NAME s_scm_string_downcase |
99a9952d | 400 | { |
a49af0c0 DH |
401 | SCM_VALIDATE_STRING (1, str); |
402 | ||
403 | return string_downcase_x (string_copy (str)); | |
99a9952d | 404 | } |
1bbd0b84 | 405 | #undef FUNC_NAME |
99a9952d | 406 | |
a49af0c0 | 407 | |
5ad8ab0a | 408 | /* Helper function for the string capitalization functions. |
a49af0c0 DH |
409 | * No argument checking is performed. */ |
410 | static SCM | |
411 | string_capitalize_x (SCM str) | |
99a9952d | 412 | { |
ff0a837c | 413 | unsigned char *sz; |
c014a02e | 414 | long i, len; |
1be6b49c | 415 | int in_word=0; |
a49af0c0 | 416 | |
bfa974f0 | 417 | len = SCM_STRING_LENGTH(str); |
ff0a837c | 418 | sz = SCM_STRING_UCHARS (str); |
99a9952d | 419 | for(i=0; i<len; i++) { |
36284627 | 420 | if (!SCM_FALSEP (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) { |
99a9952d | 421 | if(!in_word) { |
6552dbf7 | 422 | sz[i] = scm_upcase(sz[i]); |
99a9952d JB |
423 | in_word = 1; |
424 | } else { | |
6552dbf7 | 425 | sz[i] = scm_downcase(sz[i]); |
99a9952d JB |
426 | } |
427 | } | |
428 | else in_word = 0; | |
429 | } | |
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; |
dd2a6f3a MG |
490 | char * p; |
491 | int ch; | |
492 | SCM res = SCM_EOL; | |
493 | ||
494 | SCM_VALIDATE_STRING (1, str); | |
495 | SCM_VALIDATE_CHAR (2, chr); | |
496 | ||
497 | idx = SCM_STRING_LENGTH (str); | |
498 | p = SCM_STRING_CHARS (str); | |
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 | { | |
36284627 | 507 | res = scm_cons (scm_mem2string (p + idx, last_idx - idx), res); |
dd2a6f3a MG |
508 | idx--; |
509 | } | |
510 | } | |
36284627 | 511 | scm_remember_upto_here_1 (str); |
dd2a6f3a MG |
512 | return res; |
513 | } | |
514 | #undef FUNC_NAME | |
515 | ||
516 | ||
5ad8ab0a | 517 | SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, |
91344ceb MG |
518 | (SCM str), |
519 | "Return the symbol whose name is @var{str}. @var{str} is\n" | |
520 | "converted to lowercase before the conversion is done, if Guile\n" | |
8f85c0c6 | 521 | "is currently reading symbols case-insensitively.") |
1bbd0b84 | 522 | #define FUNC_NAME s_scm_string_ci_to_symbol |
99a9952d JB |
523 | { |
524 | return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P | |
525 | ? scm_string_downcase(str) | |
526 | : str); | |
527 | } | |
1bbd0b84 | 528 | #undef FUNC_NAME |
1cc91f1b | 529 | |
0f2d19dd JB |
530 | void |
531 | scm_init_strop () | |
0f2d19dd | 532 | { |
a0599745 | 533 | #include "libguile/strop.x" |
0f2d19dd | 534 | } |
89e00824 ML |
535 | |
536 | /* | |
537 | Local Variables: | |
538 | c-file-style: "gnu" | |
539 | End: | |
540 | */ |