123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224 |
- #ifdef HAVE_CONFIG_H
- # include <config.h>
- #endif
- #include "libguile/_scm.h"
- #include <stdio.h>
- #ifdef HAVE_STRING_H
- #include <string.h>
- #endif
- #include "libguile/chars.h"
- #include "libguile/modules.h"
- #include "libguile/ports.h"
- #include "libguile/rdelim.h"
- #include "libguile/root.h"
- #include "libguile/strings.h"
- #include "libguile/strports.h"
- #include "libguile/validate.h"
- SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
- (SCM delims, SCM str, SCM gobble, SCM port, SCM start, SCM end),
- "Read characters from @var{port} into @var{str} until one of the\n"
- "characters in the @var{delims} string is encountered. If\n"
- "@var{gobble} is true, discard the delimiter character;\n"
- "otherwise, leave it in the input stream for the next read. If\n"
- "@var{port} is not specified, use the value of\n"
- "@code{(current-input-port)}. If @var{start} or @var{end} are\n"
- "specified, store data only into the substring of @var{str}\n"
- "bounded by @var{start} and @var{end} (which default to the\n"
- "beginning and end of the string, respectively).\n"
- "\n"
- " Return a pair consisting of the delimiter that terminated the\n"
- "string and the number of characters read. If reading stopped\n"
- "at the end of file, the delimiter returned is the\n"
- "@var{eof-object}; if the string was filled without encountering\n"
- "a delimiter, this value is @code{#f}.")
- #define FUNC_NAME s_scm_read_delimited_x
- {
- size_t j;
- size_t cstart;
- size_t cend;
- scm_t_wchar c;
- size_t num_delims;
- SCM_VALIDATE_STRING (1, delims);
- num_delims = scm_i_string_length (delims);
- SCM_VALIDATE_STRING (2, str);
- scm_i_get_substring_spec (scm_i_string_length (str),
- start, &cstart, end, &cend);
- if (SCM_UNBNDP (port))
- port = scm_current_input_port ();
- else
- SCM_VALIDATE_OPINPORT (4, port);
- for (j = cstart; j < cend; j++)
- {
- size_t k;
- c = scm_getc_unlocked (port);
- for (k = 0; k < num_delims; k++)
- {
- if (scm_i_string_ref (delims, k) == c)
- {
- if (scm_is_false (gobble))
- scm_ungetc_unlocked (c, port);
- return scm_cons (SCM_MAKE_CHAR (c),
- scm_from_size_t (j - cstart));
- }
- }
- if (c == EOF)
- return scm_cons (SCM_EOF_VAL,
- scm_from_size_t (j - cstart));
- scm_c_string_set_x (str, j, SCM_MAKE_CHAR (c));
- }
- return scm_cons (SCM_BOOL_F, scm_from_size_t (j - cstart));
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
- (SCM port),
- "Read a newline-terminated line from @var{port}, allocating storage as\n"
- "necessary. The newline terminator (if any) is removed from the string,\n"
- "and a pair consisting of the line and its delimiter is returned. The\n"
- "delimiter may be either a newline or the @var{eof-object}; if\n"
- "@code{%read-line} is called at the end of file, it returns the pair\n"
- "@code{(#<eof> . #<eof>)}.")
- #define FUNC_NAME s_scm_read_line
- {
- #define LINE_BUFFER_SIZE 256
- SCM line, strings, result;
- scm_t_wchar buf[LINE_BUFFER_SIZE], delim;
- size_t index;
- if (SCM_UNBNDP (port))
- port = scm_current_input_port ();
- SCM_VALIDATE_OPINPORT (1,port);
- index = 0;
- delim = 0;
- strings = SCM_BOOL_F;
- do
- {
- if (SCM_UNLIKELY (index >= LINE_BUFFER_SIZE))
- {
-
- strings = scm_cons (scm_from_utf32_stringn (buf, index),
- scm_is_false (strings) ? SCM_EOL : strings);
- index = 0;
- }
- else
- {
- buf[index] = scm_getc_unlocked (port);
- switch (buf[index])
- {
- case EOF:
- case '\n':
- delim = buf[index];
- break;
- default:
- index++;
- }
- }
- }
- while (delim == 0);
- if (SCM_LIKELY (scm_is_false (strings)))
-
- line = scm_from_utf32_stringn (buf, index);
- else
- {
-
- strings = scm_cons (scm_from_utf32_stringn (buf, index), strings);
- line = scm_string_concatenate (scm_reverse (strings));
- }
- if (delim == EOF && scm_i_string_length (line) == 0)
- result = scm_cons (SCM_EOF_VAL, SCM_EOF_VAL);
- else
- result = scm_cons (line,
- delim == EOF ? SCM_EOF_VAL : SCM_MAKE_CHAR (delim));
- return result;
- #undef LINE_BUFFER_SIZE
- }
- #undef FUNC_NAME
- SCM_DEFINE (scm_write_line, "write-line", 1, 1, 0,
- (SCM obj, SCM port),
- "Display @var{obj} and a newline character to @var{port}. If\n"
- "@var{port} is not specified, @code{(current-output-port)} is\n"
- "used. This function is equivalent to:\n"
- "@lisp\n"
- "(display obj [port])\n"
- "(newline [port])\n"
- "@end lisp")
- #define FUNC_NAME s_scm_write_line
- {
- scm_display (obj, port);
- return scm_newline (port);
- }
- #undef FUNC_NAME
- SCM
- scm_init_rdelim_builtins (void)
- {
- #include "libguile/rdelim.x"
- return SCM_UNSPECIFIED;
- }
- void
- scm_init_rdelim (void)
- {
- scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
- scm_init_rdelim_builtins);
- }
|