diff options
author | Gary Houston <ghouston@arglist.com> | 2001-01-24 21:45:09 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 2001-01-24 21:45:09 +0000 |
commit | 6d36532c1c49cdb353c63275625c8343484107e9 (patch) | |
tree | 4ae00270b37f1686ef4786dcb030af94d0150a52 | |
parent | 1c8cbd62c5d9e8358cb5e5e4ce22f555a0995231 (diff) |
* boot-9.scm: don't import (ice-9 rdelim) here. it's done
in C for now.
* rdelim.scm: export the C primitives too.
* documentation.scm: use (ice-9 rdelim).
* filesys.c (scm_link): docstring fix.
* fports.h (scm_setfileno): obsolete declaration removed.
* posix.c: bogus popen declaration removed.
* rdelim.c: new file, split from ioext.c with new proc
scm_init_rdelim.
* rdelim.h: new file.
* Makefile.am: add rdelim.c and related files.
* init.c: call scm_init_rdelim. include rdelim.h.
-rw-r--r-- | ice-9/ChangeLog | 7 | ||||
-rw-r--r-- | ice-9/boot-9.scm | 5 | ||||
-rw-r--r-- | ice-9/documentation.scm | 1 | ||||
-rw-r--r-- | ice-9/rdelim.scm | 10 | ||||
-rw-r--r-- | libguile/ChangeLog | 11 | ||||
-rw-r--r-- | libguile/filesys.c | 12 | ||||
-rw-r--r-- | libguile/ioext.c | 233 | ||||
-rw-r--r-- | libguile/ioext.h | 6 | ||||
-rw-r--r-- | libguile/posix.c | 1 | ||||
-rw-r--r-- | libguile/rdelim.c | 311 | ||||
-rw-r--r-- | libguile/rdelim.h | 61 |
11 files changed, 407 insertions, 251 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 8b10caa3e..e4da0a6b0 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,10 @@ +2001-01-24 Gary Houston <ghouston@arglist.com> + + * boot-9.scm: don't import (ice-9 rdelim) here. it's done + in C for now. + * rdelim.scm: export the C primitives too. + * documentation.scm: use (ice-9 rdelim). + 2001-01-21 Gary Houston <ghouston@arglist.com> * rdelim.scm: new file implementing module (ice-9 rdelim). diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index d1e37185f..c929c0617 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2635,10 +2635,6 @@ -;; temporary, for backwards compatibility. -(use-modules (ice-9 rdelim)) - - (define using-readline? (let ((using-readline? (make-fluid))) (make-procedure-with-setter @@ -2723,3 +2719,4 @@ (define-module (guile)) (append! %load-path (cons "." ())) + diff --git a/ice-9/documentation.scm b/ice-9/documentation.scm index 3a7f1c24f..5ea3ecd84 100644 --- a/ice-9/documentation.scm +++ b/ice-9/documentation.scm @@ -17,6 +17,7 @@ ;;;; (define-module (ice-9 documentation) + :use-module (ice-9 rdelim) :no-backtrace) diff --git a/ice-9/rdelim.scm b/ice-9/rdelim.scm index c6d6b2aa8..9d961a0af 100644 --- a/ice-9/rdelim.scm +++ b/ice-9/rdelim.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1997 1999 2000 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1997, 1999, 2000, 2001 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -19,15 +19,13 @@ ;;;; -;;; Module for delimited I/O. This is similar to (scsh rdelim) but is -;;; somewhat incompatible. +;;; This is the Scheme part of the module for delimited I/O. It's +;;; similar to (scsh rdelim) but somewhat incompatible. (define-module (ice-9 rdelim)) (export read-line read-line! read-delimited read-delimited!) -;; TODO: split the C part of this module out of libguile and into its -;; own top-level directory. -;; (export read-string!/partial %read-delimited! %read-line write-line) +(export %read-delimited! %read-line write-line) ; C (define (read-line! string . maybe-port) ;; corresponds to SCM_LINE_INCREMENTORS in libguile. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 66e913e43..fb15ec74f 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,14 @@ +2001-01-24 Gary Houston <ghouston@arglist.com> + + * filesys.c (scm_link): docstring fix. + * fports.h (scm_setfileno): obsolete declaration removed. + * posix.c: bogus popen declaration removed. + + * rdelim.c: new file, split from ioext.c. + * rdelim.h: new file, split from ioext.h + * Makefile.am: add rdelim.c and related files. + * init.c: call scm_init_rdelim. include rdelim.h. + 2001-01-24 Dirk Herrmann <D.Herrmann@tu-bs.de> This patch was sent by Martin Grabmueller and makes sure that diff --git a/libguile/filesys.c b/libguile/filesys.c index 9ea6fca10..1b4fe2b68 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -557,9 +557,10 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0, SCM_DEFINE (scm_link, "link", 2, 0, 0, (SCM oldpath, SCM newpath), - "Creates a new name @var{path-to} in the file system for the file\n" - "named by @var{path-from}. If @var{path-from} is a symbolic link, the\n" - "link may or may not be followed depending on the system.") + "Creates a new name @var{newpath} in the file system for the\n" + "file named by @var{oldpath}. If @var{oldpath} is a symbolic\n" + "link, the link may or may not be followed depending on the\n" + "system.") #define FUNC_NAME s_scm_link { int val; @@ -568,7 +569,8 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0, SCM_STRING_COERCE_0TERMINATION_X (oldpath); SCM_VALIDATE_STRING (2, newpath); SCM_STRING_COERCE_0TERMINATION_X (newpath); - SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath))); + SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath), + SCM_STRING_CHARS (newpath))); if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -579,7 +581,7 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0, SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0, (SCM oldname, SCM newname), - "Renames the file specified by @var{path-from} to @var{path-to}.\n" + "Renames the file specified by @var{oldname} to @var{newname}.\n" "The return value is unspecified.") #define FUNC_NAME s_scm_rename { diff --git a/libguile/ioext.c b/libguile/ioext.c index 894982394..c3d976964 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -44,20 +44,14 @@ - -#include <stdio.h> #include "libguile/_scm.h" -#include "libguile/ports.h" -#include "libguile/read.h" +#include "libguile/ioext.h" #include "libguile/fports.h" -#include "libguile/unif.h" -#include "libguile/chars.h" #include "libguile/feature.h" +#include "libguile/ports.h" #include "libguile/root.h" #include "libguile/strings.h" - #include "libguile/validate.h" -#include "libguile/ioext.h" #include <fcntl.h> @@ -168,227 +162,6 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, } #undef FUNC_NAME -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 @var{gobble}\n" - "is true, discard the delimiter character; otherwise, leave it\n" - "in the input stream for the next read.\n" - "If @var{port} is not specified, use the value of\n" - "@code{(current-input-port)}. If @var{start} or @var{end} are specified,\n" - "store data only into the substring of @var{str} bounded by @var{start}\n" - "and @var{end} (which default to the beginning and end of the string,\n" - "respectively).\n\n" - "Return a pair consisting of the delimiter that terminated the string and\n" - "the number of characters read. If reading stopped at the end of file,\n" - "the delimiter returned is the @var{eof-object}; if the string was filled\n" - "without encountering a delimiter, this value is @var{#f}.") -#define FUNC_NAME s_scm_read_delimited_x -{ - long j; - char *buf; - long cstart; - long cend; - int c; - char *cdelims; - int num_delims; - - SCM_VALIDATE_STRING_COPY (1, delims, cdelims); - num_delims = SCM_STRING_LENGTH (delims); - SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 5, start, cstart, - 6, end, cend); - if (SCM_UNBNDP (port)) - port = scm_cur_inp; - else - SCM_VALIDATE_OPINPORT (4,port); - - for (j = cstart; j < cend; j++) - { - int k; - - c = scm_getc (port); - for (k = 0; k < num_delims; k++) - { - if (cdelims[k] == c) - { - if (SCM_FALSEP (gobble)) - scm_ungetc (c, port); - - return scm_cons (SCM_MAKE_CHAR (c), - scm_long2num (j - cstart)); - } - } - if (c == EOF) - return scm_cons (SCM_EOF_VAL, - scm_long2num (j - cstart)); - - buf[j] = c; - } - return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart)); -} -#undef FUNC_NAME - -static unsigned char * -scm_do_read_line (SCM port, int *len_p) -{ - scm_port *pt = SCM_PTAB_ENTRY (port); - unsigned char *end; - - /* I thought reading lines was simple. Mercy me. */ - - /* The common case: the buffer contains a complete line. - This needs to be fast. */ - if ((end = memchr (pt->read_pos, '\n', (pt->read_end - pt->read_pos))) - != 0) - { - int buf_len = (end + 1) - pt->read_pos; - /* Allocate a buffer of the perfect size. */ - unsigned char *buf = scm_must_malloc (buf_len + 1, "%read-line"); - - memcpy (buf, pt->read_pos, buf_len); - pt->read_pos += buf_len; - - buf[buf_len] = '\0'; - - *len_p = buf_len; - return buf; - } - - /* The buffer contains no newlines. */ - { - /* When live, len is always the number of characters in the - current buffer that are part of the current line. */ - int len = (pt->read_end - pt->read_pos); - int buf_size = (len < 50) ? 60 : len * 2; - /* Invariant: buf always has buf_size + 1 characters allocated; - the `+ 1' is for the final '\0'. */ - unsigned char *buf = scm_must_malloc (buf_size + 1, "%read-line"); - int buf_len = 0; - - for (;;) - { - if (buf_len + len > buf_size) - { - int new_size = (buf_len + len) * 2; - buf = scm_must_realloc (buf, buf_size + 1, new_size + 1, - "%read-line"); - buf_size = new_size; - } - - /* Copy what we've got out of the port, into our buffer. */ - memcpy (buf + buf_len, pt->read_pos, len); - buf_len += len; - pt->read_pos += len; - - /* If we had seen a newline, we're done now. */ - if (end) - break; - - /* Get more characters. */ - if (scm_fill_input (port) == EOF) - { - /* If we're missing a final newline in the file, return - what we did get, sans newline. */ - if (buf_len > 0) - break; - - free (buf); - return 0; - } - - /* Search the buffer for newlines. */ - if ((end = memchr (pt->read_pos, '\n', - (len = (pt->read_end - pt->read_pos)))) - != 0) - len = (end - pt->read_pos) + 1; - } - - /* I wonder how expensive this realloc is. */ - buf = scm_must_realloc (buf, buf_size + 1, buf_len + 1, "%read-line"); - buf[buf_len] = '\0'; - *len_p = buf_len; - return buf; - } -} - - -/* - * %read-line - * truncates any terminating newline from its input, and returns - * a cons of the string read and its terminating character. Doing - * so makes it easy to implement the hairy `read-line' options - * efficiently in Scheme. - */ - -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 -{ - scm_port *pt; - char *s; - int slen; - SCM line, term; - - if (SCM_UNBNDP (port)) - port = scm_cur_inp; - SCM_VALIDATE_OPINPORT (1,port); - - pt = SCM_PTAB_ENTRY (port); - if (pt->rw_active == SCM_PORT_WRITE) - scm_ptobs[SCM_PTOBNUM (port)].flush (port); - - s = (char *) scm_do_read_line (port, &slen); - - if (s == NULL) - term = line = SCM_EOF_VAL; - else - { - if (s[slen-1] == '\n') - { - term = SCM_MAKE_CHAR ('\n'); - s[slen-1] = '\0'; - line = scm_take_str (s, slen-1); - scm_done_malloc (-1); - SCM_INCLINE (port); - } - else - { - /* Fix: we should check for eof on the port before assuming this. */ - term = SCM_EOF_VAL; - line = scm_take_str (s, slen); - SCM_COL (port) += slen; - } - } - - if (pt->rw_random) - pt->rw_active = SCM_PORT_READ; - - return scm_cons (line, term); -} -#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 @var{port}\n" - "is not specified, @code{(current-output-port)} is used. This function\n" - "is equivalent to:\n\n" - "@smalllisp\n" - "(display obj [port])\n" - "(newline [port])\n" - "@end smalllisp") -#define FUNC_NAME s_scm_write_line -{ - scm_display (obj, port); - return scm_newline (port); -} -#undef FUNC_NAME - SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0, (SCM object), "Returns an integer representing the current position of @var{fd/port},\n" diff --git a/libguile/ioext.h b/libguile/ioext.h index 579da70e6..36f0ac49e 100644 --- a/libguile/ioext.h +++ b/libguile/ioext.h @@ -2,7 +2,7 @@ #ifndef IOEXTH #define IOEXTH -/* Copyright (C) 1995, 1996, 1997, 1998, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -50,10 +50,6 @@ extern SCM scm_read_string_x_partial (SCM str, SCM port_or_fdes, SCM start, SCM end); -extern SCM scm_read_delimited_x (SCM delims, SCM buf, SCM gobble, SCM port, - SCM offset, SCM length); -extern SCM scm_read_line (SCM port); -extern SCM scm_write_line (SCM obj, SCM port); extern SCM scm_ftell (SCM object); extern SCM scm_redirect_port (SCM into_pt, SCM from_pt); extern SCM scm_dup_to_fdes (SCM fd_or_port, SCM newfd); diff --git a/libguile/posix.c b/libguile/posix.c index a8e88fc31..cf8146b67 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -100,7 +100,6 @@ extern char *ttyname(); #include <signal.h> -extern FILE *popen (); extern char ** environ; #include <grp.h> diff --git a/libguile/rdelim.c b/libguile/rdelim.c new file mode 100644 index 000000000..f08df3c92 --- /dev/null +++ b/libguile/rdelim.c @@ -0,0 +1,311 @@ +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + + * This is the C part of the module for delimited I/O. It's + * similar to (scsh rdelim) but somewhat incompatible. */ + +#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 @var{gobble}\n" + "is true, discard the delimiter character; otherwise, leave it\n" + "in the input stream for the next read.\n" + "If @var{port} is not specified, use the value of\n" + "@code{(current-input-port)}. If @var{start} or @var{end} are specified,\n" + "store data only into the substring of @var{str} bounded by @var{start}\n" + "and @var{end} (which default to the beginning and end of the string,\n" + "respectively).\n\n" + "Return a pair consisting of the delimiter that terminated the string and\n" + "the number of characters read. If reading stopped at the end of file,\n" + "the delimiter returned is the @var{eof-object}; if the string was filled\n" + "without encountering a delimiter, this value is @var{#f}.") +#define FUNC_NAME s_scm_read_delimited_x +{ + long j; + char *buf; + long cstart; + long cend; + int c; + char *cdelims; + int num_delims; + + SCM_VALIDATE_STRING_COPY (1, delims, cdelims); + num_delims = SCM_STRING_LENGTH (delims); + SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 5, start, cstart, + 6, end, cend); + if (SCM_UNBNDP (port)) + port = scm_cur_inp; + else + SCM_VALIDATE_OPINPORT (4,port); + + for (j = cstart; j < cend; j++) + { + int k; + + c = scm_getc (port); + for (k = 0; k < num_delims; k++) + { + if (cdelims[k] == c) + { + if (SCM_FALSEP (gobble)) + scm_ungetc (c, port); + + return scm_cons (SCM_MAKE_CHAR (c), + scm_long2num (j - cstart)); + } + } + if (c == EOF) + return scm_cons (SCM_EOF_VAL, + scm_long2num (j - cstart)); + + buf[j] = c; + } + return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart)); +} +#undef FUNC_NAME + +static unsigned char * +scm_do_read_line (SCM port, int *len_p) +{ + scm_port *pt = SCM_PTAB_ENTRY (port); + unsigned char *end; + + /* I thought reading lines was simple. Mercy me. */ + + /* The common case: the buffer contains a complete line. + This needs to be fast. */ + if ((end = memchr (pt->read_pos, '\n', (pt->read_end - pt->read_pos))) + != 0) + { + int buf_len = (end + 1) - pt->read_pos; + /* Allocate a buffer of the perfect size. */ + unsigned char *buf = scm_must_malloc (buf_len + 1, "%read-line"); + + memcpy (buf, pt->read_pos, buf_len); + pt->read_pos += buf_len; + + buf[buf_len] = '\0'; + + *len_p = buf_len; + return buf; + } + + /* The buffer contains no newlines. */ + { + /* When live, len is always the number of characters in the + current buffer that are part of the current line. */ + int len = (pt->read_end - pt->read_pos); + int buf_size = (len < 50) ? 60 : len * 2; + /* Invariant: buf always has buf_size + 1 characters allocated; + the `+ 1' is for the final '\0'. */ + unsigned char *buf = scm_must_malloc (buf_size + 1, "%read-line"); + int buf_len = 0; + + for (;;) + { + if (buf_len + len > buf_size) + { + int new_size = (buf_len + len) * 2; + buf = scm_must_realloc (buf, buf_size + 1, new_size + 1, + "%read-line"); + buf_size = new_size; + } + + /* Copy what we've got out of the port, into our buffer. */ + memcpy (buf + buf_len, pt->read_pos, len); + buf_len += len; + pt->read_pos += len; + + /* If we had seen a newline, we're done now. */ + if (end) + break; + + /* Get more characters. */ + if (scm_fill_input (port) == EOF) + { + /* If we're missing a final newline in the file, return + what we did get, sans newline. */ + if (buf_len > 0) + break; + + free (buf); + return 0; + } + + /* Search the buffer for newlines. */ + if ((end = memchr (pt->read_pos, '\n', + (len = (pt->read_end - pt->read_pos)))) + != 0) + len = (end - pt->read_pos) + 1; + } + + /* I wonder how expensive this realloc is. */ + buf = scm_must_realloc (buf, buf_size + 1, buf_len + 1, "%read-line"); + buf[buf_len] = '\0'; + *len_p = buf_len; + return buf; + } +} + + +/* + * %read-line + * truncates any terminating newline from its input, and returns + * a cons of the string read and its terminating character. Doing + * so makes it easy to implement the hairy `read-line' options + * efficiently in Scheme. + */ + +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 +{ + scm_port *pt; + char *s; + int slen; + SCM line, term; + + if (SCM_UNBNDP (port)) + port = scm_cur_inp; + SCM_VALIDATE_OPINPORT (1,port); + + pt = SCM_PTAB_ENTRY (port); + if (pt->rw_active == SCM_PORT_WRITE) + scm_ptobs[SCM_PTOBNUM (port)].flush (port); + + s = (char *) scm_do_read_line (port, &slen); + + if (s == NULL) + term = line = SCM_EOF_VAL; + else + { + if (s[slen-1] == '\n') + { + term = SCM_MAKE_CHAR ('\n'); + s[slen-1] = '\0'; + line = scm_take_str (s, slen-1); + scm_done_malloc (-1); + SCM_INCLINE (port); + } + else + { + /* Fix: we should check for eof on the port before assuming this. */ + term = SCM_EOF_VAL; + line = scm_take_str (s, slen); + SCM_COL (port) += slen; + } + } + + if (pt->rw_random) + pt->rw_active = SCM_PORT_READ; + + return scm_cons (line, term); +} +#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 @var{port}\n" + "is not specified, @code{(current-output-port)} is used. This function\n" + "is equivalent to:\n\n" + "@smalllisp\n" + "(display obj [port])\n" + "(newline [port])\n" + "@end smalllisp") +#define FUNC_NAME s_scm_write_line +{ + scm_display (obj, port); + return scm_newline (port); +} +#undef FUNC_NAME + +void +scm_init_rdelim (void) +{ + SCM rdelim_module = scm_make_module (scm_read_0str ("(ice-9 rdelim)")); + SCM old_module = scm_select_module (rdelim_module); + +#ifndef SCM_MAGIC_SNARFER +#include "libguile/rdelim.x" +#endif + + scm_select_module (old_module); + +#if DEBUG_DEPRECATED == 0 + { + const char expr[] = "\ +(define-module (guile) :use-module (ice-9 rdelim))\ +(define-module (guile-user) :use-module (ice-9 rdelim))"; + + scm_eval_string (scm_makfromstr (expr, (sizeof expr) - 1, 0)); + } + scm_select_module (old_module); +#endif +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/rdelim.h b/libguile/rdelim.h new file mode 100644 index 000000000..1f27a1d17 --- /dev/null +++ b/libguile/rdelim.h @@ -0,0 +1,61 @@ +/* classes: h_files */ + +#ifndef SCM_RDELIM +#define SCM_RDELIM +/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + +#include "libguile/__scm.h" + +extern SCM scm_read_delimited_x (SCM delims, SCM buf, SCM gobble, SCM port, + SCM offset, SCM length); +extern SCM scm_read_line (SCM port); +extern SCM scm_write_line (SCM obj, SCM port); +void scm_init_rdelim (void); + +#endif + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ |