libguile/rdelim.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
   2  *
   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)
   6  * any later version.
   7  *
   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.
  12  *
  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
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  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.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  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.
  37  *
  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.
  41
  42  * This is the C part of the module for delimited I/O.  It's
  43  * similar to (scsh rdelim) but somewhat incompatible.  */
  44
  45 #include "libguile/_scm.h"
  46
  47 #include <stdio.h>
  48
  49 #ifdef HAVE_STRING_H
  50 #include <string.h>
  51 #endif
  52
  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"
  61
  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"
  73             "\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
  80 {
  81   size_t j;
  82   char *buf;
  83   size_t cstart;
  84   size_t cend;
  85   int c;
  86   char *cdelims;
  87   size_t num_delims;
  88
  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,
  92                                     6, end, cend);
  93   if (SCM_UNBNDP (port))
  94     port = scm_cur_inp;
  95   else
  96     SCM_VALIDATE_OPINPORT (4,port);
  97
  98   for (j = cstart; j < cend; j++)
  99     {
 100       size_t k;
 101
 102       c = scm_getc (port);
 103       for (k = 0; k < num_delims; k++)
 104         {
 105           if (cdelims[k] == c)
 106             {
 107               if (SCM_FALSEP (gobble))
 108                 scm_ungetc (c, port);
 109
 110               return scm_cons (SCM_MAKE_CHAR (c),
 111                                scm_long2num (j - cstart));
 112             }
 113         }
 114       if (c == EOF)
 115         return scm_cons (SCM_EOF_VAL,
 116                          scm_long2num (j - cstart));
 117
 118       buf[j] = c;
 119     }
 120   return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart));
 121 }
 122 #undef FUNC_NAME
 123
 124 static unsigned char *
 125 scm_do_read_line (SCM port, size_t *len_p)
 126 {
 127   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 128   unsigned char *end;
 129
 130   /* I thought reading lines was simple.  Mercy me.  */
 131
 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)))
 135            != 0)
 136     {
 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);
 140
 141       memcpy (buf, pt->read_pos, buf_len);
 142       pt->read_pos += buf_len;
 143
 144       buf[buf_len] = '\0';
 145
 146       *len_p = buf_len;
 147       return buf;
 148     }
 149
 150   /* The buffer contains no newlines.  */
 151   {
 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);
 159     size_t buf_len = 0;
 160
 161     for (;;)
 162       {
 163         if (buf_len + len > buf_size)
 164           {
 165             size_t new_size = (buf_len + len) * 2;
 166             buf = scm_realloc (buf, new_size + 1);
 167             buf_size = new_size;
 168           }
 169
 170         /* Copy what we've got out of the port, into our buffer.  */
 171         memcpy (buf + buf_len, pt->read_pos, len);
 172         buf_len += len;
 173         pt->read_pos += len;
 174
 175         /* If we had seen a newline, we're done now.  */
 176         if (end)
 177           break;
 178
 179         /* Get more characters.  */
 180         if (scm_fill_input (port) == EOF)
 181           {
 182             /* If we're missing a final newline in the file, return
 183                what we did get, sans newline.  */
 184             if (buf_len > 0)
 185               break;
 186
 187             free (buf);
 188             return 0;
 189           }
 190
 191         /* Search the buffer for newlines.  */
 192         if ((end = memchr (pt->read_pos, '\n',
 193                            (len = (pt->read_end - pt->read_pos))))
 194             != 0)
 195           len = (end - pt->read_pos) + 1;
 196       }
 197
 198     /* I wonder how expensive this realloc is.  */
 199     buf = scm_realloc (buf, buf_len + 1);
 200     buf[buf_len] = '\0';
 201     *len_p = buf_len;
 202     return buf;
 203   }
 204 }
 205
 206
 207 /*
 208  * %read-line
 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.
 213  */
 214
 215 SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
 216             (SCM port),
 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
 224 {
 225   scm_t_port *pt;
 226   char *s;
 227   size_t slen;
 228   SCM line, term;
 229
 230   if (SCM_UNBNDP (port))
 231     port = scm_cur_inp;
 232   SCM_VALIDATE_OPINPORT (1,port);
 233
 234   pt = SCM_PTAB_ENTRY (port);
 235   if (pt->rw_active == SCM_PORT_WRITE)
 236     scm_ptobs[SCM_PTOBNUM (port)].flush (port);
 237
 238   s = (char *) scm_do_read_line (port, &slen);
 239
 240   if (s == NULL)
 241     term = line = SCM_EOF_VAL;
 242   else
 243     {
 244       if (s[slen-1] == '\n')
 245         {
 246           term = SCM_MAKE_CHAR ('\n');
 247           s[slen-1] = '\0';
 248           line = scm_take_str (s, slen-1);
 249           SCM_INCLINE (port);
 250         }
 251       else
 252         {
 253           /* Fix: we should check for eof on the port before assuming this. */
 254           term = SCM_EOF_VAL;
 255           line = scm_take_str (s, slen);
 256           SCM_COL (port) += slen;
 257         }
 258     }
 259
 260   if (pt->rw_random)
 261     pt->rw_active = SCM_PORT_READ;
 262
 263   return scm_cons (line, term);
 264 }
 265 #undef FUNC_NAME
 266
 267 SCM_DEFINE (scm_write_line, "write-line", 1, 1, 0,
 268             (SCM obj, SCM port),
 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"
 272             "@lisp\n"
 273             "(display obj [port])\n"
 274             "(newline [port])\n"
 275             "@end lisp")
 276 #define FUNC_NAME s_scm_write_line
 277 {
 278   scm_display (obj, port);
 279   return scm_newline (port);
 280 }
 281 #undef FUNC_NAME
 282
 283 SCM
 284 scm_init_rdelim_builtins (void)
 285 {
 286 #ifndef SCM_MAGIC_SNARFER
 287 #include "libguile/rdelim.x"
 288 #endif
 289
 290   return SCM_UNSPECIFIED;
 291 }
 292
 293 void
 294 scm_init_rdelim (void)
 295 {
 296   scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
 297                       scm_init_rdelim_builtins);
 298 }
 299
 300 /*
 301   Local Variables:
 302   c-file-style: "gnu"
 303   End:
 304 */