* * backtrace.c (scm_display_application): New procedure:

[bpt/guile.git] / libguile / fports.c

diff --git a/libguile/fports.c b/libguile/fports.c
index 874fce2..57e9ab8 100644 (file)
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/*     Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -95,12 +95,10 @@ scm_setbuf0 (port)
 {
 #ifndef NOSETBUF
 #ifndef MSDOS
-#ifdef FIONREAD
 #ifndef ultrix
   SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0););
 #endif
 #endif
-#endif
 #endif
   return SCM_UNSPECIFIED;
 }
@@ -159,10 +157,13 @@ scm_open_file (filename, modes)
   SCM_SYSCALL (f = fopen (file, mode));
   if (!f)
     {
+      int en = errno;
+
       scm_syserror_msg (s_open_file, "%s: %S",
                        scm_listify (scm_makfrom0str (strerror (errno)),
                                     filename,
-                                    SCM_UNDEFINED));
+                                    SCM_UNDEFINED),
+                       en);
     }
   else
     {
@@ -171,19 +172,54 @@ scm_open_file (filename, modes)
       pt = scm_add_to_port_table (port);
       SCM_SETPTAB_ENTRY (port, pt);
       SCM_SETCAR (port, scm_tc16_fport | scm_mode_bits (mode));
+      SCM_SETSTREAM (port, (SCM) f);
       if (SCM_BUF0 & SCM_CAR (port))
        scm_setbuf0 (port);
-      SCM_SETSTREAM (port, (SCM) f);
       SCM_PTAB_ENTRY (port)->file_name = filename;
     }
   SCM_ALLOW_INTS;
   return port;
 }
 
+
+/* Build a Scheme port from an open stdio port, FILE.
+   MODE indicates whether FILE is open for reading or writing; it uses
+      the same notation as open-file's second argument.
+   If NAME is non-zero, use it as the port's filename.
+
+   scm_stdio_to_port sets the revealed count for FILE's file
+   descriptor to 1, so that FILE won't be closed when the port object
+   is GC'd.  */
+SCM
+scm_stdio_to_port (file, mode, name)
+     FILE *file;
+     char *mode;
+     char *name;
+{
+  long mode_bits = scm_mode_bits (mode);
+  SCM port;
+  struct scm_port_table * pt;
+
+  SCM_NEWCELL (port);
+  SCM_DEFER_INTS;
+  {
+    pt = scm_add_to_port_table (port);
+    SCM_SETPTAB_ENTRY (port, pt);
+    SCM_SETCAR (port, (scm_tc16_fport | mode_bits));
+    SCM_SETSTREAM (port, (SCM) file);
+    if (SCM_BUF0 & SCM_CAR (port))
+      scm_setbuf0 (port);
+    SCM_PTAB_ENTRY (port)->file_name = scm_makfrom0str (name);
+  }
+  SCM_ALLOW_INTS;
+  scm_set_port_revealed_x (port, SCM_MAKINUM (1));
+  return port;
+}
+
+
 /* Return the mode flags from an open port.
  * Some modes such as "append" are only used when opening
- * a file and are not returned here.
- */
+ * a file and are not returned here.  */
 
 SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);