97b545f82b84a13a2ac6645dd72bb9fba3a63b71
1 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2006,
2 * 2011 Free Software Foundation, Inc.
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24 #include "libguile/_scm.h"
32 #include "libguile/chars.h"
33 #include "libguile/modules.h"
34 #include "libguile/ports.h"
35 #include "libguile/rdelim.h"
36 #include "libguile/root.h"
37 #include "libguile/strings.h"
38 #include "libguile/strports.h"
39 #include "libguile/validate.h"
41 SCM_DEFINE (scm_read_delimited_x
, "%read-delimited!", 3, 3, 0,
42 (SCM delims
, SCM str
, SCM gobble
, SCM port
, SCM start
, SCM end
),
43 "Read characters from @var{port} into @var{str} until one of the\n"
44 "characters in the @var{delims} string is encountered. If\n"
45 "@var{gobble} is true, discard the delimiter character;\n"
46 "otherwise, leave it in the input stream for the next read. If\n"
47 "@var{port} is not specified, use the value of\n"
48 "@code{(current-input-port)}. If @var{start} or @var{end} are\n"
49 "specified, store data only into the substring of @var{str}\n"
50 "bounded by @var{start} and @var{end} (which default to the\n"
51 "beginning and end of the string, respectively).\n"
53 " Return a pair consisting of the delimiter that terminated the\n"
54 "string and the number of characters read. If reading stopped\n"
55 "at the end of file, the delimiter returned is the\n"
56 "@var{eof-object}; if the string was filled without encountering\n"
57 "a delimiter, this value is @code{#f}.")
58 #define FUNC_NAME s_scm_read_delimited_x
66 SCM_VALIDATE_STRING (1, delims
);
67 num_delims
= scm_i_string_length (delims
);
69 SCM_VALIDATE_STRING (2, str
);
70 scm_i_get_substring_spec (scm_i_string_length (str
),
71 start
, &cstart
, end
, &cend
);
73 if (SCM_UNBNDP (port
))
74 port
= scm_current_input_port ();
76 SCM_VALIDATE_OPINPORT (4, port
);
78 for (j
= cstart
; j
< cend
; j
++)
82 c
= scm_getc_unlocked (port
);
83 for (k
= 0; k
< num_delims
; k
++)
85 if (scm_i_string_ref (delims
, k
) == c
)
87 if (scm_is_false (gobble
))
90 return scm_cons (SCM_MAKE_CHAR (c
),
91 scm_from_size_t (j
- cstart
));
95 return scm_cons (SCM_EOF_VAL
,
96 scm_from_size_t (j
- cstart
));
98 scm_c_string_set_x (str
, j
, SCM_MAKE_CHAR (c
));
100 return scm_cons (SCM_BOOL_F
, scm_from_size_t (j
- cstart
));
107 * truncates any terminating newline from its input, and returns
108 * a cons of the string read and its terminating character. Doing
109 * so makes it easy to implement the hairy `read-line' options
110 * efficiently in Scheme.
113 SCM_DEFINE (scm_read_line
, "%read-line", 0, 1, 0,
115 "Read a newline-terminated line from @var{port}, allocating storage as\n"
116 "necessary. The newline terminator (if any) is removed from the string,\n"
117 "and a pair consisting of the line and its delimiter is returned. The\n"
118 "delimiter may be either a newline or the @var{eof-object}; if\n"
119 "@code{%read-line} is called at the end of file, it returns the pair\n"
120 "@code{(#<eof> . #<eof>)}.")
121 #define FUNC_NAME s_scm_read_line
123 /* Threshold under which the only allocation performed is that of the
124 resulting string and pair. */
125 #define LINE_BUFFER_SIZE 256
127 SCM line
, strings
, result
;
128 scm_t_wchar buf
[LINE_BUFFER_SIZE
], delim
;
131 if (SCM_UNBNDP (port
))
132 port
= scm_current_input_port ();
134 SCM_VALIDATE_OPINPORT (1,port
);
138 strings
= SCM_BOOL_F
;
142 if (SCM_UNLIKELY (index
>= LINE_BUFFER_SIZE
))
144 /* The line is getting longer than BUF so store its current
145 contents in STRINGS. */
146 strings
= scm_cons (scm_from_utf32_stringn (buf
, index
),
147 scm_is_false (strings
) ? SCM_EOL
: strings
);
152 buf
[index
] = scm_getc_unlocked (port
);
167 if (SCM_LIKELY (scm_is_false (strings
)))
169 line
= scm_from_utf32_stringn (buf
, index
);
172 /* Aggregate the intermediary results. */
173 strings
= scm_cons (scm_from_utf32_stringn (buf
, index
), strings
);
174 line
= scm_string_concatenate (scm_reverse (strings
));
177 if (delim
== EOF
&& scm_i_string_length (line
) == 0)
178 result
= scm_cons (SCM_EOF_VAL
, SCM_EOF_VAL
);
180 result
= scm_cons (line
,
181 delim
== EOF
? SCM_EOF_VAL
: SCM_MAKE_CHAR (delim
));
184 #undef LINE_BUFFER_SIZE
188 SCM_DEFINE (scm_write_line
, "write-line", 1, 1, 0,
190 "Display @var{obj} and a newline character to @var{port}. If\n"
191 "@var{port} is not specified, @code{(current-output-port)} is\n"
192 "used. This function is equivalent to:\n"
194 "(display obj [port])\n"
197 #define FUNC_NAME s_scm_write_line
199 scm_display (obj
, port
);
200 return scm_newline (port
);
205 scm_init_rdelim_builtins (void)
207 #include "libguile/rdelim.x"
209 return SCM_UNSPECIFIED
;
213 scm_init_rdelim (void)
215 scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
216 scm_init_rdelim_builtins
);