X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/ae2fa5bc81407b0d7591f2b801c7ecf0ae0dc0ae..cda139a7912f2a2d3ca9bab52bf16d41ce4d643f:/libguile/ioext.c

diff --git a/libguile/ioext.c b/libguile/ioext.c
index 7914b4877..bcf0cd500 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -12,7 +12,8 @@
  * 
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
  *
  * As a special exception, the Free Software Foundation gives permission
  * for additional uses of the text contained in its release of GUILE.
@@ -36,13 +37,11 @@
  *
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  
- */
+ * If you do not wish that, delete this exception notice.  */
 
 
 
 #include <stdio.h>
-#include "fd.h"
 #include "_scm.h"
 #include "genio.h"
 #include "read.h"
@@ -118,13 +117,13 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end)
     {  
       int k;
 
-      c = scm_gen_getc (port);
+      c = scm_getc (port);
       for (k = 0; k < num_delims; k++)
 	{
 	  if (cdelims[k] == c)
 	    {
 	      if (SCM_FALSEP (gobble))
-		scm_gen_ungetc (c, port);
+		scm_ungetc (c, port);
 
 	      return scm_cons (SCM_MAKICHR (c),
 			       scm_long2num (j - cstart));
@@ -139,6 +138,55 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end)
   return scm_cons (SCM_BOOL_F, scm_long2num (j - cstart));
 }
 
+/*
+ * %read-line uses a port's fgets method for fast line i/o.  It
+ * truncates any terminating newline from its input, and returns
+ * a cons of the string read and its terminating character.  Doing
+ * so makes it easy to implement the hairy `read-line' options
+ * efficiently in Scheme.
+ */
+
+SCM_PROC (s_read_line, "%read-line", 0, 1, 0, scm_read_line);
+
+SCM
+scm_read_line (port)
+     SCM port;
+{
+  char *s;
+  int slen;
+  SCM line, term;
+
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    {
+      SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
+		  port, SCM_ARG1, s_read_line);
+    }
+
+  s = scm_do_read_line (port, &slen);
+
+  if (s == NULL)
+    term = line = SCM_EOF_VAL;
+  else
+    {
+      if (s[slen-1] == '\n')
+	{
+	  term = SCM_MAKICHR ('\n');
+	  line = scm_makfromstr (s, slen-1, 0);
+	}
+      else
+	{
+	  /* Fix: we should check for eof on the port before assuming this. */
+	  term = SCM_EOF_VAL;
+	  line = scm_makfromstr (s, slen, 0);
+	}	  
+      free (s);
+    }
+
+  return scm_cons (line, term);
+}
+
 SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
 
 SCM 
@@ -153,16 +201,28 @@ scm_write_line (obj, port)
 SCM_PROC (s_ftell, "ftell", 1, 0, 0, scm_ftell);
 
 SCM 
-scm_ftell (port)
-     SCM port;
+scm_ftell (object)
+     SCM object;
 {
   long pos;
-  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_ftell);
-  SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port)));
+
+  object = SCM_COERCE_OUTPORT (object);
+
+  SCM_DEFER_INTS;
+  if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+    {
+      SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (object)));
+      if (pos > 0 && SCM_CRDYP (object))
+	pos--;
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_ftell);
+      SCM_SYSCALL (pos = lseek (SCM_INUM (object), 0, SEEK_CUR));
+    }
   if (pos < 0)
     scm_syserror (s_ftell);
-  if (pos > 0 && SCM_CRDYP (port))
-    pos--;
+  SCM_ALLOW_INTS;
   return scm_long2num (pos);
 }
 
@@ -171,29 +231,35 @@ scm_ftell (port)
 SCM_PROC (s_fseek, "fseek", 3, 0, 0, scm_fseek);
 
 SCM 
-scm_fseek (port, offset, whence)
-     SCM port;
+scm_fseek (object, offset, whence)
+     SCM object;
      SCM offset;
      SCM whence;
 {
   int rv;
   long loff;
 
-  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fseek);
+  object = SCM_COERCE_OUTPORT (object);
+
   loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
-  SCM_ASSERT (SCM_INUMP (whence) && (SCM_INUM (whence) < 3) && (SCM_INUM (whence) >= 0),
-	  whence, SCM_ARG3, s_fseek);
-  
-  SCM_CLRDY (port);			/* Clear ungetted char */
-  /* Values of whence are interned in scm_init_ioext.  */
-  rv = fseek ((FILE *)SCM_STREAM (port), loff, SCM_INUM (whence));
-  if (rv != 0)
+  SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek);
+  SCM_DEFER_INTS;
+  if (SCM_NIMP (object) && SCM_OPFPORTP (object))
+    {
+      SCM_CLRDY (object);			/* Clear ungetted char */
+      rv = fseek ((FILE *)SCM_STREAM (object), loff, SCM_INUM (whence));
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (object), object, SCM_ARG1, s_fseek);
+      rv = lseek (SCM_INUM (object), loff, SCM_INUM (whence));
+    }
+  if (rv < 0)
     scm_syserror (s_fseek);
+  SCM_ALLOW_INTS;
   return SCM_UNSPECIFIED;
 }
 
-
-
 SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen);
 
 SCM 
@@ -207,6 +273,10 @@ scm_freopen (filename, modes, port)
 	      SCM_ARG1, s_freopen);
   SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
 	      s_freopen);
+
+  SCM_COERCE_SUBSTR (filename);
+  SCM_COERCE_SUBSTR (modes);
+  port = SCM_COERCE_OUTPORT (port);
   SCM_DEFER_INTS;
   SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_freopen);
   SCM_SYSCALL (f = freopen (SCM_ROCHARS (filename), SCM_ROCHARS (modes),
@@ -231,68 +301,25 @@ scm_freopen (filename, modes, port)
   return port;
 }
 
-
-
-SCM_PROC (s_duplicate_port, "duplicate-port", 2, 0, 0, scm_duplicate_port);
-
-SCM 
-scm_duplicate_port (oldpt, modes)
-     SCM oldpt;
-     SCM modes;
-{
-  int oldfd;
-  int newfd;
-  FILE *f;
-  SCM newpt;
-  SCM_ASSERT (SCM_NIMP (oldpt) && SCM_OPPORTP (oldpt), oldpt, SCM_ARG1,
-	      s_duplicate_port);
-  SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
-	      s_duplicate_port);
-  SCM_NEWCELL (newpt);
-  SCM_DEFER_INTS;
-  oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
-  if (oldfd == -1)
-    scm_syserror (s_duplicate_port);
-  SCM_SYSCALL (newfd = dup (oldfd));
-  if (newfd == -1)
-    scm_syserror (s_duplicate_port);
-  f = fdopen (newfd, SCM_ROCHARS (modes));
-  if (!f)
-    {
-      SCM_SYSCALL (close (newfd));
-      scm_syserror (s_duplicate_port);
-    }
-  {
-    struct scm_port_table * pt;
-    pt = scm_add_to_port_table (newpt);
-    SCM_SETPTAB_ENTRY (newpt, pt);
-    SCM_SETCAR (newpt, scm_tc16_fport | scm_mode_bits (SCM_ROCHARS (modes)));
-    if (SCM_BUF0 & SCM_CAR (newpt))
-      scm_setbuf0 (newpt);
-    SCM_SETSTREAM (newpt, (SCM)f);
-    SCM_PTAB_ENTRY (newpt)->file_name = SCM_PTAB_ENTRY (oldpt)->file_name;
-  }
-  SCM_ALLOW_INTS;
-  return newpt;
-}
-
-
-
 SCM_PROC (s_redirect_port, "redirect-port", 2, 0, 0, scm_redirect_port);
 
 SCM 
-scm_redirect_port (into_pt, from_pt)
-     SCM into_pt;
-     SCM from_pt;
+scm_redirect_port (old, new)
+     SCM old;
+     SCM new;
 {
   int ans, oldfd, newfd;
+
+  old = SCM_COERCE_OUTPORT (old);
+  new = SCM_COERCE_OUTPORT (new);
+
   SCM_DEFER_INTS;
-  SCM_ASSERT (SCM_NIMP (into_pt) && SCM_OPPORTP (into_pt), into_pt, SCM_ARG1, s_redirect_port);
-  SCM_ASSERT (SCM_NIMP (from_pt) && SCM_OPPORTP (from_pt), from_pt, SCM_ARG2, s_redirect_port);
-  oldfd = fileno ((FILE *)SCM_STREAM (into_pt));
+  SCM_ASSERT (SCM_NIMP (old) && SCM_OPPORTP (old), old, SCM_ARG1, s_redirect_port);
+  SCM_ASSERT (SCM_NIMP (new) && SCM_OPPORTP (new), new, SCM_ARG2, s_redirect_port);
+  oldfd = fileno ((FILE *)SCM_STREAM (old));
   if (oldfd == -1)
     scm_syserror (s_redirect_port);
-  newfd = fileno ((FILE *)SCM_STREAM (from_pt));
+  newfd = fileno ((FILE *)SCM_STREAM (new));
   if (newfd == -1)
     scm_syserror (s_redirect_port);
   SCM_SYSCALL (ans = dup2 (oldfd, newfd));
@@ -302,6 +329,49 @@ scm_redirect_port (into_pt, from_pt)
   return SCM_UNSPECIFIED;
 }
 
+SCM_PROC (s_dup_to_fdes, "dup->fdes", 1, 1, 0, scm_dup_to_fdes);
+SCM 
+scm_dup_to_fdes (SCM fd_or_port, SCM fd)
+{
+  int oldfd, newfd, rv;
+
+  fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
+
+  SCM_DEFER_INTS;
+  if (SCM_INUMP (fd_or_port))
+    oldfd = SCM_INUM (fd_or_port);
+  else
+    {
+      SCM_ASSERT (SCM_NIMP (fd_or_port) && SCM_OPPORTP (fd_or_port),
+		  fd_or_port, SCM_ARG1, s_dup_to_fdes);
+      oldfd = fileno ((FILE *)SCM_STREAM (fd_or_port));
+      if (oldfd == -1)
+	scm_syserror (s_dup_to_fdes);
+    }
+
+  if (SCM_UNBNDP (fd))
+    {
+      SCM_SYSCALL (newfd = dup (oldfd));
+      if (newfd == -1)
+	scm_syserror (s_dup_to_fdes);
+      fd = SCM_MAKINUM (newfd);
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_dup_to_fdes);
+      newfd = SCM_INUM (fd);
+      if (oldfd != newfd)
+	{
+	  scm_evict_ports (newfd);	/* see scsh manual.  */
+	  SCM_SYSCALL (rv = dup2 (oldfd, newfd));
+	  if (rv == -1)
+	    scm_syserror (s_dup_to_fdes);
+	}
+    }
+  SCM_ALLOW_INTS;
+  return fd;
+}
+
 SCM_PROC (s_fileno, "fileno", 1, 0, 0, scm_fileno);
 
 SCM 
@@ -309,6 +379,9 @@ scm_fileno (port)
      SCM port;
 {
   int fd;
+
+  port = SCM_COERCE_OUTPORT (port);
+
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_fileno);
   fd = fileno ((FILE *)SCM_STREAM (port));
   if (fd == -1)
@@ -323,6 +396,9 @@ scm_isatty_p (port)
      SCM port;
 {
   int rv;
+
+  port = SCM_COERCE_OUTPORT (port);
+
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_isatty);
   rv = fileno ((FILE *)SCM_STREAM (port));
   if (rv == -1)
@@ -347,6 +423,7 @@ scm_fdopen (fdes, modes)
   SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_fdopen);
   SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
 	      s_fdopen);
+  SCM_COERCE_SUBSTR (modes);
   SCM_NEWCELL (port);
   SCM_DEFER_INTS;
   f = fdopen (SCM_INUM (fdes), SCM_ROCHARS (modes));
@@ -355,9 +432,9 @@ scm_fdopen (fdes, modes)
   pt = scm_add_to_port_table (port);
   SCM_SETPTAB_ENTRY (port, pt);
   SCM_SETCAR (port, scm_tc16_fport | scm_mode_bits (SCM_ROCHARS (modes)));
+  SCM_SETSTREAM (port, (SCM)f);
   if (SCM_BUF0 & SCM_CAR (port))
     scm_setbuf0 (port);
-  SCM_SETSTREAM (port, (SCM)f);
   SCM_ALLOW_INTS;
   return port;
 }
@@ -381,6 +458,8 @@ scm_primitive_move_to_fdes (port, fd)
   int new_fd;
   int rv;
 
+  port = SCM_COERCE_OUTPORT (port);
+
   SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_primitive_move_to_fdes);
   SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_primitive_move_to_fdes);
   SCM_DEFER_INTS;
@@ -402,49 +481,6 @@ scm_primitive_move_to_fdes (port, fd)
   return SCM_BOOL_T;
 }
 
-
-void
-scm_setfileno (fs, fd)
-     FILE *fs;
-     int fd;
-{
-#ifdef SET_FILE_FD_FIELD
-  SET_FILE_FD_FIELD(fs, fd);
-#else
-  Configure could not guess the name of the correct field in a FILE *.
-
-  This function needs to be ported to your system.
-
-  SET_FILE_FD_FIELD should change the descriptor refered to by a stdio
-  stream, and nothing else.
-
-  The way to port this file is to add cases to configure.in.  Search
-  that file for "SET_FILE_FD_FIELD" and follow the examples there.
-#endif
-}
-
-/* Move ports with the specified file descriptor to new descriptors,
- * reseting the revealed count to 0.
- * Should be called with SCM_DEFER_INTS active.
- */
-
-void
-scm_evict_ports (fd)
-     int fd;
-{
-  int i;
-
-  for (i = 0; i < scm_port_table_size; i++)
-    {
-      if (SCM_FPORTP (scm_port_table[i]->port)
-	  && fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd)
-	{
-	  scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd));
-	  scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0));
-	}
-    }
-}
-
 /* Return a list of ports using a given file descriptor.  */
 SCM_PROC(s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports);