-/* 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
*
* 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.
*
* 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. */
\f
#include <stdio.h>
#include "_scm.h"
#include "fports.h"
#include "strports.h"
#include "vports.h"
+#include "kw.h"
#include "ports.h"
\f
-SCM_PROC (s_ungetc_char_ready_p, "ungetc-char-ready?", 1, 0, 0, scm_ungetc_char_ready_p);
-
-SCM
-scm_ungetc_char_ready_p (port)
- SCM port;
-{
- if (SCM_UNBNDP (port))
- port = scm_cur_inp;
- else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_ungetc_char_ready_p);
- return (SCM_CRDYP (port)
- ? SCM_BOOL_T
- : SCM_BOOL_F);
-}
-
-
-\f
-
/* {Standard Ports}
*/
return SCM_UNSPECIFIED;
}
+/* Return the flags that characterize a port based on the mode
+ * string used to open a file for that port.
+ *
+ * See PORT FLAGS in scm.h
+ */
+
+long
+scm_mode_bits (modes)
+ char *modes;
+{
+ return (SCM_OPN
+ | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
+ | ( strchr (modes, 'w')
+ || strchr (modes, 'a')
+ || strchr (modes, '+') ? SCM_WRTNG : 0)
+ | (strchr (modes, '0') ? SCM_BUF0 : 0));
+}
+
+
+/* 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. */
+
+SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
+
+SCM
+scm_port_mode (port)
+ SCM port;
+{
+ char modes[3];
+ modes[0] = '\0';
+ 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)
+ strcpy (modes, "r+");
+ else
+ strcpy (modes, "r");
+ }
+ else if (SCM_CAR (port) & SCM_WRTNG)
+ strcpy (modes, "w");
+ if (SCM_CAR (port) & SCM_BUF0)
+ strcat (modes, "0");
+ return scm_makfromstr (modes, strlen (modes), 0);
+}
+
+
/* scm_close_port
* Call the close operation on a port object.
+ * see also scm_close.
*/
SCM_PROC(s_close_port, "close-port", 1, 0, 0, scm_close_port);
SCM port;
{
scm_sizet i;
+ int rv;
+
SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_close_port);
if (SCM_CLOSEDP (port))
- return SCM_UNSPECIFIED;
+ return SCM_BOOL_F;
i = SCM_PTOBNUM (port);
SCM_DEFER_INTS;
if (scm_ptobs[i].fclose)
- SCM_SYSCALL ((scm_ptobs[i].fclose) (SCM_STREAM (port)));
+ {
+ SCM_SYSCALL (rv = (scm_ptobs[i].fclose) (SCM_STREAM (port)));
+ /* ports with a closed file descriptor can be reclosed without error. */
+ if (rv < 0 && errno != EBADF)
+ scm_syserror (s_close_port);
+ }
+ else
+ rv = 0;
scm_remove_from_port_table (port);
SCM_SETAND_CAR (port, ~SCM_OPN);
SCM_ALLOW_INTS;
- return SCM_UNSPECIFIED;
+ return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
}
SCM_PROC(s_close_all_ports_except, "close-all-ports-except", 0, 0, 1, scm_close_all_ports_except);
}
}
+SCM_PROC (s_flush_all_ports, "flush-all-ports", 0, 0, 0, scm_flush_all_ports);
+SCM
+scm_flush_all_ports (void)
+{
+ int i;
+
+ for (i = 0; i < scm_port_table_size; i++)
+ {
+ SCM port = scm_port_table[i]->port;
+ if (SCM_OPOUTPORTP (port))
+ {
+ scm_sizet ptob = SCM_PTOBNUM (port);
+ (scm_ptobs[ptob].fflush) (SCM_STREAM (port));
+ }
+ }
+ return SCM_UNSPECIFIED;
+}
SCM_PROC(s_read_char, "read-char", 0, 1, 0, scm_read_char);
int scm_tc16_void_port = 0;
static int
-print_void_port (exp, port, writing)
- SCM exp;
- SCM port;
- int writing;
+print_void_port (SCM exp, SCM port, scm_print_state *pstate)
{
scm_prinport (exp, port, "void");
return 1;
}
static int
-putc_void_port (c, strm)
- int c;
- SCM strm;
+putc_void_port (int c, SCM strm)
{
return 0; /* vestigial return value */
}
static int
-puts_void_port (s, strm)
- char * s;
- SCM strm;
+puts_void_port (char *s, SCM strm)
{
return 0; /* vestigial return value */
}
static scm_sizet
-write_void_port (ptr, size, nitems, strm)
- void * ptr;
- int size;
- int nitems;
- SCM strm;
+write_void_port (char *ptr, scm_sizet size, scm_sizet nitems, SCM strm)
{
int len;
len = size * nitems;
}
-static int flush_void_port SCM_P ((SCM strm));
-
static int
-flush_void_port (strm)
- SCM strm;
+flush_void_port (SCM strm)
{
return 0;
}
-static int getc_void_port SCM_P ((SCM strm));
-
static int
-getc_void_port (strm)
- SCM strm;
+getc_void_port (SCM strm)
{
return EOF;
}
-static int close_void_port SCM_P ((SCM strm));
-
static int
-close_void_port (strm)
- SCM strm;
+close_void_port (SCM strm)
{
return 0; /* this is ignored by scm_close_port. */
}
-static int noop0 SCM_P ((SCM stream));
-
static int
-noop0 (stream)
- SCM stream;
+noop0 (SCM stream)
{
return 0;
}
scm_sys_make_void_port (mode)
SCM mode;
{
- SCM_ASSERT (SCM_NIMP (mode) && SCM_STRINGP (mode), mode,
+ SCM_ASSERT (SCM_NIMP (mode) && SCM_ROSTRINGP (mode), mode,
SCM_ARG1, s_sys_make_void_port);
+ SCM_COERCE_SUBSTR (mode);
return scm_void_port (SCM_ROCHARS (mode));
}
HCoop / bpt / guile.git / blobdiff