* gsubr.c (scm_gsubr_apply): Added dummy return to avoid compiler
[bpt/guile.git] / libguile / ioext.c
index 69515e9..bcf0cd5 100644 (file)
@@ -138,6 +138,14 @@ 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
@@ -145,6 +153,8 @@ scm_read_line (port)
      SCM port;
 {
   char *s;
+  int slen;
+  SCM line, term;
 
   if (SCM_UNBNDP (port))
     port = scm_cur_inp;
@@ -154,8 +164,27 @@ scm_read_line (port)
                  port, SCM_ARG1, s_read_line);
     }
 
-  s = scm_do_read_line (port);
-  return (s == NULL ? SCM_EOF_VAL : scm_makfrom0str (s));
+  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);
@@ -176,6 +205,9 @@ scm_ftell (object)
      SCM object;
 {
   long pos;
+
+  object = SCM_COERCE_OUTPORT (object);
+
   SCM_DEFER_INTS;
   if (SCM_NIMP (object) && SCM_OPFPORTP (object))
     {
@@ -207,6 +239,8 @@ scm_fseek (object, offset, whence)
   int rv;
   long loff;
 
+  object = SCM_COERCE_OUTPORT (object);
+
   loff = scm_num2long (offset, (char *)SCM_ARG2, s_fseek);
   SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_fseek);
   SCM_DEFER_INTS;
@@ -242,6 +276,7 @@ scm_freopen (filename, modes, port)
 
   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),
@@ -275,6 +310,9 @@ scm_redirect_port (old, new)
 {
   int ans, oldfd, newfd;
 
+  old = SCM_COERCE_OUTPORT (old);
+  new = SCM_COERCE_OUTPORT (new);
+
   SCM_DEFER_INTS;
   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);
@@ -297,6 +335,8 @@ 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);
@@ -339,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)
@@ -353,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)
@@ -412,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;