/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- * 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ * 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ * 2014, 2015 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
#include <io.h>
#endif
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#endif
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
ptobnum = scm_c_port_type_add_x (desc);
/* Make a class object if GOOPS is present. */
- if (SCM_UNPACK (scm_port_class[0]) != 0)
+ if (SCM_UNPACK (scm_i_port_class[0]) != 0)
scm_make_port_classes (ptobnum, name);
return scm_tc7_port + ptobnum * 256;
static SCM cur_inport_fluid = SCM_BOOL_F;
static SCM cur_outport_fluid = SCM_BOOL_F;
static SCM cur_errport_fluid = SCM_BOOL_F;
+static SCM cur_warnport_fluid = SCM_BOOL_F;
static SCM cur_loadport_fluid = SCM_BOOL_F;
SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
- (),
+ (void),
"Return the current input port. This is the default port used\n"
"by many input procedures. Initially, @code{current-input-port}\n"
"returns the @dfn{standard input} in Unix and C terminology.")
#undef FUNC_NAME
SCM_DEFINE (scm_current_output_port, "current-output-port", 0, 0, 0,
- (),
+ (void),
"Return the current output port. This is the default port used\n"
"by many output procedures. Initially,\n"
"@code{current-output-port} returns the @dfn{standard output} in\n"
#undef FUNC_NAME
SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
- (),
+ (void),
"Return the port to which errors and warnings should be sent (the\n"
"@dfn{standard error} in Unix and C terminology).")
#define FUNC_NAME s_scm_current_error_port
}
#undef FUNC_NAME
-static SCM current_warning_port_var;
-static scm_i_pthread_once_t current_warning_port_once = SCM_I_PTHREAD_ONCE_INIT;
-
-static void
-init_current_warning_port_var (void)
-{
- current_warning_port_var
- = scm_c_private_variable ("guile", "current-warning-port");
-}
-
-SCM
-scm_current_warning_port (void)
+SCM_DEFINE (scm_current_warning_port, "current-warning-port", 0, 0, 0,
+ (void),
+ "Return the port to which diagnostic warnings should be sent.")
+#define FUNC_NAME s_scm_current_warning_port
{
- scm_i_pthread_once (¤t_warning_port_once,
- init_current_warning_port_var);
- return scm_call_0 (scm_variable_ref (current_warning_port_var));
+ if (scm_is_true (cur_warnport_fluid))
+ return scm_fluid_ref (cur_warnport_fluid);
+ else
+ return SCM_BOOL_F;
}
+#undef FUNC_NAME
SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
(),
SCM
scm_set_current_warning_port (SCM port)
+#define FUNC_NAME "set-current-warning-port"
{
- scm_i_pthread_once (¤t_warning_port_once,
- init_current_warning_port_var);
- return scm_call_1 (scm_variable_ref (current_warning_port_var), port);
+ SCM owarnp = scm_fluid_ref (cur_warnport_fluid);
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_VALIDATE_OPOUTPORT (1, port);
+ scm_fluid_set_x (cur_warnport_fluid, port);
+ return owarnp;
}
+#undef FUNC_NAME
void
if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8)
{
- if (c < 0xf0)
+ if (c < 0x80)
{
result_buf[0] = (char) c;
result = result_buf;
free (result);
if (c == '\n')
- {
- /* What should col be in this case?
- * We'll leave it at -1.
- */
- SCM_LINUM (port) -= 1;
- }
- else
- SCM_COL(port) -= 1;
+ SCM_LINUM (port) -= 1;
+ SCM_DECCOL (port);
}
#undef FUNC_NAME
cur_inport_fluid = scm_make_fluid ();
cur_outport_fluid = scm_make_fluid ();
cur_errport_fluid = scm_make_fluid ();
+ cur_warnport_fluid = scm_make_fluid ();
cur_loadport_fluid = scm_make_fluid ();
scm_i_port_weak_set = scm_c_make_weak_set (31);
scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
scm_c_define ("%current-output-port-fluid", cur_outport_fluid);
scm_c_define ("%current-error-port-fluid", cur_errport_fluid);
+ scm_c_define ("%current-warning-port-fluid", cur_warnport_fluid);
}
/*