Updated
[bpt/guile.git] / libguile / ports.c
index 5a80114..a4d3d04 100644 (file)
@@ -204,6 +204,7 @@ scm_set_current_output_port (port)
      SCM port;
 {
   SCM ooutp = scm_cur_outp;
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_output_port);
   scm_cur_outp = port;
   return ooutp;
@@ -217,6 +218,7 @@ scm_set_current_error_port (port)
      SCM port;
 {
   SCM oerrp = scm_cur_errp;
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_error_port);
   scm_cur_errp = port;
   return oerrp;
@@ -244,8 +246,8 @@ scm_add_to_port_table (port)
     {
       scm_port_table = ((struct scm_port_table **)
                        realloc ((char *) scm_port_table,
-                                (long) (sizeof (struct scm_port_table)
-                                        * scm_port_table_room * 2)));
+                                (scm_sizet) (sizeof (struct scm_port_table *)
+                                             * scm_port_table_room * 2)));
       /* !!! error checking */
       scm_port_table_room *= 2;
     }
@@ -256,7 +258,7 @@ scm_add_to_port_table (port)
   scm_port_table[scm_port_table_size]->revealed = 0;
   scm_port_table[scm_port_table_size]->stream = 0;
   scm_port_table[scm_port_table_size]->file_name = SCM_BOOL_F;
-  scm_port_table[scm_port_table_size]->line_number = 1;
+  scm_port_table[scm_port_table_size]->line_number = 0;
   scm_port_table[scm_port_table_size]->column_number = 0;
   return scm_port_table[scm_port_table_size++];
 }
@@ -331,6 +333,7 @@ SCM
 scm_port_revealed (port)
      SCM port;
 {
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed);
   return SCM_MAKINUM (scm_revealed_count (port));
 }
@@ -343,6 +346,7 @@ scm_set_port_revealed_x (port, rcount)
      SCM port;
      SCM rcount;
 {
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_set_port_revealed_x);
   SCM_ASSERT (SCM_INUMP (rcount), rcount, SCM_ARG2, s_set_port_revealed_x);
   SCM_DEFER_INTS;
@@ -382,6 +386,8 @@ scm_port_mode (port)
 {
   char modes[3];
   modes[0] = '\0';
+
+  port = SCM_COERCE_OUTPORT (port);
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);  
   if (SCM_CAR (port) & SCM_RDNG) {
     if (SCM_CAR (port) & SCM_WRTNG)
@@ -410,7 +416,10 @@ scm_close_port (port)
   scm_sizet i;
   int rv;
 
-  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_close_port);
+  port = SCM_COERCE_OUTPORT (port);
+
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1,
+             s_close_port);
   if (SCM_CLOSEDP (port))
     return SCM_BOOL_F;
   i = SCM_PTOBNUM (port);
@@ -447,7 +456,7 @@ scm_close_all_ports_except (ports)
 
       while (SCM_NNULLP (ports_ptr))
        {
-         SCM port = SCM_CAR (ports_ptr);
+         SCM port = SCM_COERCE_OUTPORT (SCM_CAR (ports_ptr));
          if (i == 0)
            SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_close_all_ports_except);
          if (port == thisport)
@@ -505,7 +514,10 @@ scm_force_output (port)
   if (SCM_UNBNDP (port))
  port = scm_cur_outp;
   else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_force_output);
+    {
+      port = SCM_COERCE_OUTPORT (port);
+      SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_force_output);
+    }
   {
     scm_sizet i = SCM_PTOBNUM (port);
     SCM_SYSCALL ((scm_ptobs[i].fflush) (SCM_STREAM (port)));
@@ -576,47 +588,57 @@ scm_peek_char (port)
  * to ensure that you don't have to.
  */
 
-char * scm_generic_fgets SCM_P ((SCM port));
+char * scm_generic_fgets SCM_P ((SCM port, int *len));
 
 char *
-scm_generic_fgets (port)
+scm_generic_fgets (port, len)
      SCM port;
+     int *len;
 {
   SCM f                = SCM_STREAM (port);
   scm_sizet p  = SCM_PTOBNUM (port);
 
-  char *buf   = NULL;
-  int   i     = 0;     /* index into current buffer position */
+  char *buf;
   int   limit = 80;    /* current size of buffer */
   int   c;
 
-  if (feof ((FILE *)f))
-    return NULL;
+  /* FIXME: It would be nice to be able to check for EOF before anything. */
+
+  *len = 0;
+  buf = (char *) malloc (limit * sizeof(char));
 
-  buf = (char *) scm_must_malloc (limit * sizeof(char), "generic_fgets");
+  /* If a char has been pushed onto the port with scm_ungetc,
+     read that first. */
+  if (SCM_CRDYP (port))
+    {
+      buf[*len] = SCM_CGETUN (port);
+      SCM_CLRDY (port);
+      if (buf[(*len)++] == '\n')
+       {
+         buf[*len] = '\0';
+         return buf;
+       }
+    }
 
   while (1) {
-    if (i >= limit-1)
+    if (*len >= limit-1)
       {
-       buf = (char *) scm_must_realloc (buf,
-                                        sizeof(char) * limit,
-                                        sizeof(char) * limit * 2,
-                                        "generic_fgets");
+       buf = (char *) realloc (buf, sizeof(char) * limit * 2);
        limit *= 2;
       }
 
     c = (scm_ptobs[p].fgetc) (f);
     if (c != EOF)
-      buf[i++] = c;
+      buf[(*len)++] = c;
 
     if (c == EOF || c == '\n')
       {
-       if (i)
+       if (*len)
          {
-           buf[i] = '\0';
+           buf[*len] = '\0';
            return buf;
          }
-       scm_must_free (buf);
+       free (buf);
        return NULL;
       }
   }
@@ -645,111 +667,93 @@ scm_unread_char (cobj, port)
   return cobj;
 }
 
-SCM_PROC (s_port_line, "port-line", 0, 1, 0, scm_port_line);
+SCM_PROC (s_port_line, "port-line", 1, 0, 0, scm_port_line);
 
 SCM 
 scm_port_line (port)
      SCM port;
 {
-  SCM p;
-  p = ((port == SCM_UNDEFINED)
-       ? scm_cur_inp
-       : port);
-  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
-    return SCM_BOOL_F;
-  else
-    return SCM_MAKINUM (SCM_LINUM (p));
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_port_line);
+  return SCM_MAKINUM (SCM_LINUM (port));
 }
 
-SCM_PROC (s_set_port_line_x, "set-port-line!", 1, 1, 0, scm_set_port_line_x);
+SCM_PROC (s_set_port_line_x, "set-port-line!", 2, 0, 0, scm_set_port_line_x);
 
 SCM 
 scm_set_port_line_x (port, line)
      SCM port;
      SCM line;
 {
-  if (line == SCM_UNDEFINED)
-    {
-      line = port;
-      port = scm_cur_inp;
-    }
-  else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
-               port,
-               SCM_ARG1,
-               s_set_port_line_x);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_set_port_line_x);
+  SCM_ASSERT (SCM_INUMP (line), line, SCM_ARG2, s_set_port_line_x);
   return SCM_PTAB_ENTRY (port)->line_number = SCM_INUM (line);
 }
 
-SCM_PROC (s_port_column, "port-column", 0, 1, 0, scm_port_column);
+SCM_PROC (s_port_column, "port-column", 1, 0, 0, scm_port_column);
 
 SCM
 scm_port_column  (port)
      SCM port;
 {
-  SCM p;
-  p = ((port == SCM_UNDEFINED)
-       ? scm_cur_inp
-       : port);
-  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
-    return SCM_BOOL_F;
-  else
-    return SCM_MAKINUM (SCM_COL (p));
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_port_column);
+  return SCM_MAKINUM (SCM_COL (port));
 }
 
-SCM_PROC (s_set_port_column_x, "set-port-column!", 1, 1, 0, scm_set_port_column_x);
+SCM_PROC (s_set_port_column_x, "set-port-column!", 2, 0, 0, scm_set_port_column_x);
 
 SCM 
 scm_set_port_column_x (port, column)
      SCM port;
      SCM column;
 {
-  if (column == SCM_UNDEFINED)
-    {
-      column = port;
-      port = scm_cur_inp;
-    }
-  else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
-               port,
-               SCM_ARG1,
-               s_set_port_column_x);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_set_port_column_x);
+  SCM_ASSERT (SCM_INUMP (column), column, SCM_ARG2, s_set_port_column_x);
   return SCM_PTAB_ENTRY (port)->column_number = SCM_INUM (column);
 }
 
-SCM_PROC (s_port_filename, "port-filename", 0, 1, 0, scm_port_filename);
+SCM_PROC (s_port_filename, "port-filename", 1, 0, 0, scm_port_filename);
 
 SCM 
 scm_port_filename (port)
      SCM port;
 {
-  SCM p;
-  p = ((port == SCM_UNDEFINED)
-       ? scm_cur_inp
-       : port);
-  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
-    return SCM_BOOL_F;
-  else
-    return SCM_PTAB_ENTRY (p)->file_name;
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_port_filename);
+  return SCM_PTAB_ENTRY (port)->file_name;
 }
 
-SCM_PROC (s_set_port_filename_x, "set-port-filename!", 1, 1, 0, scm_set_port_filename_x);
+SCM_PROC (s_set_port_filename_x, "set-port-filename!", 2, 0, 0, scm_set_port_filename_x);
 
 SCM 
 scm_set_port_filename_x (port, filename)
      SCM port;
      SCM filename;
 {
-  if (filename == SCM_UNDEFINED)
-    {
-      filename = port;
-      port = scm_cur_inp;
-    }
-  else
-    SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
-               port,
-               SCM_ARG1,
-               s_set_port_filename_x);
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port) && SCM_OPENP (port),
+             port,
+             SCM_ARG1,
+             s_set_port_filename_x);
+  /* We allow the user to set the filename to whatever he likes.  */
   return SCM_PTAB_ENTRY (port)->file_name = filename;
 }
 
@@ -861,7 +865,7 @@ getc_void_port (SCM strm)
 }
 
 static char *
-fgets_void_port (SCM strm)
+fgets_void_port (SCM strm, int *len)
 {
   return NULL;
 }