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_port_t
*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_must_malloc (buf_len
+ 1, "%read-line");
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_must_malloc (buf_size
+ 1, "%read-line");
163 if (buf_len
+ len
> buf_size
)
165 size_t new_size
= (buf_len
+ len
) * 2;
166 buf
= scm_must_realloc (buf
, buf_size
+ 1, new_size
+ 1,
171 /* Copy what we've got out of the port, into our buffer. */
172 memcpy (buf
+ buf_len
, pt
->read_pos
, len
);
176 /* If we had seen a newline, we're done now. */
180 /* Get more characters. */
181 if (scm_fill_input (port
) == EOF
)
183 /* If we're missing a final newline in the file, return
184 what we did get, sans newline. */
192 /* Search the buffer for newlines. */
193 if ((end
= memchr (pt
->read_pos
, '\n',
194 (len
= (pt
->read_end
- pt
->read_pos
))))
196 len
= (end
- pt
->read_pos
) + 1;
199 /* I wonder how expensive this realloc is. */
200 buf
= scm_must_realloc (buf
, buf_size
+ 1, buf_len
+ 1, "%read-line");
210 * truncates any terminating newline from its input, and returns
211 * a cons of the string read and its terminating character. Doing
212 * so makes it easy to implement the hairy `read-line' options
213 * efficiently in Scheme.
216 SCM_DEFINE (scm_read_line
, "%read-line", 0, 1, 0,
218 "Read a newline-terminated line from @var{port}, allocating storage as\n"
219 "necessary. The newline terminator (if any) is removed from the string,\n"
220 "and a pair consisting of the line and its delimiter is returned. The\n"
221 "delimiter may be either a newline or the @var{eof-object}; if\n"
222 "@code{%read-line} is called at the end of file, it returns the pair\n"
223 "@code{(#<eof> . #<eof>)}.")
224 #define FUNC_NAME s_scm_read_line
231 if (SCM_UNBNDP (port
))
233 SCM_VALIDATE_OPINPORT (1,port
);
235 pt
= SCM_PTAB_ENTRY (port
);
236 if (pt
->rw_active
== SCM_PORT_WRITE
)
237 scm_ptobs
[SCM_PTOBNUM (port
)].flush (port
);
239 s
= (char *) scm_do_read_line (port
, &slen
);
242 term
= line
= SCM_EOF_VAL
;
245 if (s
[slen
-1] == '\n')
247 term
= SCM_MAKE_CHAR ('\n');
249 line
= scm_take_str (s
, slen
-1);
255 /* Fix: we should check for eof on the port before assuming this. */
257 line
= scm_take_str (s
, slen
);
258 SCM_COL (port
) += slen
;
263 pt
->rw_active
= SCM_PORT_READ
;
265 return scm_cons (line
, term
);
269 SCM_DEFINE (scm_write_line
, "write-line", 1, 1, 0,
271 "Display @var{obj} and a newline character to @var{port}. If\n"
272 "@var{port} is not specified, @code{(current-output-port)} is\n"
273 "used. This function is equivalent to:\n"
275 "(display obj [port])\n"
278 #define FUNC_NAME s_scm_write_line
280 scm_display (obj
, port
);
281 return scm_newline (port
);
286 scm_init_rdelim_builtins (void)
288 #ifndef SCM_MAGIC_SNARFER
289 #include "libguile/rdelim.x"
292 return SCM_UNSPECIFIED
;
296 scm_init_rdelim (void)
298 scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
299 scm_init_rdelim_builtins
);