* validate.h (SCM_VALIDATE_OPOUTSTRPORT): New macro.

	* strports.h (SCM_STRPORTP, SCM_OPSTRPORTP, SCM_OPINSTRPORTP),
	(SCM_OPOUTSTRPORTP): New predicate macros.
	(scm_open_input_string, scm_open_output_string),
	(scm_get_output_string): New prototypes.

	* strports.c (scm_open_input_string, scm_open_output_string),
	(scm_get_output_string): New procedures (SRFI-6 compliant).
	Made scm_tc16_strport non-static.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 1577fbb..5e3a9b6 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,16 @@
+2001-03-15  Martin Grabmueller  <mgrabmue@cs.tu-berlin.de>
+
+       * validate.h (SCM_VALIDATE_OPOUTSTRPORT): New macro.
+
+       * strports.h (SCM_STRPORTP, SCM_OPSTRPORTP, SCM_OPINSTRPORTP),
+       (SCM_OPOUTSTRPORTP): New predicate macros.
+       (scm_open_input_string, scm_open_output_string),
+       (scm_get_output_string): New prototypes.
+       
+       * strports.c (scm_open_input_string, scm_open_output_string),
+       (scm_get_output_string): New procedures (SRFI-6 compliant).
+       Made scm_tc16_strport non-static.
+
 2001-03-15  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
        * macros.h (SCM_ASSYNT):  Removed unused object argument from

diff --git a/libguile/strports.c b/libguile/strports.c
index b72130e..299337d 100644 (file)
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -80,8 +80,7 @@
    when rw_active is SCM_PORT_NEITHER.
 */
 
-
-static scm_bits_t scm_tc16_strport;
+scm_bits_t scm_tc16_strport;
 
 
 static int
@@ -377,6 +376,49 @@ SCM_DEFINE (scm_call_with_input_string, "call-with-input-string", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_open_input_string, "open-input-string", 1, 0, 0,
+           (SCM str),
+           "Takes a string and returns an input port that delivers\n"
+           "characters from the string. The port can be closed by\n"
+           "@code{close-input-port}, though its storage will be reclaimed\n"
+           "by the garbage collector if it becomes inaccessible.")
+#define FUNC_NAME s_scm_open_input_string
+{
+  SCM p = scm_mkstrport(SCM_INUM0, str, SCM_OPN | SCM_RDNG, FUNC_NAME);
+  return p;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_open_output_string, "open-output-string", 0, 0, 0, 
+           (void),
+           "Returns an output port that will accumulate characters for\n"
+           "retrieval by @code{get-output-string}. The port can be closed\n"
+           "by the procedure @code{close-output-port}, though its storage\n"
+           "will be reclaimed by the garbage collector if it becomes\n"
+           "inaccessible.")
+#define FUNC_NAME s_scm_open_output_string
+{
+  SCM p;
+
+  p = scm_mkstrport (SCM_INUM0, 
+                    scm_make_string (SCM_INUM0, SCM_UNDEFINED),
+                    SCM_OPN | SCM_WRTNG,
+                     FUNC_NAME);
+  return p;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_output_string, "get-output-string", 1, 0, 0, 
+           (SCM port),
+           "Given an output port created by @code{open-output-string},\n"
+           "returns a string consisting of the characters that have been\n"
+           "output to the port so far.")
+#define FUNC_NAME s_scm_get_output_string
+{
+  SCM_VALIDATE_OPOUTSTRPORT (1, port);
+  return scm_strport_to_string (port);
+}
+#undef FUNC_NAME
 
 
 /* Given a null-terminated string EXPR containing a Scheme expression

diff --git a/libguile/strports.h b/libguile/strports.h
index 6767bd2..9388c2d 100644 (file)
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -48,11 +48,30 @@
 
 \f
 
+
+#define SCM_STRPORTP(x)      (!SCM_IMP (x) && \
+                              (SCM_TYP16 (x) == scm_tc16_strport))
+#define SCM_OPSTRPORTP(x)    (SCM_STRPORTP (x) && \
+                              (SCM_CELL_WORD_0 (x) & SCM_OPN))
+#define SCM_OPINSTRPORTP(x)  (SCM_OPSTRPORTP (x) && \
+                             (SCM_CELL_WORD_0 (x) & SCM_RDNG))
+#define SCM_OPOUTSTRPORTP(x) (SCM_OPSTRPORTP (x) && \
+                              (SCM_CELL_WORD_0 (x) & SCM_WRTNG))
+
+\f
+
+extern scm_bits_t scm_tc16_strport;
+
+\f
+
 extern SCM scm_mkstrport (SCM pos, SCM str, long modes, const char * caller);
 extern SCM scm_strport_to_string (SCM port);
 extern SCM scm_object_to_string (SCM obj, SCM printer);
 extern SCM scm_call_with_output_string (SCM proc);
 extern SCM scm_call_with_input_string (SCM str, SCM proc);
+extern SCM scm_open_input_string (SCM str);
+extern SCM scm_open_output_string (void);
+extern SCM scm_get_output_string (SCM port);
 extern SCM scm_read_0str (char *expr);
 extern SCM scm_eval_0str (const char *expr);
 extern SCM scm_eval_string (SCM string);

diff --git a/libguile/validate.h b/libguile/validate.h
index 87fdb71..969b412 100644 (file)
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -1,4 +1,4 @@
-/* $Id: validate.h,v 1.27 2001-03-04 22:48:13 dirk Exp $ */
+/* $Id: validate.h,v 1.28 2001-03-15 11:24:45 mgrabmue Exp $ */
 /*     Copyright (C) 1999, 2000 Free Software Foundation, Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -359,6 +359,9 @@
 #define SCM_VALIDATE_OPOUTPORT(pos, port) \
   SCM_MAKE_VALIDATE (pos, port, OPOUTPORTP)
 
+#define SCM_VALIDATE_OPOUTSTRPORT(pos, port) \
+  SCM_MAKE_VALIDATE (pos, port, OPOUTSTRPORTP)
+
 #define SCM_VALIDATE_FLUID(pos, fluid) SCM_MAKE_VALIDATE (pos, fluid, FLUIDP)
 
 #define SCM_VALIDATE_KEYWORD(pos, v) SCM_MAKE_VALIDATE (pos, v, KEYWORDP)