diff options
Diffstat (limited to 'libguile/strports.c')
-rw-r--r-- | libguile/strports.c | 137 |
1 files changed, 111 insertions, 26 deletions
diff --git a/libguile/strports.c b/libguile/strports.c index 5c67bf9a8..ed6275b50 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -39,6 +39,7 @@ #include "libguile/modules.h" #include "libguile/validate.h" #include "libguile/deprecation.h" +#include "libguile/srfi-4.h" #include "libguile/strports.h" @@ -289,42 +290,33 @@ st_truncate (SCM port, scm_t_off length) } SCM -scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) +scm_i_mkstrport (SCM pos, const char *locale_str, size_t str_len, long modes, const char *caller) { - SCM z; + SCM z, str; scm_t_port *pt; - size_t str_len, c_pos; - - SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); + size_t c_pos; + char *buf; + + /* Because ports are inherently 8-bit, strings need to be converted + to a locale representation for storage. But, since string ports + rely on string functionality for their memory management, we need + to create a new string that has the 8-bit locale representation + of the underlying string. This violates the guideline that the + internal encoding of characters in strings is in unicode + codepoints. */ + str = scm_i_make_string (str_len, &buf); + memcpy (buf, locale_str, str_len); - str_len = scm_i_string_length (str); c_pos = scm_to_unsigned_integer (pos, 0, str_len); if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); - /* XXX - - Make a new string to isolate us from changes to the original. - This is done so that we can rely on scm_i_string_chars to stay in - place even across SCM_TICKs. - - Additionally, when we are going to write to the string, we make a - copy so that we can write to it without having to use - scm_i_string_writable_chars. - */ - - if (modes & SCM_WRTNG) - str = scm_c_substring_copy (str, 0, str_len); - else - str = scm_c_substring (str, 0, str_len); - scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); 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); - /* see above why we can use scm_i_string_chars here. */ pt->write_buf = pt->read_buf = (unsigned char *) scm_i_string_chars (str); pt->read_pos = pt->write_pos = pt->read_buf + c_pos; pt->write_buf_size = pt->read_buf_size = str_len; @@ -340,22 +332,60 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) return z; } +SCM +scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) +{ + SCM z; + size_t str_len; + char *buf; + + SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller); + + /* Because ports are inherently 8-bit, strings need to be converted + to a locale representation for storage. But, since string ports + rely on string functionality for their memory management, we need + to create a new string that has the 8-bit locale representation + of the underlying string. This violates the guideline that the + internal encoding of characters in strings is in unicode + codepoints. */ + buf = scm_to_locale_stringn (str, &str_len); + z = scm_i_mkstrport (pos, buf, str_len, modes, caller); + free (buf); + return z; +} + /* create a new string from a string port's buffer. */ SCM scm_strport_to_string (SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); SCM str; - char *dst; if (pt->rw_active == SCM_PORT_WRITE) st_flush (port); - str = scm_i_make_string (pt->read_buf_size, &dst); - memcpy (dst, (char *) pt->read_buf, pt->read_buf_size); + str = scm_from_locale_stringn ((char *)pt->read_buf, pt->read_buf_size); scm_remember_upto_here_1 (port); return str; } +/* Create a vector containing the locale representation of the string in the + port's buffer. */ +SCM scm_strport_to_locale_u8vector (SCM port) +{ + scm_t_port *pt = SCM_PTAB_ENTRY (port); + SCM vec; + char *buf; + + if (pt->rw_active == SCM_PORT_WRITE) + st_flush (port); + + buf = scm_malloc (pt->read_buf_size); + memcpy (buf, pt->read_buf, pt->read_buf_size); + vec = scm_take_u8vector ((unsigned char *) buf, pt->read_buf_size); + scm_remember_upto_here_1 (port); + return vec; +} + SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, (SCM obj, SCM printer), "Return a Scheme string obtained by printing @var{obj}.\n" @@ -380,6 +410,25 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_call_with_output_locale_u8vector, "call-with-output-locale-u8vector", 1, 0, 0, + (SCM proc), + "Calls the one-argument procedure @var{proc} with a newly created output\n" + "port. When the function returns, a vector containing the bytes of a\n" + "locale representation of the characters written into the port is returned\n") +#define FUNC_NAME s_scm_call_with_output_locale_u8vector +{ + SCM p; + + p = scm_mkstrport (SCM_INUM0, + scm_make_string (SCM_INUM0, SCM_UNDEFINED), + SCM_OPN | SCM_WRTNG, + FUNC_NAME); + scm_call_1 (proc, p); + + return scm_get_output_locale_u8vector (p); +} +#undef FUNC_NAME + SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, (SCM proc), "Calls the one-argument procedure @var{proc} with a newly created output\n" @@ -424,6 +473,27 @@ SCM_DEFINE (scm_open_input_string, "open-input-string", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_open_input_locale_u8vector, "open-input-locale-u8vector", 1, 0, 0, + (SCM vec), + "Take a u8vector containing the bytes of a string encoded in the\n" + "current locale and return an input port that delivers characters\n" + "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_locale_u8vector +{ + scm_t_array_handle hnd; + ssize_t inc; + size_t len; + const scm_t_uint8 *buf; + + buf = scm_u8vector_elements (vec, &hnd, &len, &inc); + SCM p = scm_i_mkstrport(SCM_INUM0, (const char *) buf, len, SCM_OPN | SCM_RDNG, FUNC_NAME); + scm_array_handle_release (&hnd); + return p; +} +#undef FUNC_NAME + SCM_DEFINE (scm_open_output_string, "open-output-string", 0, 0, 0, (void), "Return an output port that will accumulate characters for\n" @@ -456,11 +526,26 @@ SCM_DEFINE (scm_get_output_string, "get-output-string", 1, 0, 0, #undef FUNC_NAME +SCM_DEFINE (scm_get_output_locale_u8vector, "get-output-locale-u8vector", 1, 0, 0, + (SCM port), + "Given an output port created by @code{open-output-string},\n" + "return a u8 vector containing the characters of the string\n" + "encoded in the current locale.") +#define FUNC_NAME s_scm_get_output_locale_u8vector +{ + SCM_VALIDATE_OPOUTSTRPORT (1, port); + return scm_strport_to_locale_u8vector (port); +} +#undef FUNC_NAME + + /* Given a null-terminated string EXPR containing a Scheme expression read it, and return it as an SCM value. */ SCM scm_c_read_string (const char *expr) { + /* FIXME: the c string gets packed into a string, only to get + immediately unpacked in scm_mkstrport. */ SCM port = scm_mkstrport (SCM_INUM0, scm_from_locale_string (expr), SCM_OPN | SCM_RDNG, |