diff options
Diffstat (limited to 'libguile/strings.c')
-rw-r--r-- | libguile/strings.c | 230 |
1 files changed, 143 insertions, 87 deletions
diff --git a/libguile/strings.c b/libguile/strings.c index 5d0db2301..85a6c4839 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -126,7 +126,7 @@ make_stringbuf (size_t len) lenhist[1000]++; #endif - buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1, + buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1, "string")); SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG); @@ -153,7 +153,7 @@ make_wide_stringbuf (size_t len) #endif raw_len = (len + 1) * sizeof (scm_t_wchar); - buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len, + buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len, "string")); SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG | STRINGBUF_F_WIDE); @@ -240,7 +240,7 @@ scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; #define SET_STRING_STRINGBUF(str,buf) (SCM_SET_CELL_OBJECT_1(str,buf)) #define SET_STRING_START(str,start) (SCM_SET_CELL_WORD_2(str,start)) -#define IS_STRING(str) (SCM_NIMP(str) && SCM_TYP7(str) == STRING_TAG) +#define IS_STRING(str) (SCM_HAS_TYP7 (str, STRING_TAG)) /* Read-only strings. */ @@ -1492,6 +1492,23 @@ scm_decoding_error (const char *subr, int err, const char *message, SCM port) /* String conversion to/from C. */ +static void +decoding_error (const char *func_name, int errno_save, + const char *str, size_t len) +{ + /* Raise an error and pass the raw C string as a bytevector to the `throw' + handler. */ + SCM bv; + signed char *buf; + + buf = scm_gc_malloc_pointerless (len, "bytevector"); + memcpy (buf, str, len); + bv = scm_c_take_gc_bytevector (buf, len, SCM_BOOL_F); + + scm_decoding_error (func_name, errno_save, + "input locale conversion error", bv); +} + SCM scm_from_stringn (const char *str, size_t len, const char *encoding, scm_t_string_failed_conversion_handler handler) @@ -1507,14 +1524,11 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, if (len == (size_t) -1) len = strlen (str); - if (encoding == NULL || len == 0) - { - /* If encoding is null (or the string is empty), use Latin-1. */ - char *buf; - res = scm_i_make_string (len, &buf, 0); - memcpy (buf, str, len); - return res; - } + if (strcmp (encoding, "ISO-8859-1") == 0 || len == 0) + return scm_from_latin1_stringn (str, len); + else if (strcmp (encoding, "UTF-8") == 0 + && handler == SCM_FAILED_CONVERSION_ERROR) + return scm_from_utf8_stringn (str, len); u32len = 0; u32 = (scm_t_wchar *) u32_conv_from_encoding (encoding, @@ -1525,19 +1539,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, NULL, &u32len); if (SCM_UNLIKELY (u32 == NULL)) - { - /* Raise an error and pass the raw C string as a bytevector to the `throw' - handler. */ - SCM bv; - signed char *buf; - - buf = scm_gc_malloc_pointerless (len, "bytevector"); - memcpy (buf, str, len); - bv = scm_c_take_gc_bytevector (buf, len); - - scm_decoding_error (__func__, errno, - "input locale conversion error", bv); - } + decoding_error (__func__, errno, str, len); i = 0; while (i < u32len) @@ -1611,7 +1613,81 @@ scm_from_utf8_string (const char *str) SCM scm_from_utf8_stringn (const char *str, size_t len) { - return scm_from_stringn (str, len, "UTF-8", SCM_FAILED_CONVERSION_ERROR); + size_t i, char_len; + const scm_t_uint8 *ustr = (const scm_t_uint8 *) str; + int ascii = 1, narrow = 1; + SCM res; + + if (len == (size_t) -1) + len = strlen (str); + + i = 0; + char_len = 0; + + while (i < len) + { + if (ustr[i] <= 127) + { + char_len++; + i++; + } + else + { + ucs4_t c; + int nbytes; + + ascii = 0; + + nbytes = u8_mbtouc (&c, ustr + i, len - i); + + if (c == 0xfffd) + /* Bad UTF-8. */ + decoding_error (__func__, errno, str, len); + + if (c > 255) + narrow = 0; + + char_len++; + i += nbytes; + } + } + + if (ascii) + { + char *dst; + res = scm_i_make_string (char_len, &dst, 0); + memcpy (dst, str, len); + } + else if (narrow) + { + char *dst; + size_t j; + ucs4_t c; + + res = scm_i_make_string (char_len, &dst, 0); + + for (i = 0, j = 0; i < len; j++) + { + i += u8_mbtouc_unsafe (&c, ustr + i, len - i); + dst[j] = (signed char) c; + } + } + else + { + scm_t_wchar *dst; + size_t j; + ucs4_t c; + + res = scm_i_make_wide_string (char_len, &dst, 0); + + for (i = 0, j = 0; i < len; j++) + { + i += u8_mbtouc_unsafe (&c, ustr + i, len - i); + dst[j] = c; + } + } + + return res; } SCM @@ -1636,6 +1712,26 @@ scm_from_utf32_stringn (const scm_t_wchar *str, size_t len) return result; } +SCM +scm_from_port_string (const char *str, SCM port) +{ + return scm_from_port_stringn (str, -1, port); +} + +SCM +scm_from_port_stringn (const char *str, size_t len, SCM port) +{ + scm_t_port *pt = SCM_PTAB_ENTRY (port); + + if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1) + return scm_from_latin1_stringn (str, len); + else if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8 + && pt->ilseq_handler == SCM_FAILED_CONVERSION_ERROR) + return scm_from_utf8_stringn (str, len); + else + return scm_from_stringn (str, len, pt->encoding, pt->ilseq_handler); +} + /* Create a new scheme string from the C string STR. The memory of STR may be used directly as storage for the new string. */ /* FIXME: GC-wise, the only way to use the memory area pointed to by STR @@ -2021,6 +2117,26 @@ scm_to_utf32_stringn (SCM str, size_t *lenp) } #undef FUNC_NAME +char * +scm_to_port_string (SCM str, SCM port) +{ + return scm_to_port_stringn (str, NULL, port); +} + +char * +scm_to_port_stringn (SCM str, size_t *lenp, SCM port) +{ + scm_t_port *pt = SCM_PTAB_ENTRY (port); + + if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1 + && pt->ilseq_handler == SCM_FAILED_CONVERSION_ERROR) + return scm_to_latin1_stringn (str, lenp); + else if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8) + return scm_to_utf8_stringn (str, lenp); + else + return scm_to_stringn (str, lenp, pt->encoding, pt->ilseq_handler); +} + /* Return a malloc(3)-allocated buffer containing the contents of STR encoded according to ENCODING. If LENP is non-NULL, set it to the size in bytes of the returned buffer. If the conversion to ENCODING fails, apply the strategy @@ -2054,7 +2170,7 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding, "string contains #\\nul character: ~S", scm_list_1 (str)); - if (scm_i_is_narrow_string (str) && (encoding == NULL)) + if (scm_i_is_narrow_string (str) && strcmp (encoding, "ISO-8859-1") == 0) { /* If using native Latin-1 encoding, just copy the string contents. */ @@ -2310,66 +2426,6 @@ scm_i_get_substring_spec (size_t len, *cend = scm_to_unsigned_integer (end, *cstart, len); } -#if SCM_ENABLE_DEPRECATED - -/* When these definitions are removed, it becomes reasonable to use - read-only strings for string literals. For that, change the reader - to create string literals with scm_c_substring_read_only instead of - with scm_c_substring_copy. -*/ - -int -scm_i_deprecated_stringp (SCM str) -{ - scm_c_issue_deprecation_warning - ("SCM_STRINGP is deprecated. Use scm_is_string instead."); - - return scm_is_string (str); -} - -char * -scm_i_deprecated_string_chars (SCM str) -{ - char *chars; - - scm_c_issue_deprecation_warning - ("SCM_STRING_CHARS is deprecated. See the manual for alternatives."); - - /* We don't accept shared substrings here since they are not - null-terminated. - */ - if (IS_SH_STRING (str)) - scm_misc_error (NULL, - "SCM_STRING_CHARS does not work with shared substrings", - SCM_EOL); - - /* We explicitly test for read-only strings to produce a better - error message. - */ - - if (IS_RO_STRING (str)) - scm_misc_error (NULL, - "SCM_STRING_CHARS does not work with read-only strings", - SCM_EOL); - - /* The following is still wrong, of course... - */ - str = scm_i_string_start_writing (str); - chars = scm_i_string_writable_chars (str); - scm_i_string_stop_writing (); - return chars; -} - -size_t -scm_i_deprecated_string_length (SCM str) -{ - scm_c_issue_deprecation_warning - ("SCM_STRING_LENGTH is deprecated. Use scm_c_string_length instead."); - return scm_c_string_length (str); -} - -#endif - static SCM string_handle_ref (scm_t_array_handle *h, size_t index) { |