summaryrefslogtreecommitdiff
path: root/libguile/strings.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/strings.c')
-rw-r--r--libguile/strings.c94
1 files changed, 34 insertions, 60 deletions
diff --git a/libguile/strings.c b/libguile/strings.c
index b13cb780f..bf637041c 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -262,30 +262,34 @@ SCM scm_nullstr;
/* Create a scheme string with space for LEN 8-bit Latin-1-encoded
characters. CHARSP, if not NULL, will be set to location of the
- char array. */
+ char array. If READ_ONLY_P, the returned string is read-only;
+ otherwise it is writable. */
SCM
-scm_i_make_string (size_t len, char **charsp)
+scm_i_make_string (size_t len, char **charsp, int read_only_p)
{
SCM buf = make_stringbuf (len);
SCM res;
if (charsp)
*charsp = (char *) STRINGBUF_CHARS (buf);
- res = scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
- (scm_t_bits)0, (scm_t_bits) len);
+ res = scm_double_cell (read_only_p ? RO_STRING_TAG : STRING_TAG,
+ SCM_UNPACK (buf),
+ (scm_t_bits) 0, (scm_t_bits) len);
return res;
}
/* Create a scheme string with space for LEN 32-bit UCS-4-encoded
characters. CHARSP, if not NULL, will be set to location of the
- character array. */
+ character array. If READ_ONLY_P, the returned string is read-only;
+ otherwise it is writable. */
SCM
-scm_i_make_wide_string (size_t len, scm_t_wchar **charsp)
+scm_i_make_wide_string (size_t len, scm_t_wchar **charsp, int read_only_p)
{
SCM buf = make_wide_stringbuf (len);
SCM res;
if (charsp)
*charsp = STRINGBUF_WIDE_CHARS (buf);
- res = scm_double_cell (STRING_TAG, SCM_UNPACK (buf),
+ res = scm_double_cell (read_only_p ? RO_STRING_TAG : STRING_TAG,
+ SCM_UNPACK (buf),
(scm_t_bits) 0, (scm_t_bits) len);
return res;
}
@@ -889,7 +893,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str),
{
size_t len = STRINGBUF_LENGTH (buf);
char *cbuf;
- SCM sbc = scm_i_make_string (len, &cbuf);
+ SCM sbc = scm_i_make_string (len, &cbuf, 0);
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
@@ -898,7 +902,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str),
{
size_t len = STRINGBUF_LENGTH (buf);
scm_t_wchar *cbuf;
- SCM sbc = scm_i_make_wide_string (len, &cbuf);
+ SCM sbc = scm_i_make_wide_string (len, &cbuf, 0);
u32_cpy ((scm_t_uint32 *) cbuf,
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
@@ -962,7 +966,7 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym),
{
size_t len = STRINGBUF_LENGTH (buf);
char *cbuf;
- SCM sbc = scm_i_make_string (len, &cbuf);
+ SCM sbc = scm_i_make_string (len, &cbuf, 0);
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
@@ -971,7 +975,7 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym),
{
size_t len = STRINGBUF_LENGTH (buf);
scm_t_wchar *cbuf;
- SCM sbc = scm_i_make_wide_string (len, &cbuf);
+ SCM sbc = scm_i_make_wide_string (len, &cbuf, 0);
u32_cpy ((scm_t_uint32 *) cbuf,
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
@@ -1066,7 +1070,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
{
char *buf;
- result = scm_i_make_string (len, NULL);
+ result = scm_i_make_string (len, NULL, 0);
result = scm_i_string_start_writing (result);
buf = scm_i_string_writable_chars (result);
while (len > 0 && scm_is_pair (rest))
@@ -1083,7 +1087,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
{
scm_t_wchar *buf;
- result = scm_i_make_wide_string (len, NULL);
+ result = scm_i_make_wide_string (len, NULL, 0);
result = scm_i_string_start_writing (result);
buf = scm_i_string_writable_wide_chars (result);
while (len > 0 && scm_is_pair (rest))
@@ -1125,7 +1129,7 @@ scm_c_make_string (size_t len, SCM chr)
{
size_t p;
char *contents = NULL;
- SCM res = scm_i_make_string (len, &contents);
+ SCM res = scm_i_make_string (len, &contents, 0);
/* If no char is given, initialize string contents to NULL. */
if (SCM_UNBNDP (chr))
@@ -1372,9 +1376,9 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
}
data.narrow = NULL;
if (!wide)
- res = scm_i_make_string (len, &data.narrow);
+ res = scm_i_make_string (len, &data.narrow, 0);
else
- res = scm_i_make_wide_string (len, &data.wide);
+ res = scm_i_make_wide_string (len, &data.wide, 0);
for (l = args; !scm_is_null (l); l = SCM_CDR (l))
{
@@ -1419,8 +1423,8 @@ scm_encoding_error (const char *subr, int err, const char *message,
SCM port, SCM chr)
{
scm_throw (scm_encoding_error_key,
- scm_list_n (scm_from_locale_string (subr),
- scm_from_locale_string (message),
+ scm_list_n (scm_from_latin1_string (subr),
+ scm_from_latin1_string (message),
scm_from_int (err),
port, chr,
SCM_UNDEFINED));
@@ -1432,8 +1436,8 @@ void
scm_decoding_error (const char *subr, int err, const char *message, SCM port)
{
scm_throw (scm_decoding_error_key,
- scm_list_n (scm_from_locale_string (subr),
- scm_from_locale_string (message),
+ scm_list_n (scm_from_latin1_string (subr),
+ scm_from_latin1_string (message),
scm_from_int (err),
port,
SCM_UNDEFINED));
@@ -1463,7 +1467,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding,
{
/* If encoding is null, use Latin-1. */
char *buf;
- res = scm_i_make_string (len, &buf);
+ res = scm_i_make_string (len, &buf, 0);
memcpy (buf, str, len);
return res;
}
@@ -1502,7 +1506,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding,
if (!wide)
{
char *dst;
- res = scm_i_make_string (u32len, &dst);
+ res = scm_i_make_string (u32len, &dst, 0);
for (i = 0; i < u32len; i ++)
dst[i] = (unsigned char) u32[i];
dst[u32len] = '\0';
@@ -1510,7 +1514,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding,
else
{
scm_t_wchar *wdst;
- res = scm_i_make_wide_string (u32len, &wdst);
+ res = scm_i_make_wide_string (u32len, &wdst, 0);
u32_cpy ((scm_t_uint32 *) wdst, (scm_t_uint32 *) u32, u32len);
wdst[u32len] = 0;
}
@@ -1528,25 +1532,8 @@ scm_from_locale_string (const char *str)
SCM
scm_from_locale_stringn (const char *str, size_t len)
{
- const char *enc;
- scm_t_string_failed_conversion_handler hndl;
- SCM inport;
- scm_t_port *pt;
-
- inport = scm_current_input_port ();
- if (!SCM_UNBNDP (inport) && SCM_OPINPORTP (inport))
- {
- pt = SCM_PTAB_ENTRY (inport);
- enc = pt->encoding;
- hndl = pt->ilseq_handler;
- }
- else
- {
- enc = NULL;
- hndl = SCM_FAILED_CONVERSION_ERROR;
- }
-
- return scm_from_stringn (str, len, enc, hndl);
+ return scm_from_stringn (str, len, locale_charset (),
+ scm_i_get_conversion_strategy (SCM_BOOL_F));
}
SCM
@@ -1565,7 +1552,7 @@ scm_from_latin1_stringn (const char *str, size_t len)
len = strlen (str);
/* Make a narrow string and copy STR as is. */
- result = scm_i_make_string (len, &buf);
+ result = scm_i_make_string (len, &buf, 0);
memcpy (buf, str, len);
return result;
@@ -1598,7 +1585,7 @@ scm_from_utf32_stringn (const scm_t_wchar *str, size_t len)
if (len == (size_t) -1)
len = u32_strlen ((uint32_t *) str);
- result = scm_i_make_wide_string (len, &buf);
+ result = scm_i_make_wide_string (len, &buf, 0);
memcpy (buf, str, len * sizeof (scm_t_wchar));
scm_i_try_narrow_string (result);
@@ -1771,21 +1758,8 @@ scm_to_locale_string (SCM str)
char *
scm_to_locale_stringn (SCM str, size_t *lenp)
{
- SCM outport;
- scm_t_port *pt;
- const char *enc;
-
- outport = scm_current_output_port ();
- if (!SCM_UNBNDP (outport) && SCM_OPOUTPORTP (outport))
- {
- pt = SCM_PTAB_ENTRY (outport);
- enc = pt->encoding;
- }
- else
- enc = NULL;
-
return scm_to_stringn (str, lenp,
- enc,
+ locale_charset (),
scm_i_get_conversion_strategy (SCM_BOOL_F));
}
@@ -2029,7 +2003,7 @@ normalize_str (SCM string, uninorm_t form)
w_str = u32_normalize (form, w_str, len, NULL, &rlen);
- ret = scm_i_make_wide_string (rlen, &cbuf);
+ ret = scm_i_make_wide_string (rlen, &cbuf, 0);
u32_cpy ((scm_t_uint32 *) cbuf, w_str, rlen);
free (w_str);
@@ -2241,7 +2215,7 @@ SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string)
void
scm_init_strings ()
{
- scm_nullstr = scm_i_make_string (0, NULL);
+ scm_nullstr = scm_i_make_string (0, NULL, 1);
#include "libguile/strings.x"
}