*** empty log message ***

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

diff --git a/libguile/strports.c b/libguile/strports.c
index 612d98b..107fedd 100644 (file)
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 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
@@ -279,12 +279,12 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
     scm_out_of_range (caller, pos);
   if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
     scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
-  SCM_NEWCELL (z);
+
   SCM_DEFER_INTS;
-  pt = scm_add_to_port_table (z);
-  SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
-  SCM_SETPTAB_ENTRY (z, pt);
+  z = scm_new_port_table_entry (scm_tc16_strport);
+  pt = SCM_PTAB_ENTRY(z);
   SCM_SETSTREAM (z, SCM_UNPACK (str));
+  SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
   pt->write_buf = pt->read_buf = SCM_STRING_UCHARS (str);
   pt->read_pos = pt->write_pos = pt->read_buf + SCM_INUM (pos);
   pt->write_buf_size = pt->read_buf_size = str_len;
@@ -440,6 +440,13 @@ scm_c_eval_string (const char *expr)
   return scm_eval_string (scm_makfrom0str (expr));
 }
 
+SCM
+scm_c_eval_string_in_module (const char *expr, SCM module)
+{
+  return scm_eval_string_in_module (scm_makfrom0str (expr), module);
+}
+
+
 static SCM
 inner_eval_string (void *data)
 {
@@ -459,21 +466,32 @@ inner_eval_string (void *data)
   return ans;
 }
 
-SCM_DEFINE (scm_eval_string, "eval-string", 1, 0, 0, 
-            (SCM string),
+SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, 
+            (SCM string, SCM module),
            "Evaluate @var{string} as the text representation of a Scheme\n"
            "form or forms, and return whatever value they produce.\n"
-           "Evaluation takes place in the environment returned by the\n"
-           "procedure @code{interaction-environment}.")
-#define FUNC_NAME s_scm_eval_string
+           "Evaluation takes place in the given module, or the current\n"
+            "module when no module is given.\n"
+            "While the code is evaluated, the given module is made the\n"
+           "current one.  The current module is restored when this\n"
+            "procedure returns.")
+#define FUNC_NAME s_scm_eval_string_in_module
 {
   SCM port = scm_mkstrport (SCM_INUM0, string, SCM_OPN | SCM_RDNG,
-                           "eval-string");
-  return scm_c_call_with_current_module (scm_interaction_environment (),
+                           FUNC_NAME);
+  if (SCM_UNBNDP (module))
+    module = scm_current_module ();
+  return scm_c_call_with_current_module (module,
                                         inner_eval_string, (void *)port);
 }
 #undef FUNC_NAME
 
+SCM
+scm_eval_string (SCM string)
+{
+  return scm_eval_string_in_module (string, SCM_UNDEFINED);
+}
+
 static scm_t_bits
 scm_make_stptob ()
 {
@@ -493,9 +511,7 @@ scm_init_strports ()
 {
   scm_tc16_strport = scm_make_stptob ();
 
-#ifndef SCM_MAGIC_SNARFER
 #include "libguile/strports.x"
-#endif
 }