1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program 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
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice.
42 * This is the C part of the module for delimited I/O. It's
43 * similar to (scsh rdelim) but somewhat incompatible. */
45 #include "libguile/_scm.h"
53 #include "libguile/chars.h"
54 #include "libguile/modules.h"
55 #include "libguile/ports.h"
56 #include "libguile/rdelim.h"
57 #include "libguile/root.h"
58 #include "libguile/strings.h"
59 #include "libguile/strports.h"
60 #include "libguile/validate.h"
62 SCM_DEFINE (scm_read_delimited_x
, "%read-delimited!", 3, 3, 0,
63 (SCM delims
, SCM str
, SCM gobble
, SCM port
, SCM start
, SCM end
),
64 "Read characters from @var{port} into @var{str} until one of the\n"
65 "characters in the @var{delims} string is encountered. If\n"
66 "@var{gobble} is true, discard the delimiter character;\n"
67 "otherwise, leave it in the input stream for the next read. If\n"
68 "@var{port} is not specified, use the value of\n"
69 "@code{(current-input-port)}. If @var{start} or @var{end} are\n"
70 "specified, store data only into the substring of @var{str}\n"
71 "bounded by @var{start} and @var{end} (which default to the\n"
72 "beginning and end of the string, respectively).\n"
74 " Return a pair consisting of the delimiter that terminated the\n"
75 "string and the number of characters read. If reading stopped\n"
76 "at the end of file, the delimiter returned is the\n"
77 "@var{eof-object}; if the string was filled without encountering\n"
78 "a delimiter, this value is @code{#f}.")
79 #define FUNC_NAME s_scm_read_delimited_x
89 SCM_VALIDATE_STRING_COPY (1, delims
, cdelims
);
90 num_delims
= SCM_STRING_LENGTH (delims
);
91 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 5, start
, cstart
,
93 if (SCM_UNBNDP (port
))
96 SCM_VALIDATE_OPINPORT (4,port
);
98 for (j
= cstart
; j
< cend
; j
++)
103 for (k
= 0; k
< num_delims
; k
++)
107 if (SCM_FALSEP (gobble
))
108 scm_ungetc (c
, port
);
110 return scm_cons (SCM_MAKE_CHAR (c
),
111 scm_long2num (j
- cstart
));
115 return scm_cons (SCM_EOF_VAL
,
116 scm_long2num (j
- cstart
));
120 return scm_cons (SCM_BOOL_F
, scm_long2num (j
- cstart
));
124 static unsigned char *
125 scm_do_read_line (SCM port
, size_t *len_p
)
127 scm_t_port
*pt
= SCM_PTAB_ENTRY (port
);
130 /* I thought reading lines was simple. Mercy me. */
132 /* The common case: the buffer contains a complete line.
133 This needs to be fast. */
134 if ((end
= memchr (pt
->read_pos
, '\n', (pt
->read_end
- pt
->read_pos
)))
137 size_t buf_len
= (end
+ 1) - pt
->read_pos
;
138 /* Allocate a buffer of the perfect size. */
139 unsigned char *buf
= scm_malloc (buf_len
+ 1);
141 memcpy (buf
, pt
->read_pos
, buf_len
);
142 pt
->read_pos
+= buf_len
;
150 /* The buffer contains no newlines. */
152 /* When live, len is always the number of characters in the
153 current buffer that are part of the current line. */
154 size_t len
= (pt
->read_end
- pt
->read_pos
);
155 size_t buf_size
= (len
< 50) ? 60 : len
* 2;
156 /* Invariant: buf always has buf_size + 1 characters allocated;
157 the `+ 1' is for the final '\0'. */
158 unsigned char *buf
= scm_malloc (buf_size
+ 1);
163 if (buf_len
+ len
> buf_size
)
165 size_t new_size
= (buf_len
+ len
) * 2;
166 buf
= scm_realloc (buf
, new_size
+ 1);
170 /* Copy what we've got out of the port, into our buffer. */
171 memcpy (buf
+ buf_len
, pt
->read_pos
, len
);
175 /* If we had seen a newline, we're done now. */
179 /* Get more characters. */
180 if (scm_fill_input (port
) == EOF
)
182 /* If we're missing a final newline in the file, return
183 what we did get, sans newline. */
191 /* Search the buffer for newlines. */
192 if ((end
= memchr (pt
->read_pos
, '\n',
193 (len
= (pt
->read_end
- pt
->read_pos
))))
195 len
= (end
- pt
->read_pos
) + 1;
198 /* I wonder how expensive this realloc is. */
199 buf
= scm_realloc (buf
, buf_len
+ 1);
209 * truncates any terminating newline from its input, and returns
210 * a cons of the string read and its terminating character. Doing
211 * so makes it easy to implement the hairy `read-line' options
212 * efficiently in Scheme.
215 SCM_DEFINE (scm_read_line
, "%read-line", 0, 1, 0,
217 "Read a newline-terminated line from @var{port}, allocating storage as\n"
218 "necessary. The newline terminator (if any) is removed from the string,\n"
219 "and a pair consisting of the line and its delimiter is returned. The\n"
220 "delimiter may be either a newline or the @var{eof-object}; if\n"
221 "@code{%read-line} is called at the end of file, it returns the pair\n"
222 "@code{(#<eof> . #<eof>)}.")
223 #define FUNC_NAME s_scm_read_line
230 if (SCM_UNBNDP (port
))
232 SCM_VALIDATE_OPINPORT (1,port
);
234 pt
= SCM_PTAB_ENTRY (port
);
235 if (pt
->rw_active
== SCM_PORT_WRITE
)
236 scm_ptobs
[SCM_PTOBNUM (port
)].flush (port
);
238 s
= (char *) scm_do_read_line (port
, &slen
);
241 term
= line
= SCM_EOF_VAL
;
244 if (s
[slen
-1] == '\n')
246 term
= SCM_MAKE_CHAR ('\n');
248 line
= scm_take_str (s
, slen
-1);
253 /* Fix: we should check for eof on the port before assuming this. */
255 line
= scm_take_str (s
, slen
);
256 SCM_COL (port
) += slen
;
261 pt
->rw_active
= SCM_PORT_READ
;
263 return scm_cons (line
, term
);
267 SCM_DEFINE (scm_write_line
, "write-line", 1, 1, 0,
269 "Display @var{obj} and a newline character to @var{port}. If\n"
270 "@var{port} is not specified, @code{(current-output-port)} is\n"
271 "used. This function is equivalent to:\n"
273 "(display obj [port])\n"
276 #define FUNC_NAME s_scm_write_line
278 scm_display (obj
, port
);
279 return scm_newline (port
);
284 scm_init_rdelim_builtins (void)
286 #include "libguile/rdelim.x"
288 return SCM_UNSPECIFIED
;
292 scm_init_rdelim (void)
294 scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
295 scm_init_rdelim_builtins
);