diff options
Diffstat (limited to 'libguile/strings.c')
-rw-r--r-- | libguile/strings.c | 94 |
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" } |