Commit | Line | Data |
---|---|---|
be54b15d | 1 | /* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc. |
0f2d19dd | 2 | * |
73be1d9e MV |
3 | * This library is free software; you can redistribute it and/or |
4 | * modify it under the terms of the GNU Lesser General Public | |
5 | * License as published by the Free Software Foundation; either | |
6 | * version 2.1 of the License, or (at your option) any later version. | |
0f2d19dd | 7 | * |
73be1d9e MV |
8 | * This library is distributed in the hope that it will be useful, |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
11 | * Lesser General Public License for more details. | |
0f2d19dd | 12 | * |
73be1d9e MV |
13 | * You should have received a copy of the GNU Lesser General Public |
14 | * License along with this library; if not, write to the Free Software | |
15 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
16 | */ | |
1bbd0b84 | 17 | |
1bbd0b84 | 18 | |
0f2d19dd JB |
19 | \f |
20 | ||
faf2c9d7 MD |
21 | #include <string.h> |
22 | ||
a0599745 MD |
23 | #include "libguile/_scm.h" |
24 | #include "libguile/chars.h" | |
7c33806a | 25 | #include "libguile/root.h" |
a0599745 | 26 | #include "libguile/strings.h" |
1afff620 | 27 | #include "libguile/deprecation.h" |
a0599745 | 28 | #include "libguile/validate.h" |
c829a427 | 29 | #include "libguile/dynwind.h" |
1afff620 | 30 | |
0f2d19dd JB |
31 | \f |
32 | ||
33 | /* {Strings} | |
34 | */ | |
35 | ||
3b3b36dd | 36 | SCM_DEFINE (scm_string_p, "string?", 1, 0, 0, |
0d26a824 | 37 | (SCM obj), |
bb2c02f2 | 38 | "Return @code{#t} if @var{obj} is a string, else @code{#f}.") |
1bbd0b84 | 39 | #define FUNC_NAME s_scm_string_p |
0f2d19dd | 40 | { |
c829a427 | 41 | return scm_from_bool (SCM_I_STRINGP (obj)); |
0f2d19dd | 42 | } |
1bbd0b84 | 43 | #undef FUNC_NAME |
0f2d19dd | 44 | |
e53cc817 | 45 | |
bd9e24b3 | 46 | SCM_REGISTER_PROC (s_scm_list_to_string, "list->string", 1, 0, 0, scm_string); |
1bbd0b84 | 47 | |
3b3b36dd | 48 | SCM_DEFINE (scm_string, "string", 0, 0, 1, |
6fa73e72 | 49 | (SCM chrs), |
8f85c0c6 | 50 | "@deffnx {Scheme Procedure} list->string chrs\n" |
1e6808ea | 51 | "Return a newly allocated string composed of the arguments,\n" |
0d26a824 | 52 | "@var{chrs}.") |
1bbd0b84 | 53 | #define FUNC_NAME s_scm_string |
0f2d19dd | 54 | { |
bd9e24b3 GH |
55 | SCM result; |
56 | ||
0f2d19dd | 57 | { |
c014a02e | 58 | long i = scm_ilength (chrs); |
bd9e24b3 | 59 | |
4d6aae71 | 60 | SCM_ASSERT (i >= 0, chrs, SCM_ARG1, FUNC_NAME); |
be54b15d | 61 | result = scm_allocate_string (i); |
0f2d19dd | 62 | } |
bd9e24b3 GH |
63 | |
64 | { | |
c829a427 | 65 | unsigned char *data = SCM_I_STRING_UCHARS (result); |
bd9e24b3 | 66 | |
36284627 | 67 | while (!SCM_NULLP (chrs)) |
bd9e24b3 GH |
68 | { |
69 | SCM elt = SCM_CAR (chrs); | |
70 | ||
7866a09b GB |
71 | SCM_VALIDATE_CHAR (SCM_ARGn, elt); |
72 | *data++ = SCM_CHAR (elt); | |
bd9e24b3 GH |
73 | chrs = SCM_CDR (chrs); |
74 | } | |
75 | } | |
76 | return result; | |
0f2d19dd | 77 | } |
1bbd0b84 | 78 | #undef FUNC_NAME |
0f2d19dd | 79 | |
0f2d19dd JB |
80 | |
81 | /* converts C scm_array of strings to SCM scm_list of strings. */ | |
82 | /* If argc < 0, a null terminated scm_array is assumed. */ | |
0f2d19dd | 83 | SCM |
1bbd0b84 | 84 | scm_makfromstrs (int argc, char **argv) |
0f2d19dd JB |
85 | { |
86 | int i = argc; | |
87 | SCM lst = SCM_EOL; | |
88 | if (0 > i) | |
89 | for (i = 0; argv[i]; i++); | |
90 | while (i--) | |
36284627 | 91 | lst = scm_cons (scm_mem2string (argv[i], strlen (argv[i])), lst); |
0f2d19dd JB |
92 | return lst; |
93 | } | |
94 | ||
95 | ||
ee149d03 JB |
96 | /* This function must only be applied to memory obtained via malloc, |
97 | since the GC is going to apply `free' to it when the string is | |
98 | dropped. | |
99 | ||
100 | Also, s[len] must be `\0', since we promise that strings are | |
101 | null-terminated. Perhaps we could handle non-null-terminated | |
102 | strings by claiming they're shared substrings of a string we just | |
103 | made up. */ | |
0f2d19dd | 104 | SCM |
1be6b49c | 105 | scm_take_str (char *s, size_t len) |
cb0d8be2 | 106 | #define FUNC_NAME "scm_take_str" |
0f2d19dd JB |
107 | { |
108 | SCM answer; | |
cb0d8be2 | 109 | |
b9bd8526 | 110 | SCM_ASSERT_RANGE (2, scm_from_ulong (len), len <= SCM_STRING_MAX_LENGTH); |
cb0d8be2 | 111 | |
c829a427 | 112 | answer = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) s); |
4c9419ac | 113 | scm_gc_register_collectable_memory (s, len+1, "string"); |
cb0d8be2 | 114 | |
0f2d19dd JB |
115 | return answer; |
116 | } | |
cb0d8be2 DH |
117 | #undef FUNC_NAME |
118 | ||
0f2d19dd | 119 | |
ee149d03 JB |
120 | /* `s' must be a malloc'd string. See scm_take_str. */ |
121 | SCM | |
122 | scm_take0str (char *s) | |
123 | { | |
c829a427 | 124 | return scm_take_locale_string (s); |
ee149d03 JB |
125 | } |
126 | ||
36284627 DH |
127 | |
128 | SCM | |
129 | scm_mem2string (const char *src, size_t len) | |
0f2d19dd | 130 | { |
c829a427 | 131 | return scm_from_locale_stringn (src, len); |
0f2d19dd JB |
132 | } |
133 | ||
b00418df DH |
134 | |
135 | SCM | |
136 | scm_str2string (const char *src) | |
137 | { | |
c829a427 | 138 | return scm_from_locale_string (src); |
b00418df DH |
139 | } |
140 | ||
141 | ||
0f2d19dd | 142 | SCM |
1bbd0b84 | 143 | scm_makfrom0str (const char *src) |
0f2d19dd JB |
144 | { |
145 | if (!src) return SCM_BOOL_F; | |
c829a427 | 146 | return scm_from_locale_string (src); |
0f2d19dd JB |
147 | } |
148 | ||
1cc91f1b | 149 | |
0f2d19dd | 150 | SCM |
1bbd0b84 | 151 | scm_makfrom0str_opt (const char *src) |
0f2d19dd JB |
152 | { |
153 | return scm_makfrom0str (src); | |
154 | } | |
155 | ||
156 | ||
be54b15d | 157 | SCM |
1be6b49c | 158 | scm_allocate_string (size_t len) |
be54b15d DH |
159 | #define FUNC_NAME "scm_allocate_string" |
160 | { | |
161 | char *mem; | |
162 | SCM s; | |
163 | ||
b9bd8526 | 164 | SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= SCM_STRING_MAX_LENGTH); |
be54b15d | 165 | |
4c9419ac | 166 | mem = (char *) scm_gc_malloc (len + 1, "string"); |
be54b15d DH |
167 | mem[len] = 0; |
168 | ||
c829a427 | 169 | s = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) mem); |
be54b15d DH |
170 | |
171 | return s; | |
172 | } | |
173 | #undef FUNC_NAME | |
174 | ||
175 | ||
3b3b36dd | 176 | SCM_DEFINE (scm_make_string, "make-string", 1, 1, 0, |
6fa73e72 | 177 | (SCM k, SCM chr), |
0d26a824 MG |
178 | "Return a newly allocated string of\n" |
179 | "length @var{k}. If @var{chr} is given, then all elements of\n" | |
180 | "the string are initialized to @var{chr}, otherwise the contents\n" | |
9401323e | 181 | "of the @var{string} are unspecified.") |
1bbd0b84 | 182 | #define FUNC_NAME s_scm_make_string |
0f2d19dd | 183 | { |
e11e83f3 MV |
184 | size_t i = scm_to_unsigned_integer (k, 0, SCM_STRING_MAX_LENGTH); |
185 | SCM res = scm_allocate_string (i); | |
cb0d8be2 | 186 | |
e11e83f3 MV |
187 | if (!SCM_UNBNDP (chr)) |
188 | { | |
189 | unsigned char *dst; | |
190 | ||
191 | SCM_VALIDATE_CHAR (2, chr); | |
192 | ||
c829a427 | 193 | dst = SCM_I_STRING_UCHARS (res); |
e11e83f3 | 194 | memset (dst, SCM_CHAR (chr), i); |
0f2d19dd | 195 | } |
e11e83f3 MV |
196 | |
197 | return res; | |
0f2d19dd | 198 | } |
1bbd0b84 | 199 | #undef FUNC_NAME |
0f2d19dd | 200 | |
cb0d8be2 | 201 | |
3b3b36dd | 202 | SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0, |
0d26a824 MG |
203 | (SCM string), |
204 | "Return the number of characters in @var{string}.") | |
1bbd0b84 | 205 | #define FUNC_NAME s_scm_string_length |
0f2d19dd | 206 | { |
d1ca2c64 | 207 | SCM_VALIDATE_STRING (1, string); |
c829a427 | 208 | return scm_from_size_t (SCM_I_STRING_LENGTH (string)); |
0f2d19dd | 209 | } |
1bbd0b84 | 210 | #undef FUNC_NAME |
0f2d19dd | 211 | |
bd9e24b3 | 212 | SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0, |
6fa73e72 | 213 | (SCM str, SCM k), |
0d26a824 MG |
214 | "Return character @var{k} of @var{str} using zero-origin\n" |
215 | "indexing. @var{k} must be a valid index of @var{str}.") | |
1bbd0b84 | 216 | #define FUNC_NAME s_scm_string_ref |
0f2d19dd | 217 | { |
a55c2b68 | 218 | unsigned long idx; |
bd9e24b3 | 219 | |
d1ca2c64 | 220 | SCM_VALIDATE_STRING (1, str); |
c829a427 MV |
221 | idx = scm_to_unsigned_integer (k, 0, SCM_I_STRING_LENGTH(str)-1); |
222 | return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (str)[idx]); | |
0f2d19dd | 223 | } |
1bbd0b84 | 224 | #undef FUNC_NAME |
0f2d19dd | 225 | |
f0942910 | 226 | |
3b3b36dd | 227 | SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, |
6fa73e72 | 228 | (SCM str, SCM k, SCM chr), |
0d26a824 MG |
229 | "Store @var{chr} in element @var{k} of @var{str} and return\n" |
230 | "an unspecified value. @var{k} must be a valid index of\n" | |
231 | "@var{str}.") | |
1bbd0b84 | 232 | #define FUNC_NAME s_scm_string_set_x |
0f2d19dd | 233 | { |
a55c2b68 MV |
234 | unsigned long idx; |
235 | ||
f0942910 | 236 | SCM_VALIDATE_STRING (1, str); |
c829a427 | 237 | idx = scm_to_unsigned_integer (k, 0, SCM_I_STRING_LENGTH(str)-1); |
34d19ef6 | 238 | SCM_VALIDATE_CHAR (3, chr); |
c829a427 | 239 | SCM_I_STRING_UCHARS (str)[idx] = SCM_CHAR (chr); |
0f2d19dd JB |
240 | return SCM_UNSPECIFIED; |
241 | } | |
1bbd0b84 | 242 | #undef FUNC_NAME |
0f2d19dd JB |
243 | |
244 | ||
3b3b36dd | 245 | SCM_DEFINE (scm_substring, "substring", 2, 1, 0, |
0d26a824 MG |
246 | (SCM str, SCM start, SCM end), |
247 | "Return a newly allocated string formed from the characters\n" | |
248 | "of @var{str} beginning with index @var{start} (inclusive) and\n" | |
249 | "ending with index @var{end} (exclusive).\n" | |
250 | "@var{str} must be a string, @var{start} and @var{end} must be\n" | |
251 | "exact integers satisfying:\n\n" | |
252 | "0 <= @var{start} <= @var{end} <= (string-length @var{str}).") | |
1bbd0b84 | 253 | #define FUNC_NAME s_scm_substring |
0f2d19dd | 254 | { |
a55c2b68 MV |
255 | unsigned long int from; |
256 | unsigned long int to; | |
36284627 | 257 | SCM substr; |
685c0d71 | 258 | |
d1ca2c64 | 259 | SCM_VALIDATE_STRING (1, str); |
c829a427 | 260 | from = scm_to_unsigned_integer (start, 0, SCM_I_STRING_LENGTH(str)); |
a55c2b68 | 261 | if (SCM_UNBNDP (end)) |
c829a427 | 262 | to = SCM_I_STRING_LENGTH(str); |
a55c2b68 | 263 | else |
c829a427 MV |
264 | to = scm_to_unsigned_integer (end, from, SCM_I_STRING_LENGTH(str)); |
265 | substr = scm_allocate_string (to - from); | |
266 | memcpy (SCM_I_STRING_CHARS (substr), SCM_I_STRING_CHARS (str) + from, | |
267 | to - from); | |
36284627 DH |
268 | scm_remember_upto_here_1 (str); |
269 | return substr; | |
0f2d19dd | 270 | } |
1bbd0b84 | 271 | #undef FUNC_NAME |
0f2d19dd | 272 | |
685c0d71 | 273 | |
3b3b36dd | 274 | SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, |
6fa73e72 | 275 | (SCM args), |
0d26a824 MG |
276 | "Return a newly allocated string whose characters form the\n" |
277 | "concatenation of the given strings, @var{args}.") | |
1bbd0b84 | 278 | #define FUNC_NAME s_scm_string_append |
0f2d19dd JB |
279 | { |
280 | SCM res; | |
1be6b49c | 281 | size_t i = 0; |
c829a427 MV |
282 | SCM l, s; |
283 | char *data; | |
af45e3b0 DH |
284 | |
285 | SCM_VALIDATE_REST_ARGUMENT (args); | |
c829a427 MV |
286 | for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) |
287 | { | |
288 | s = SCM_CAR (l); | |
289 | SCM_VALIDATE_STRING (SCM_ARGn, s); | |
290 | i += SCM_I_STRING_LENGTH (s); | |
291 | } | |
be54b15d | 292 | res = scm_allocate_string (i); |
c829a427 MV |
293 | data = SCM_I_STRING_CHARS (res); |
294 | for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) | |
295 | { | |
296 | s = SCM_CAR (l); | |
297 | memcpy (data, SCM_I_STRING_CHARS (s), SCM_I_STRING_LENGTH (s)); | |
298 | data += SCM_I_STRING_LENGTH (s); | |
299 | scm_remember_upto_here_1 (s); | |
300 | } | |
0f2d19dd JB |
301 | return res; |
302 | } | |
1bbd0b84 | 303 | #undef FUNC_NAME |
0f2d19dd | 304 | |
c829a427 MV |
305 | int |
306 | scm_is_string (SCM obj) | |
307 | { | |
308 | return SCM_I_STRINGP (obj); | |
309 | } | |
24933780 | 310 | |
c829a427 MV |
311 | SCM |
312 | scm_from_locale_stringn (const char *str, size_t len) | |
313 | { | |
314 | SCM res; | |
315 | char *dst; | |
4d4528e7 | 316 | |
c829a427 MV |
317 | if (len == (size_t)-1) |
318 | len = strlen (str); | |
319 | res = scm_allocate_string (len); | |
320 | dst = SCM_I_STRING_CHARS (res); | |
321 | memcpy (dst, str, len); | |
322 | return res; | |
323 | } | |
4d4528e7 | 324 | |
c829a427 MV |
325 | SCM |
326 | scm_from_locale_string (const char *str) | |
4d4528e7 | 327 | { |
c829a427 MV |
328 | return scm_from_locale_stringn (str, -1); |
329 | } | |
4d4528e7 | 330 | |
c829a427 MV |
331 | SCM |
332 | scm_take_locale_stringn (char *str, size_t len) | |
333 | { | |
334 | if (len == (size_t)-1) | |
335 | return scm_take_locale_string (str); | |
336 | else | |
337 | { | |
338 | /* STR might not be zero terminated and we are not allowed to | |
339 | look at str[len], so we have to make a new one... | |
340 | */ | |
341 | SCM res = scm_from_locale_stringn (str, len); | |
342 | free (str); | |
343 | return res; | |
344 | } | |
345 | } | |
4d4528e7 | 346 | |
c829a427 MV |
347 | SCM |
348 | scm_take_locale_string (char *str) | |
349 | { | |
350 | size_t len = strlen (str); | |
351 | SCM res; | |
352 | ||
353 | if (len > SCM_STRING_MAX_LENGTH) | |
24933780 | 354 | { |
c829a427 MV |
355 | free (str); |
356 | scm_out_of_range (NULL, scm_from_size_t (len)); | |
24933780 | 357 | } |
4d4528e7 | 358 | |
c829a427 MV |
359 | res = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) str); |
360 | scm_gc_register_collectable_memory (str, len+1, "string"); | |
361 | ||
362 | return res; | |
363 | } | |
364 | ||
365 | char * | |
366 | scm_to_locale_stringn (SCM str, size_t *lenp) | |
367 | { | |
368 | char *res; | |
369 | size_t len; | |
4d4528e7 | 370 | |
c829a427 MV |
371 | if (!SCM_I_STRINGP (str)) |
372 | scm_wrong_type_arg_msg (NULL, 0, str, "string"); | |
373 | len = SCM_I_STRING_LENGTH (str); | |
374 | res = scm_malloc (len + ((lenp==NULL)? 1 : 0)); | |
375 | memcpy (res, SCM_I_STRING_CHARS (str), len); | |
376 | if (lenp == NULL) | |
377 | { | |
378 | res[len] = '\0'; | |
379 | if (strlen (res) != len) | |
380 | { | |
381 | free (res); | |
382 | scm_misc_error (NULL, | |
383 | "string contains #\\nul character: ~S", | |
384 | scm_list_1 (str)); | |
385 | } | |
386 | } | |
387 | else | |
4d4528e7 | 388 | *lenp = len; |
24933780 | 389 | |
c829a427 MV |
390 | scm_remember_upto_here_1 (str); |
391 | return res; | |
4d4528e7 | 392 | } |
af68e5e5 | 393 | |
c829a427 MV |
394 | char * |
395 | scm_to_locale_string (SCM str) | |
396 | { | |
397 | return scm_to_locale_stringn (str, NULL); | |
398 | } | |
af68e5e5 | 399 | |
c829a427 MV |
400 | size_t |
401 | scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len) | |
402 | { | |
403 | size_t len; | |
404 | ||
405 | if (!SCM_I_STRINGP (str)) | |
406 | scm_wrong_type_arg_msg (NULL, 0, str, "string"); | |
407 | len = SCM_I_STRING_LENGTH (str); | |
408 | memcpy (buf, SCM_I_STRING_CHARS (str), (len > max_len)? max_len : len); | |
409 | scm_remember_upto_here_1 (str); | |
410 | return len; | |
411 | } | |
af68e5e5 | 412 | |
c829a427 MV |
413 | /* Return a newly allocated array of char pointers to each of the strings |
414 | in args, with a terminating NULL pointer. */ | |
415 | ||
416 | char ** | |
417 | scm_i_allocate_string_pointers (SCM list) | |
af68e5e5 | 418 | { |
c829a427 MV |
419 | char **result; |
420 | int len = scm_ilength (list); | |
421 | int i; | |
422 | ||
423 | if (len < 0) | |
424 | scm_wrong_type_arg_msg (NULL, 0, list, "proper list"); | |
425 | ||
426 | scm_frame_begin (0); | |
427 | ||
428 | result = (char **) scm_malloc ((len + 1) * sizeof (char *)); | |
429 | result[len] = NULL; | |
430 | scm_frame_unwind_handler (free, result, 0); | |
431 | ||
432 | /* The list might be have been modified in another thread, so | |
433 | we check LIST before each access. | |
434 | */ | |
435 | for (i = 0; i < len && SCM_CONSP (list); i++) | |
436 | { | |
437 | result[i] = scm_to_locale_string (SCM_CAR (list)); | |
438 | list = SCM_CDR (list); | |
439 | } | |
440 | ||
441 | scm_frame_end (); | |
442 | return result; | |
af68e5e5 | 443 | } |
e53cc817 | 444 | |
c829a427 MV |
445 | void |
446 | scm_i_free_string_pointers (char **pointers) | |
447 | { | |
448 | int i; | |
449 | ||
450 | for (i = 0; pointers[i]; i++) | |
451 | free (pointers[i]); | |
452 | free (pointers); | |
453 | } | |
24933780 | 454 | |
6f14f578 MV |
455 | void |
456 | scm_i_get_substring_spec (size_t len, | |
457 | SCM start, size_t *cstart, | |
458 | SCM end, size_t *cend) | |
459 | { | |
460 | if (SCM_UNBNDP (start)) | |
461 | *cstart = 0; | |
462 | else | |
463 | *cstart = scm_to_unsigned_integer (start, 0, len); | |
464 | ||
465 | if (SCM_UNBNDP (end)) | |
466 | *cend = len; | |
467 | else | |
468 | *cend = scm_to_unsigned_integer (end, *cstart, len); | |
469 | } | |
470 | ||
0f2d19dd JB |
471 | void |
472 | scm_init_strings () | |
0f2d19dd | 473 | { |
7c33806a DH |
474 | scm_nullstr = scm_allocate_string (0); |
475 | ||
a0599745 | 476 | #include "libguile/strings.x" |
0f2d19dd JB |
477 | } |
478 | ||
89e00824 ML |
479 | |
480 | /* | |
481 | Local Variables: | |
482 | c-file-style: "gnu" | |
483 | End: | |
484 | */ |