1 /* classes: src_files */
3 /* Copyright (C) 1994,1996,1997,1999,2000,2001 Free Software Foundation, Inc.
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)
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.
15 You should have received a copy of the GNU General Public License
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
20 As a special exception, the Free Software Foundation gives permission
21 for additional uses of the text contained in its release of GUILE.
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.
29 This exception does not however invalidate any other reasons why
30 the executable file might be covered by the GNU General Public License.
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.
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. */
50 #include "libguile/_scm.h"
51 #include "libguile/chars.h"
52 #include "libguile/strings.h"
54 #include "libguile/validate.h"
55 #include "libguile/strop.h"
56 #include "libguile/read.h" /*For SCM_CASE_INSENSITIVE_P*/
65 xSCM_DEFINE (scm_i_index, "i-index", 2, 2, 0,
66 (SCM str, SCM chr, SCM frm, SCM to),
67 "@deftypefn {Internal C Function} {static int} scm_i_index (SCM *@var{str},\n"
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"
70 "@code{rindex} function, depending on the value of @var{direction}."
72 /* implements index if direction > 0 otherwise rindex. */
74 scm_i_index (SCM
*str
, SCM chr
, int direction
, SCM sub_start
,
75 SCM sub_end
, const char *why
)
83 SCM_ASSERT (SCM_STRINGP (*str
), *str
, SCM_ARG1
, why
);
84 SCM_ASSERT (SCM_CHARP (chr
), chr
, SCM_ARG2
, why
);
86 if (SCM_FALSEP (sub_start
))
87 sub_start
= SCM_MAKINUM (0);
89 SCM_ASSERT (SCM_INUMP (sub_start
), sub_start
, SCM_ARG3
, why
);
90 lower
= SCM_INUM (sub_start
);
91 if (lower
< 0 || lower
> SCM_STRING_LENGTH (*str
))
92 scm_out_of_range (why
, sub_start
);
94 if (SCM_FALSEP (sub_end
))
95 sub_end
= SCM_MAKINUM (SCM_STRING_LENGTH (*str
));
97 SCM_ASSERT (SCM_INUMP (sub_end
), sub_end
, SCM_ARG4
, why
);
98 upper
= SCM_INUM (sub_end
);
99 if (upper
< SCM_INUM (sub_start
) || upper
> SCM_STRING_LENGTH (*str
))
100 scm_out_of_range (why
, sub_end
);
104 p
= SCM_STRING_UCHARS (*str
) + lower
;
107 for (x
= SCM_INUM (sub_start
); x
< upper
; ++x
, ++p
)
113 p
= upper
- 1 + SCM_STRING_UCHARS (*str
);
115 for (x
= upper
- 1; x
>= lower
; --x
, --p
)
123 SCM_DEFINE (scm_string_index
, "string-index", 2, 2, 0,
124 (SCM str
, SCM chr
, SCM frm
, SCM to
),
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"
129 "@code{strchr} functions from the C library.\n"
132 "(string-index \"weiner\" #\\e)\n"
134 "(string-index \"weiner\" #\\e 2)\n"
136 "(string-index \"weiner\" #\\e 2 4)\n"
139 #define FUNC_NAME s_scm_string_index
143 if (SCM_UNBNDP (frm
))
147 pos
= scm_i_index (&str
, chr
, 1, frm
, to
, FUNC_NAME
);
150 : SCM_MAKINUM (pos
));
154 SCM_DEFINE (scm_string_rindex
, "string-rindex", 2, 2, 0,
155 (SCM str
, SCM chr
, SCM frm
, SCM to
),
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"
162 "(string-rindex \"weiner\" #\\e)\n"
164 "(string-rindex \"weiner\" #\\e 2 4)\n"
166 "(string-rindex \"weiner\" #\\e 2 5)\n"
169 #define FUNC_NAME s_scm_string_rindex
173 if (SCM_UNBNDP (frm
))
177 pos
= scm_i_index (&str
, chr
, -1, frm
, to
, FUNC_NAME
);
180 : SCM_MAKINUM (pos
));
184 SCM_DEFINE (scm_substring_move_x
, "substring-move!", 5, 0, 0,
185 (SCM str1
, SCM start1
, SCM end1
, SCM str2
, SCM start2
),
186 "Copy the substring of @var{str1} bounded by @var{start1} and @var{end1}\n"
187 "into @var{str2} beginning at position @var{start2}.\n"
188 "@var{str1} and @var{str2} can be the same string.")
189 #define FUNC_NAME s_scm_substring_move_x
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
);
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
));
205 SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2
)[s2
])),
206 (void *)(&(SCM_STRING_CHARS(str1
)[s1
])),
209 return scm_return_first(SCM_UNSPECIFIED
, str1
, str2
);
214 SCM_DEFINE (scm_substring_fill_x
, "substring-fill!", 4, 0, 0,
215 (SCM str
, SCM start
, SCM end
, SCM fill
),
216 "Change every character in @var{str} between @var{start} and\n"
217 "@var{end} to @var{fill}.\n"
220 "(define y \"abcdefg\")\n"
221 "(substring-fill! y 1 3 #\\r)\n"
223 "@result{} \"arrdefg\"\n"
225 #define FUNC_NAME s_scm_substring_fill_x
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);
235 while (i
<e
) SCM_STRING_CHARS (str
)[i
++] = c
;
236 return SCM_UNSPECIFIED
;
241 SCM_DEFINE (scm_string_null_p
, "string-null?", 1, 0, 0,
243 "Return @code{#t} if @var{str}'s length is zero, and\n"
244 "@code{#f} otherwise.\n"
246 "(string-null? \"\") @result{} #t\n"
247 "y @result{} \"foo\"\n"
248 "(string-null? y) @result{} #f\n"
250 #define FUNC_NAME s_scm_string_null_p
252 SCM_VALIDATE_STRING (1,str
);
253 return SCM_BOOL (SCM_STRING_LENGTH (str
) == 0);
258 SCM_DEFINE (scm_string_to_list
, "string->list", 1, 0, 0,
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"
264 #define FUNC_NAME s_scm_string_to_list
269 SCM_VALIDATE_STRING (1,str
);
270 src
= SCM_STRING_UCHARS (str
);
271 for (i
= SCM_STRING_LENGTH (str
)-1;i
>= 0;i
--) res
= scm_cons (SCM_MAKE_CHAR (src
[i
]), res
);
277 /* Helper function for the string copy and string conversion functions.
278 * No argument checking is performed. */
280 string_copy (SCM str
)
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
);
290 SCM_DEFINE (scm_string_copy
, "string-copy", 1, 0, 0,
292 "Return a newly allocated copy of the given @var{string}.")
293 #define FUNC_NAME s_scm_string_copy
295 SCM_VALIDATE_STRING (1, str
);
297 return string_copy (str
);
302 SCM_DEFINE (scm_string_fill_x
, "string-fill!", 2, 0, 0,
304 "Store @var{char} in every element of the given @var{string} and\n"
305 "return an unspecified value.")
306 #define FUNC_NAME s_scm_string_fill_x
308 register char *dst
, c
;
310 SCM_VALIDATE_STRING_COPY (1,str
,dst
);
311 SCM_VALIDATE_CHAR_COPY (2,chr
,c
);
312 for (k
= SCM_STRING_LENGTH (str
)-1;k
>= 0;k
--) dst
[k
] = c
;
313 return SCM_UNSPECIFIED
;
318 /* Helper function for the string uppercase conversion functions.
319 * No argument checking is performed. */
321 string_upcase_x (SCM v
)
325 for (k
= 0; k
< SCM_STRING_LENGTH (v
); ++k
)
326 SCM_STRING_UCHARS (v
) [k
] = scm_upcase (SCM_STRING_UCHARS (v
) [k
]);
332 SCM_DEFINE (scm_string_upcase_x
, "string-upcase!", 1, 0, 0,
334 "Destructively upcase every character in @var{str} and return\n"
337 "y @result{} \"arrdefg\"\n"
338 "(string-upcase! y) @result{} \"ARRDEFG\"\n"
339 "y @result{} \"ARRDEFG\"\n"
341 #define FUNC_NAME s_scm_string_upcase_x
343 SCM_VALIDATE_STRING (1, str
);
345 return string_upcase_x (str
);
350 SCM_DEFINE (scm_string_upcase
, "string-upcase", 1, 0, 0,
352 "Return a freshly allocated string containing the characters of\n"
353 "@var{str} in upper case.")
354 #define FUNC_NAME s_scm_string_upcase
356 SCM_VALIDATE_STRING (1, str
);
358 return string_upcase_x (string_copy (str
));
363 /* Helper function for the string lowercase conversion functions.
364 * No argument checking is performed. */
366 string_downcase_x (SCM v
)
370 for (k
= 0; k
< SCM_STRING_LENGTH (v
); ++k
)
371 SCM_STRING_UCHARS (v
) [k
] = scm_downcase (SCM_STRING_UCHARS (v
) [k
]);
377 SCM_DEFINE (scm_string_downcase_x
, "string-downcase!", 1, 0, 0,
379 "Destructively downcase every character in @var{str} and return\n"
382 "y @result{} \"ARRDEFG\"\n"
383 "(string-downcase! y) @result{} \"arrdefg\"\n"
384 "y @result{} \"arrdefg\"\n"
386 #define FUNC_NAME s_scm_string_downcase_x
388 SCM_VALIDATE_STRING (1, str
);
390 return string_downcase_x (str
);
395 SCM_DEFINE (scm_string_downcase
, "string-downcase", 1, 0, 0,
397 "Return a freshly allocation string containing the characters in\n"
398 "@var{str} in lower case.")
399 #define FUNC_NAME s_scm_string_downcase
401 SCM_VALIDATE_STRING (1, str
);
403 return string_downcase_x (string_copy (str
));
408 /* Helper function for the string capitalization functions.
409 * No argument checking is performed. */
411 string_capitalize_x (SCM str
)
417 len
= SCM_STRING_LENGTH(str
);
418 sz
= SCM_STRING_CHARS (str
);
419 for(i
=0; i
<len
; i
++) {
420 if (!SCM_FALSEP (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz
[i
])))) {
422 sz
[i
] = scm_upcase(sz
[i
]);
425 sz
[i
] = scm_downcase(sz
[i
]);
434 SCM_DEFINE (scm_string_capitalize_x
, "string-capitalize!", 1, 0, 0,
436 "Upcase the first character of every word in @var{str}\n"
437 "destructively and return @var{str}.\n"
440 "y @result{} \"hello world\"\n"
441 "(string-capitalize! y) @result{} \"Hello World\"\n"
442 "y @result{} \"Hello World\"\n"
444 #define FUNC_NAME s_scm_string_capitalize_x
446 SCM_VALIDATE_STRING (1, str
);
448 return string_capitalize_x (str
);
453 SCM_DEFINE (scm_string_capitalize
, "string-capitalize", 1, 0, 0,
455 "Return a freshly allocated string with the characters in\n"
456 "@var{str}, where the first character of every word is\n"
458 #define FUNC_NAME s_scm_string_capitalize
460 SCM_VALIDATE_STRING (1, str
);
462 return string_capitalize_x (string_copy (str
));
467 SCM_DEFINE (scm_string_split
, "string-split", 2, 0, 0,
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"
475 "(string-split \"root:x:0:0:root:/root:/bin/bash\" #\\:)\n"
477 "(\"root\" \"x\" \"0\" \"0\" \"root\" \"/root\" \"/bin/bash\")\n"
479 "(string-split \"::\" #\\:)\n"
483 "(string-split \"\" #\\:)\n"
487 #define FUNC_NAME s_scm_string_split
494 SCM_VALIDATE_STRING (1, str
);
495 SCM_VALIDATE_CHAR (2, chr
);
497 idx
= SCM_STRING_LENGTH (str
);
498 p
= SCM_STRING_CHARS (str
);
503 while (idx
> 0 && p
[idx
- 1] != ch
)
507 res
= scm_cons (scm_mem2string (p
+ idx
, last_idx
- idx
), res
);
511 scm_remember_upto_here_1 (str
);
517 SCM_DEFINE (scm_string_ci_to_symbol
, "string-ci->symbol", 1, 0, 0,
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"
521 "is currently reading symbols case-insensitively.")
522 #define FUNC_NAME s_scm_string_ci_to_symbol
524 return scm_string_to_symbol (SCM_CASE_INSENSITIVE_P
525 ? scm_string_downcase(str
)
533 #ifndef SCM_MAGIC_SNARFER
534 #include "libguile/strop.x"