libguile/rdelim.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library 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 GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  16  */
  17
  18 #if HAVE_CONFIG_H
  19 #  include <config.h>
  20 #endif
  21
  22 #include "libguile/_scm.h"
  23
  24 #include <stdio.h>
  25
  26 #ifdef HAVE_STRING_H
  27 #include <string.h>
  28 #endif
  29
  30 #include "libguile/chars.h"
  31 #include "libguile/modules.h"
  32 #include "libguile/ports.h"
  33 #include "libguile/rdelim.h"
  34 #include "libguile/root.h"
  35 #include "libguile/strings.h"
  36 #include "libguile/strports.h"
  37 #include "libguile/validate.h"
  38
  39 SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
  40             (SCM delims, SCM str, SCM gobble, SCM port, SCM start, SCM end),
  41             "Read characters from @var{port} into @var{str} until one of the\n"
  42             "characters in the @var{delims} string is encountered.  If\n"
  43             "@var{gobble} is true, discard the delimiter character;\n"
  44             "otherwise, leave it in the input stream for the next read.  If\n"
  45             "@var{port} is not specified, use the value of\n"
  46             "@code{(current-input-port)}.  If @var{start} or @var{end} are\n"
  47             "specified, store data only into the substring of @var{str}\n"
  48             "bounded by @var{start} and @var{end} (which default to the\n"
  49             "beginning and end of the string, respectively).\n"
  50             "\n"
  51             " Return a pair consisting of the delimiter that terminated the\n"
  52             "string and the number of characters read.  If reading stopped\n"
  53             "at the end of file, the delimiter returned is the\n"
  54             "@var{eof-object}; if the string was filled without encountering\n"
  55             "a delimiter, this value is @code{#f}.")
  56 #define FUNC_NAME s_scm_read_delimited_x
  57 {
  58   size_t j;
  59   char *buf;
  60   size_t cstart;
  61   size_t cend;
  62   int c;
  63   char *cdelims;
  64   size_t num_delims;
  65
  66   SCM_VALIDATE_STRING_COPY (1, delims, cdelims);
  67   num_delims = SCM_STRING_LENGTH (delims);
  68   SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str, buf, 5, start, cstart,
  69                                     6, end, cend);
  70   if (SCM_UNBNDP (port))
  71     port = scm_cur_inp;
  72   else
  73     SCM_VALIDATE_OPINPORT (4,port);
  74
  75   for (j = cstart; j < cend; j++)
  76     {
  77       size_t k;
  78
  79       c = scm_getc (port);
  80       for (k = 0; k < num_delims; k++)
  81         {
  82           if (cdelims[k] == c)
  83             {
  84               if (SCM_FALSEP (gobble))
  85                 scm_ungetc (c, port);
  86
  87               return scm_cons (SCM_MAKE_CHAR (c),
  88                                scm_long2num (j - cstart));
  89             }
  90         }
  91       if (c == EOF)
  92         return scm_cons (SCM_EOF_VAL,
  93                          scm_long2num (j - cstart));
  94
  95       buf[j] = c;
  96     }
  97   return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart));
  98 }
  99 #undef FUNC_NAME
 100
 101 static unsigned char *
 102 scm_do_read_line (SCM port, size_t *len_p)
 103 {
 104   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 105   unsigned char *end;
 106
 107   /* I thought reading lines was simple.  Mercy me.  */
 108
 109   /* The common case: the buffer contains a complete line.
 110      This needs to be fast.  */
 111   if ((end = memchr (pt->read_pos, '\n', (pt->read_end - pt->read_pos)))
 112            != 0)
 113     {
 114       size_t buf_len = (end + 1) - pt->read_pos;
 115       /* Allocate a buffer of the perfect size.  */
 116       unsigned char *buf = scm_malloc (buf_len + 1);
 117
 118       memcpy (buf, pt->read_pos, buf_len);
 119       pt->read_pos += buf_len;
 120
 121       buf[buf_len] = '\0';
 122
 123       *len_p = buf_len;
 124       return buf;
 125     }
 126
 127   /* The buffer contains no newlines.  */
 128   {
 129     /* When live, len is always the number of characters in the
 130        current buffer that are part of the current line.  */
 131     size_t len = (pt->read_end - pt->read_pos);
 132     size_t buf_size = (len < 50) ? 60 : len * 2;
 133     /* Invariant: buf always has buf_size + 1 characters allocated;
 134        the `+ 1' is for the final '\0'.  */
 135     unsigned char *buf = scm_malloc (buf_size + 1);
 136     size_t buf_len = 0;
 137
 138     for (;;)
 139       {
 140         if (buf_len + len > buf_size)
 141           {
 142             size_t new_size = (buf_len + len) * 2;
 143             buf = scm_realloc (buf, new_size + 1);
 144             buf_size = new_size;
 145           }
 146
 147         /* Copy what we've got out of the port, into our buffer.  */
 148         memcpy (buf + buf_len, pt->read_pos, len);
 149         buf_len += len;
 150         pt->read_pos += len;
 151
 152         /* If we had seen a newline, we're done now.  */
 153         if (end)
 154           break;
 155
 156         /* Get more characters.  */
 157         if (scm_fill_input (port) == EOF)
 158           {
 159             /* If we're missing a final newline in the file, return
 160                what we did get, sans newline.  */
 161             if (buf_len > 0)
 162               break;
 163
 164             free (buf);
 165             return 0;
 166           }
 167
 168         /* Search the buffer for newlines.  */
 169         if ((end = memchr (pt->read_pos, '\n',
 170                            (len = (pt->read_end - pt->read_pos))))
 171             != 0)
 172           len = (end - pt->read_pos) + 1;
 173       }
 174
 175     /* I wonder how expensive this realloc is.  */
 176     buf = scm_realloc (buf, buf_len + 1);
 177     buf[buf_len] = '\0';
 178     *len_p = buf_len;
 179     return buf;
 180   }
 181 }
 182
 183
 184 /*
 185  * %read-line
 186  * truncates any terminating newline from its input, and returns
 187  * a cons of the string read and its terminating character.  Doing
 188  * so makes it easy to implement the hairy `read-line' options
 189  * efficiently in Scheme.
 190  */
 191
 192 SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
 193             (SCM port),
 194             "Read a newline-terminated line from @var{port}, allocating storage as\n"
 195             "necessary.  The newline terminator (if any) is removed from the string,\n"
 196             "and a pair consisting of the line and its delimiter is returned.  The\n"
 197             "delimiter may be either a newline or the @var{eof-object}; if\n"
 198             "@code{%read-line} is called at the end of file, it returns the pair\n"
 199             "@code{(#<eof> . #<eof>)}.")
 200 #define FUNC_NAME s_scm_read_line
 201 {
 202   scm_t_port *pt;
 203   char *s;
 204   size_t slen;
 205   SCM line, term;
 206
 207   if (SCM_UNBNDP (port))
 208     port = scm_cur_inp;
 209   SCM_VALIDATE_OPINPORT (1,port);
 210
 211   pt = SCM_PTAB_ENTRY (port);
 212   if (pt->rw_active == SCM_PORT_WRITE)
 213     scm_ptobs[SCM_PTOBNUM (port)].flush (port);
 214
 215   s = (char *) scm_do_read_line (port, &slen);
 216
 217   if (s == NULL)
 218     term = line = SCM_EOF_VAL;
 219   else
 220     {
 221       if (s[slen-1] == '\n')
 222         {
 223           term = SCM_MAKE_CHAR ('\n');
 224           s[slen-1] = '\0';
 225           line = scm_take_str (s, slen-1);
 226           SCM_INCLINE (port);
 227         }
 228       else
 229         {
 230           /* Fix: we should check for eof on the port before assuming this. */
 231           term = SCM_EOF_VAL;
 232           line = scm_take_str (s, slen);
 233           SCM_COL (port) += slen;
 234         }
 235     }
 236
 237   if (pt->rw_random)
 238     pt->rw_active = SCM_PORT_READ;
 239
 240   return scm_cons (line, term);
 241 }
 242 #undef FUNC_NAME
 243
 244 SCM_DEFINE (scm_write_line, "write-line", 1, 1, 0,
 245             (SCM obj, SCM port),
 246             "Display @var{obj} and a newline character to @var{port}.  If\n"
 247             "@var{port} is not specified, @code{(current-output-port)} is\n"
 248             "used.  This function is equivalent to:\n"
 249             "@lisp\n"
 250             "(display obj [port])\n"
 251             "(newline [port])\n"
 252             "@end lisp")
 253 #define FUNC_NAME s_scm_write_line
 254 {
 255   scm_display (obj, port);
 256   return scm_newline (port);
 257 }
 258 #undef FUNC_NAME
 259
 260 SCM
 261 scm_init_rdelim_builtins (void)
 262 {
 263 #include "libguile/rdelim.x"
 264
 265   return SCM_UNSPECIFIED;
 266 }
 267
 268 void
 269 scm_init_rdelim (void)
 270 {
 271   scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
 272                       scm_init_rdelim_builtins);
 273 }
 274
 275 /*
 276   Local Variables:
 277   c-file-style: "gnu"
 278   End:
 279 */