c9cc0164d4c1614f840d7bebf7ba5de99ab66490
1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
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.
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.
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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 #include "libguile/_scm.h"
30 #include "libguile/chars.h"
31 #include "libguile/modules.h"
32 #include "libguile/ports.h"
33 #include "libguile/rdelim.h"
34 #include "libguile/root.h"
35 #include "libguile/strings.h"
36 #include "libguile/strports.h"
37 #include "libguile/validate.h"
39 SCM_DEFINE (scm_read_delimited_x
, "%read-delimited!", 3, 3, 0,
40 (SCM delims
, SCM str
, SCM gobble
, SCM port
, SCM start
, SCM end
),
41 "Read characters from @var{port} into @var{str} until one of the\n"
42 "characters in the @var{delims} string is encountered. If\n"
43 "@var{gobble} is true, discard the delimiter character;\n"
44 "otherwise, leave it in the input stream for the next read. If\n"
45 "@var{port} is not specified, use the value of\n"
46 "@code{(current-input-port)}. If @var{start} or @var{end} are\n"
47 "specified, store data only into the substring of @var{str}\n"
48 "bounded by @var{start} and @var{end} (which default to the\n"
49 "beginning and end of the string, respectively).\n"
51 " Return a pair consisting of the delimiter that terminated the\n"
52 "string and the number of characters read. If reading stopped\n"
53 "at the end of file, the delimiter returned is the\n"
54 "@var{eof-object}; if the string was filled without encountering\n"
55 "a delimiter, this value is @code{#f}.")
56 #define FUNC_NAME s_scm_read_delimited_x
65 SCM_VALIDATE_STRING (1, delims
);
66 cdelims
= scm_i_string_chars (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
++)
83 for (k
= 0; k
< num_delims
; k
++)
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
));
104 static unsigned char *
105 scm_do_read_line (SCM port
, size_t *len_p
)
107 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
110 /* I thought reading lines was simple. Mercy me. */
112 /* The common case: the buffer contains a complete line.
113 This needs to be fast. */
114 if ((end
= memchr (pt
->read_pos
, '\n', (pt
->read_end
- pt
->read_pos
)))
117 size_t buf_len
= (end
+ 1) - pt
->read_pos
;
118 /* Allocate a buffer of the perfect size. */
119 unsigned char *buf
= scm_malloc (buf_len
+ 1);
121 memcpy (buf
, pt
->read_pos
, buf_len
);
122 pt
->read_pos
+= buf_len
;
130 /* The buffer contains no newlines. */
132 /* When live, len is always the number of characters in the
133 current buffer that are part of the current line. */
134 size_t len
= (pt
->read_end
- pt
->read_pos
);
135 size_t buf_size
= (len
< 50) ? 60 : len
* 2;
136 /* Invariant: buf always has buf_size + 1 characters allocated;
137 the `+ 1' is for the final '\0'. */
138 unsigned char *buf
= scm_malloc (buf_size
+ 1);
143 if (buf_len
+ len
> buf_size
)
145 size_t new_size
= (buf_len
+ len
) * 2;
146 buf
= scm_realloc (buf
, new_size
+ 1);
150 /* Copy what we've got out of the port, into our buffer. */
151 memcpy (buf
+ buf_len
, pt
->read_pos
, len
);
155 /* If we had seen a newline, we're done now. */
159 /* Get more characters. */
160 if (scm_fill_input (port
) == EOF
)
162 /* If we're missing a final newline in the file, return
163 what we did get, sans newline. */
171 /* Search the buffer for newlines. */
172 if ((end
= memchr (pt
->read_pos
, '\n',
173 (len
= (pt
->read_end
- pt
->read_pos
))))
175 len
= (end
- pt
->read_pos
) + 1;
178 /* I wonder how expensive this realloc is. */
179 buf
= scm_realloc (buf
, buf_len
+ 1);
189 * truncates any terminating newline from its input, and returns
190 * a cons of the string read and its terminating character. Doing
191 * so makes it easy to implement the hairy `read-line' options
192 * efficiently in Scheme.
195 SCM_DEFINE (scm_read_line
, "%read-line", 0, 1, 0,
197 "Read a newline-terminated line from @var{port}, allocating storage as\n"
198 "necessary. The newline terminator (if any) is removed from the string,\n"
199 "and a pair consisting of the line and its delimiter is returned. The\n"
200 "delimiter may be either a newline or the @var{eof-object}; if\n"
201 "@code{%read-line} is called at the end of file, it returns the pair\n"
202 "@code{(#<eof> . #<eof>)}.")
203 #define FUNC_NAME s_scm_read_line
210 if (SCM_UNBNDP (port
))
211 port
= scm_current_input_port ();
212 SCM_VALIDATE_OPINPORT (1,port
);
214 pt
= SCM_PTAB_ENTRY (port
);
215 if (pt
->rw_active
== SCM_PORT_WRITE
)
216 scm_ptobs
[SCM_PTOBNUM (port
)].flush (port
);
218 s
= (char *) scm_do_read_line (port
, &slen
);
221 term
= line
= SCM_EOF_VAL
;
224 if (s
[slen
-1] == '\n')
226 term
= SCM_MAKE_CHAR ('\n');
228 line
= scm_take_locale_stringn (s
, slen
-1);
233 /* Fix: we should check for eof on the port before assuming this. */
235 line
= scm_take_locale_stringn (s
, slen
);
236 SCM_COL (port
) += slen
;
241 pt
->rw_active
= SCM_PORT_READ
;
243 return scm_cons (line
, term
);
247 SCM_DEFINE (scm_write_line
, "write-line", 1, 1, 0,
249 "Display @var{obj} and a newline character to @var{port}. If\n"
250 "@var{port} is not specified, @code{(current-output-port)} is\n"
251 "used. This function is equivalent to:\n"
253 "(display obj [port])\n"
256 #define FUNC_NAME s_scm_write_line
258 scm_display (obj
, port
);
259 return scm_newline (port
);
264 scm_init_rdelim_builtins (void)
266 #include "libguile/rdelim.x"
268 return SCM_UNSPECIFIED
;
272 scm_init_rdelim (void)
274 scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
275 scm_init_rdelim_builtins
);