[uim commit] r4803 - in sigscheme-trunk: . src

[codesite-noreply]

Author: yamakenz
Date: Mon Aug  6 15:50:57 2007
New Revision: 4803

Modified:
   sigscheme-trunk/NEWS
   sigscheme-trunk/src/port.c
   sigscheme-trunk/src/sigscheme.h

Log:
* src/sigscheme.h
  - (scm_p_current_error_port, scm_p_set_current_input_portx,
    scm_p_set_current_output_portx, scm_p_set_current_error_portx): New
    function decl
* src/port.c
  - (scm_p_current_error_port, scm_p_set_current_input_portx,
    scm_p_set_current_output_portx, scm_p_set_current_error_portx): New
    function
* NEWS
  -- Update


Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS        (original)
+++ sigscheme-trunk/NEWS        Mon Aug  6 15:50:57 2007
@@ -27,6 +27,10 @@
   - New character codec procedures %%current-char-codec,
     %%set-current-char-codec! and with-char-codec
 
+  - New port handling procedures %%current-error-port,
+    %%set-current-input-port!, %%set-current-output-port!,
+    %%set-current-error-port!
+
   - New debugging procedures %%pair-mutable?, %%string-mutable?,
     %%vector-mutable?
 

Modified: sigscheme-trunk/src/port.c
==============================================================================
--- sigscheme-trunk/src/port.c  (original)
+++ sigscheme-trunk/src/port.c  Mon Aug  6 15:50:57 2007
@@ -331,6 +331,56 @@
     return scm_out;
 }
 
+SCM_EXPORT ScmObj
+scm_p_current_error_port(void)
+{
+    DECLARE_FUNCTION("%%current-error-port", procedure_fixed_0);
+
+    return scm_err;
+}
+
+SCM_EXPORT ScmObj
+scm_p_set_current_input_portx(ScmObj newport)
+{
+    DECLARE_FUNCTION("%%set-current-input-port!", procedure_fixed_1);
+
+    SCM_ENSURE_LIVE_PORT(newport);
+    if (!(SCM_PORT_FLAG(newport) & SCM_PORTFLAG_INPUT))
+        ERR_OBJ("input port required but got", newport);
+
+    scm_in = newport;
+
+    return SCM_TRUE;
+}
+
+SCM_EXPORT ScmObj
+scm_p_set_current_output_portx(ScmObj newport)
+{
+    DECLARE_FUNCTION("%%set-current-output-port!", procedure_fixed_1);
+
+    SCM_ENSURE_LIVE_PORT(newport);
+    if (!(SCM_PORT_FLAG(newport) & SCM_PORTFLAG_OUTPUT))
+        ERR_OBJ("output port required but got", newport);
+
+    scm_out = newport;
+
+    return SCM_TRUE;
+}
+
+SCM_EXPORT ScmObj
+scm_p_set_current_error_portx(ScmObj newport)
+{
+    DECLARE_FUNCTION("%%set-current-error-port!", procedure_fixed_1);
+
+    SCM_ENSURE_LIVE_PORT(newport);
+    if (!(SCM_PORT_FLAG(newport) & SCM_PORTFLAG_OUTPUT))
+        ERR_OBJ("output port required but got", newport);
+
+    scm_err = newport;
+
+    return SCM_TRUE;
+}
+
 /* TODO: dynamic environment for scm_in (although R5RS does not require it) */
 SCM_EXPORT ScmObj
 scm_p_with_input_from_file(ScmObj filepath, ScmObj thunk)

Modified: sigscheme-trunk/src/sigscheme.h
==============================================================================
--- sigscheme-trunk/src/sigscheme.h     (original)
+++ sigscheme-trunk/src/sigscheme.h     Mon Aug  6 15:50:57 2007
@@ -1588,6 +1588,10 @@
 SCM_EXPORT ScmObj scm_p_output_portp(ScmObj obj);
 SCM_EXPORT ScmObj scm_p_current_input_port(void);
 SCM_EXPORT ScmObj scm_p_current_output_port(void);
+SCM_EXPORT ScmObj scm_p_current_error_port(void);
+SCM_EXPORT ScmObj scm_p_set_current_input_portx(ScmObj newport);
+SCM_EXPORT ScmObj scm_p_set_current_output_portx(ScmObj newport);
+SCM_EXPORT ScmObj scm_p_set_current_error_portx(ScmObj newport);
 SCM_EXPORT ScmObj scm_p_with_input_from_file(ScmObj filepath, ScmObj thunk);
 SCM_EXPORT ScmObj scm_p_with_output_to_file(ScmObj filepath, ScmObj thunk);
 SCM_EXPORT ScmObj scm_p_open_input_file(ScmObj filepath);