libguile/genio.c

   1 /*      Copyright (C) 1995, 1996, 1997, 1998 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 \f
  42 #include <stdio.h>
  43 #include "_scm.h"
  44 #include "chars.h"
  45 #ifdef GUILE_ISELECT
  46 #include "filesys.h"
  47 #endif
  48
  49 #include "genio.h"
  50
  51 #ifdef HAVE_STRING_H
  52 #include <string.h>
  53 #endif
  54 \f
  55
  56 void
  57 scm_putc (c, port)
  58      int c;
  59      SCM port;
  60 {
  61   scm_sizet i = SCM_PTOBNUM (port);
  62   SCM_SYSCALL ((scm_ptobs[i].fputc) (c, port));
  63 }
  64
  65 void
  66 scm_puts (s, port)
  67      char *s;
  68      SCM port;
  69 {
  70   scm_sizet i = SCM_PTOBNUM (port);
  71   SCM_SYSCALL ((scm_ptobs[i].fputs) (s, port));
  72 }
  73
  74 void
  75 scm_lfwrite (ptr, size, port)
  76      char *ptr;
  77      scm_sizet size;
  78      SCM port;
  79 {
  80   scm_sizet i = SCM_PTOBNUM (port);
  81   SCM_SYSCALL (scm_ptobs[i].fwrite (ptr, size, 1, port));
  82 }
  83
  84
  85 void
  86 scm_fflush (port)
  87      SCM port;
  88 {
  89   scm_sizet i = SCM_PTOBNUM (port);
  90   (scm_ptobs[i].fflush) (port);
  91 }
  92
  93 \f
  94
  95 int
  96 scm_getc (port)
  97      SCM port;
  98 {
  99   SCM f;
 100   int c;
 101   scm_sizet i;
 102
 103   if (SCM_CRDYP (port))
 104     {
 105       c = SCM_CGETUN (port);
 106       SCM_TRY_CLRDY (port);         /* Clear ungetted char */
 107     }
 108   else
 109     {
 110       f = SCM_STREAM (port);
 111       i = SCM_PTOBNUM (port);
 112 #ifdef GUILE_ISELECT
 113       if (SCM_FPORTP (port) && !scm_input_waiting_p ((FILE *) f, "scm_getc"))
 114         {
 115           int n;
 116           SELECT_TYPE readfds;
 117           int fd = fileno ((FILE *) f);
 118           do
 119             {
 120               FD_ZERO (&readfds);
 121               FD_SET (fd, &readfds);
 122               n = scm_internal_select (fd + 1, &readfds, NULL, NULL, NULL);
 123             }
 124           while (n == -1 && errno == EINTR);
 125         }
 126 #endif
 127       SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (port));
 128     }
 129
 130   if (c == '\n')
 131     {
 132       SCM_INCLINE (port);
 133     }
 134   else if (c == '\t')
 135     {
 136       SCM_TABCOL (port);
 137     }
 138   else
 139     {
 140       SCM_INCCOL (port);
 141     }
 142
 143   return c;
 144 }
 145
 146
 147 void
 148 scm_ungetc (c, port)
 149      int c;
 150      SCM port;
 151 {
 152   SCM_CUNGET (c, port);
 153
 154   if (c == '\n')
 155     {
 156       /* What should col be in this case?
 157        * We'll leave it at -1.
 158        */
 159       SCM_LINUM (port) -= 1;
 160     }
 161   else
 162     SCM_COL(port) -= 1;
 163 }
 164
 165
 166 void
 167 scm_ungets (s, n, port)
 168      char *s;
 169      int n;
 170      SCM port;
 171 {
 172   /* This is simple minded and inefficient, but unreading strings is
 173    * probably not a common operation, and remember that line and
 174    * column numbers have to be handled...
 175    *
 176    * Please feel freee to write an optimized version!
 177    */
 178   while (n--)
 179     scm_ungetc (s[n], port);
 180 }
 181
 182
 183 char *
 184 scm_do_read_line (port, len)
 185      SCM port;
 186      int *len;
 187 {
 188   char *s;
 189   scm_sizet i;
 190
 191   i = SCM_PTOBNUM (port);
 192   SCM_SYSCALL (s = (scm_ptobs[i].fgets) (port, len));
 193
 194   /* We should never get an empty string.  Every line has a newline at
 195      the end, except for the last one.  If the last line has no
 196      newline and is empty, then that's just an ordinary EOF, and we
 197      should have s == NULL.  But this seems obscure to me, so we check
 198      this here, to protect ourselves from odd port implementations.  */
 199   if (s && *len <= 0)
 200     abort ();
 201
 202   /* If we're not at EOF, and there was a newline at the end of the
 203      string, increment the line counter.  */
 204   if (s && s[*len - 1] == '\n')
 205     SCM_INCLINE(port);
 206
 207   return s;
 208 }