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_must_malloc (buf_len + 1, "%read-line");
 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_must_malloc (buf_size + 1, "%read-line");
 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_must_realloc (buf, buf_size + 1, new_size + 1,
 167                                     "%read-line");
 168             buf_size = new_size;
 169           }
 170
 171         /* Copy what we've got out of the port, into our buffer.  */
 172         memcpy (buf + buf_len, pt->read_pos, len);
 173         buf_len += len;
 174         pt->read_pos += len;
 175
 176         /* If we had seen a newline, we're done now.  */
 177         if (end)
 178           break;
 179
 180         /* Get more characters.  */
 181         if (scm_fill_input (port) == EOF)
 182           {
 183             /* If we're missing a final newline in the file, return
 184                what we did get, sans newline.  */
 185             if (buf_len > 0)
 186               break;
 187
 188             free (buf);
 189             return 0;
 190           }
 191
 192         /* Search the buffer for newlines.  */
 193         if ((end = memchr (pt->read_pos, '\n',
 194                            (len = (pt->read_end - pt->read_pos))))
 195             != 0)
 196           len = (end - pt->read_pos) + 1;
 197       }
 198
 199     /* I wonder how expensive this realloc is.  */
 200     buf = scm_must_realloc (buf, buf_size + 1, buf_len + 1, "%read-line");
 201     buf[buf_len] = '\0';
 202     *len_p = buf_len;
 203     return buf;
 204   }
 205 }
 206
 207
 208 /*
 209  * %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.
 214  */
 215
 216 SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
 217             (SCM port),
 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
 225 {
 226   scm_t_port *pt;
 227   char *s;
 228   size_t slen;
 229   SCM line, term;
 230
 231   if (SCM_UNBNDP (port))
 232     port = scm_cur_inp;
 233   SCM_VALIDATE_OPINPORT (1,port);
 234
 235   pt = SCM_PTAB_ENTRY (port);
 236   if (pt->rw_active == SCM_PORT_WRITE)
 237     scm_ptobs[SCM_PTOBNUM (port)].flush (port);
 238
 239   s = (char *) scm_do_read_line (port, &slen);
 240
 241   if (s == NULL)
 242     term = line = SCM_EOF_VAL;
 243   else
 244     {
 245       if (s[slen-1] == '\n')
 246         {
 247           term = SCM_MAKE_CHAR ('\n');
 248           s[slen-1] = '\0';
 249           line = scm_take_str (s, slen-1);
 250           scm_done_free (1);
 251           SCM_INCLINE (port);
 252         }
 253       else
 254         {
 255           /* Fix: we should check for eof on the port before assuming this. */
 256           term = SCM_EOF_VAL;
 257           line = scm_take_str (s, slen);
 258           SCM_COL (port) += slen;
 259         }
 260     }
 261
 262   if (pt->rw_random)
 263     pt->rw_active = SCM_PORT_READ;
 264
 265   return scm_cons (line, term);
 266 }
 267 #undef FUNC_NAME
 268
 269 SCM_DEFINE (scm_write_line, "write-line", 1, 1, 0,
 270             (SCM obj, SCM port),
 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"
 274             "@lisp\n"
 275             "(display obj [port])\n"
 276             "(newline [port])\n"
 277             "@end lisp")
 278 #define FUNC_NAME s_scm_write_line
 279 {
 280   scm_display (obj, port);
 281   return scm_newline (port);
 282 }
 283 #undef FUNC_NAME
 284
 285 SCM
 286 scm_init_rdelim_builtins (void)
 287 {
 288 #ifndef SCM_MAGIC_SNARFER
 289 #include "libguile/rdelim.x"
 290 #endif
 291
 292   return SCM_UNSPECIFIED;
 293 }
 294
 295 void
 296 scm_init_rdelim (void)
 297 {
 298   scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
 299                       scm_init_rdelim_builtins);
 300 }
 301
 302 /*
 303   Local Variables:
 304   c-file-style: "gnu"
 305   End:
 306 */