-/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011 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
# include <config.h>
#endif
+#include <alloca.h>
#include <string.h>
#include <stdio.h>
#include <ctype.h>
#define STRINGBUF_SHARED(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_SHARED)
#define STRINGBUF_WIDE(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_WIDE)
-#define STRINGBUF_CHARS(buf) ((unsigned char *) \
+#define STRINGBUF_CONTENTS(buf) ((void *) \
SCM_CELL_OBJECT_LOC (buf, \
STRINGBUF_HEADER_SIZE))
-#define STRINGBUF_LENGTH(buf) (SCM_CELL_WORD_1 (buf))
+#define STRINGBUF_CHARS(buf) ((unsigned char *) STRINGBUF_CONTENTS (buf))
+#define STRINGBUF_WIDE_CHARS(buf) ((scm_t_wchar *) STRINGBUF_CONTENTS (buf))
-#define STRINGBUF_WIDE_CHARS(buf) ((scm_t_wchar *) STRINGBUF_CHARS (buf))
+#define STRINGBUF_LENGTH(buf) (SCM_CELL_WORD_1 (buf))
#define SET_STRINGBUF_SHARED(buf) \
do \
return scm_i_is_narrow_string (str);
}
+/* Return a pointer to the raw data of the string, which can be either Latin-1
+ or UCS-4 encoded data, depending on `scm_i_is_narrow_string (STR)'. */
+const void *
+scm_i_string_data (SCM str)
+{
+ SCM buf;
+ size_t start;
+ const char *data;
+
+ get_str_buf_start (&str, &buf, &start);
+
+ data = STRINGBUF_CONTENTS (buf);
+ data += start * (scm_i_is_narrow_string (str) ? 1 : 4);
+
+ return data;
+}
+
/* Returns a pointer to the 8-bit Latin-1 encoded character array of
STR. */
const char *
SCM_VALIDATE_STRING (1, str);
/* String info */
- e1 = scm_cons (scm_from_locale_symbol ("string"),
+ e1 = scm_cons (scm_from_latin1_symbol ("string"),
str);
- e2 = scm_cons (scm_from_locale_symbol ("start"),
+ e2 = scm_cons (scm_from_latin1_symbol ("start"),
scm_from_size_t (STRING_START (str)));
- e3 = scm_cons (scm_from_locale_symbol ("length"),
+ e3 = scm_cons (scm_from_latin1_symbol ("length"),
scm_from_size_t (STRING_LENGTH (str)));
if (IS_SH_STRING (str))
{
- e4 = scm_cons (scm_from_locale_symbol ("shared"),
+ e4 = scm_cons (scm_from_latin1_symbol ("shared"),
SH_STRING_STRING (str));
buf = STRING_STRINGBUF (SH_STRING_STRING (str));
}
else
{
- e4 = scm_cons (scm_from_locale_symbol ("shared"),
+ e4 = scm_cons (scm_from_latin1_symbol ("shared"),
SCM_BOOL_F);
buf = STRING_STRINGBUF (str);
}
if (IS_RO_STRING (str))
- e5 = scm_cons (scm_from_locale_symbol ("read-only"),
+ e5 = scm_cons (scm_from_latin1_symbol ("read-only"),
SCM_BOOL_T);
else
- e5 = scm_cons (scm_from_locale_symbol ("read-only"),
+ e5 = scm_cons (scm_from_latin1_symbol ("read-only"),
SCM_BOOL_F);
/* Stringbuf info */
char *cbuf;
SCM sbc = scm_i_make_string (len, &cbuf);
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
- e6 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+ e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
}
else
SCM sbc = scm_i_make_wide_string (len, &cbuf);
u32_cpy ((scm_t_uint32 *) cbuf,
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
- e6 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+ e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
}
- e7 = scm_cons (scm_from_locale_symbol ("stringbuf-length"),
+ e7 = scm_cons (scm_from_latin1_symbol ("stringbuf-length"),
scm_from_size_t (STRINGBUF_LENGTH (buf)));
if (STRINGBUF_SHARED (buf))
- e8 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
+ e8 = scm_cons (scm_from_latin1_symbol ("stringbuf-shared"),
SCM_BOOL_T);
else
- e8 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
+ e8 = scm_cons (scm_from_latin1_symbol ("stringbuf-shared"),
SCM_BOOL_F);
if (STRINGBUF_WIDE (buf))
- e9 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+ e9 = scm_cons (scm_from_latin1_symbol ("stringbuf-wide"),
SCM_BOOL_T);
else
- e9 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+ e9 = scm_cons (scm_from_latin1_symbol ("stringbuf-wide"),
SCM_BOOL_F);
return scm_list_n (e1, e2, e3, e4, e5, e6, e7, e8, e9, SCM_UNDEFINED);
SCM e1, e2, e3, e4, e5, e6, e7;
SCM buf;
SCM_VALIDATE_SYMBOL (1, sym);
- e1 = scm_cons (scm_from_locale_symbol ("symbol"),
+ e1 = scm_cons (scm_from_latin1_symbol ("symbol"),
sym);
- e2 = scm_cons (scm_from_locale_symbol ("hash"),
+ e2 = scm_cons (scm_from_latin1_symbol ("hash"),
scm_from_ulong (scm_i_symbol_hash (sym)));
- e3 = scm_cons (scm_from_locale_symbol ("interned"),
+ e3 = scm_cons (scm_from_latin1_symbol ("interned"),
scm_symbol_interned_p (sym));
buf = SYMBOL_STRINGBUF (sym);
char *cbuf;
SCM sbc = scm_i_make_string (len, &cbuf);
memcpy (cbuf, STRINGBUF_CHARS (buf), len);
- e4 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+ e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
}
else
SCM sbc = scm_i_make_wide_string (len, &cbuf);
u32_cpy ((scm_t_uint32 *) cbuf,
(scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
- e4 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+ e4 = scm_cons (scm_from_latin1_symbol ("stringbuf-chars"),
sbc);
}
- e5 = scm_cons (scm_from_locale_symbol ("stringbuf-length"),
+ e5 = scm_cons (scm_from_latin1_symbol ("stringbuf-length"),
scm_from_size_t (STRINGBUF_LENGTH (buf)));
if (STRINGBUF_SHARED (buf))
- e6 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
+ e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-shared"),
SCM_BOOL_T);
else
- e6 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"),
+ e6 = scm_cons (scm_from_latin1_symbol ("stringbuf-shared"),
SCM_BOOL_F);
if (STRINGBUF_WIDE (buf))
- e7 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+ e7 = scm_cons (scm_from_latin1_symbol ("stringbuf-wide"),
SCM_BOOL_T);
else
- e7 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+ e7 = scm_cons (scm_from_latin1_symbol ("stringbuf-wide"),
SCM_BOOL_F);
return scm_list_n (e1, e2, e3, e4, e5, e6, e7, SCM_UNDEFINED);
"Return a newly allocated string of\n"
"length @var{k}. If @var{chr} is given, then all elements of\n"
"the string are initialized to @var{chr}, otherwise the contents\n"
- "of the @var{string} are unspecified.")
+ "of the @var{string} are all set to @var{#\nul}.")
#define FUNC_NAME s_scm_make_string
{
return scm_c_make_string (scm_to_size_t (k), chr);
#define FUNC_NAME NULL
{
size_t p;
- SCM res = scm_i_make_string (len, NULL);
+ char *contents = NULL;
+ SCM res = scm_i_make_string (len, &contents);
- if (!SCM_UNBNDP (chr))
+ /* If no char is given, initialize string contents to NULL. */
+ if (SCM_UNBNDP (chr))
+ memset (contents, 0, len);
+ else
{
SCM_VALIDATE_CHAR (0, chr);
res = scm_i_string_start_writing (res);
}
#undef FUNC_NAME
-int
-scm_is_string (SCM obj)
-{
- return IS_STRING (obj);
-}
\f
-/* Conversion to/from other encodings. */
+/* Charset conversion error handling. */
SCM_SYMBOL (scm_encoding_error_key, "encoding-error");
-static void
-scm_encoding_error (const char *subr, const char *message, SCM args)
+SCM_SYMBOL (scm_decoding_error_key, "decoding-error");
+
+/* Raise an exception informing that character CHR could not be written
+ to PORT in its current encoding. */
+void
+scm_encoding_error (const char *subr, int err, const char *message,
+ SCM port, SCM chr)
{
- scm_error (scm_encoding_error_key, subr, message, args, SCM_BOOL_F);
+ scm_throw (scm_encoding_error_key,
+ scm_list_n (scm_from_locale_string (subr),
+ scm_from_locale_string (message),
+ scm_from_int (err),
+ port, chr,
+ SCM_UNDEFINED));
}
+/* Raise an exception informing of an encoding error on PORT. This
+ means that a character could not be written in PORT's encoding. */
+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_from_int (err),
+ port,
+ SCM_UNDEFINED));
+}
+
+\f
+/* String conversion to/from C. */
+
SCM
scm_from_stringn (const char *str, size_t len, const char *encoding,
scm_t_string_failed_conversion_handler handler)
int wide = 0;
SCM res;
+ /* The order of these checks is important. */
+ if (!str && len != 0)
+ scm_misc_error ("scm_from_stringn", "NULL string pointer", SCM_EOL);
+ if (len == (size_t) -1)
+ len = strlen (str);
if (len == 0)
return scm_nullstr;
NULL,
NULL, &u32len);
- if (u32 == NULL)
+ if (SCM_UNLIKELY (u32 == NULL))
{
- if (errno == ENOMEM)
- scm_memory_error ("locale string conversion");
- else
- {
- /* There are invalid sequences in the input string. */
- SCM errstr;
- char *dst;
- errstr = scm_i_make_string (len, &dst);
- memcpy (dst, str, len);
- scm_encoding_error (NULL,
- "input locale conversion error from ~s: ~s",
- scm_list_2 (scm_from_locale_string (encoding),
- errstr));
- scm_remember_upto_here_1 (errstr);
- }
+ /* 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_bytevector (buf, len);
+
+ scm_decoding_error (__func__, errno,
+ "input locale conversion error", bv);
}
i = 0;
return res;
}
+SCM
+scm_from_locale_string (const char *str)
+{
+ return scm_from_locale_stringn (str, -1);
+}
+
SCM
scm_from_locale_stringn (const char *str, size_t len)
{
SCM inport;
scm_t_port *pt;
- if (len == (size_t) -1)
- len = strlen (str);
- if (len == 0)
- return scm_nullstr;
-
inport = scm_current_input_port ();
if (!SCM_UNBNDP (inport) && SCM_OPINPORTP (inport))
{
}
SCM
-scm_from_locale_string (const char *str)
+scm_from_latin1_string (const char *str)
{
- if (str == NULL)
- return scm_nullstr;
+ return scm_from_latin1_stringn (str, -1);
+}
- return scm_from_locale_stringn (str, -1);
+SCM
+scm_from_latin1_stringn (const char *str, size_t len)
+{
+ char *buf;
+ SCM result;
+
+ if (len == (size_t) -1)
+ len = strlen (str);
+
+ /* Make a narrow string and copy STR as is. */
+ result = scm_i_make_string (len, &buf);
+ memcpy (buf, str, len);
+
+ return result;
}
SCM
-scm_i_from_utf8_string (const scm_t_uint8 *str)
+scm_from_utf8_string (const char *str)
{
- return scm_from_stringn ((const char *) str,
- strlen ((char *) str), "UTF-8",
- SCM_FAILED_CONVERSION_ERROR);
+ return scm_from_utf8_stringn (str, -1);
+}
+
+SCM
+scm_from_utf8_stringn (const char *str, size_t len)
+{
+ return scm_from_stringn (str, len, "UTF-8", SCM_FAILED_CONVERSION_ERROR);
+}
+
+SCM
+scm_from_utf32_string (const scm_t_wchar *str)
+{
+ return scm_from_utf32_stringn (str, -1);
+}
+
+SCM
+scm_from_utf32_stringn (const scm_t_wchar *str, size_t len)
+{
+ SCM result;
+ scm_t_wchar *buf;
+
+ if (len == (size_t) -1)
+ len = u32_strlen ((uint32_t *) str);
+
+ result = scm_i_make_wide_string (len, &buf);
+ memcpy (buf, str, len * sizeof (scm_t_wchar));
+ scm_i_try_narrow_string (result);
+
+ return result;
}
/* Create a new scheme string from the C string STR. The memory of
return scm_take_locale_stringn (str, -1);
}
-/* Change libunistring escapes (\uXXXX and \UXXXXXXXX) to \xXX \uXXXX
- and \UXXXXXX. */
+/* Change libunistring escapes (`\uXXXX' and `\UXXXXXXXX') in BUF, a
+ *LENP-byte locale-encoded string, to `\xXX', `\uXXXX', or `\UXXXXXX'.
+ Set *LENP to the size of the resulting string.
+
+ FIXME: This is a hack we should get rid of. See
+ <http://lists.gnu.org/archive/html/bug-libunistring/2010-09/msg00004.html>
+ for details. */
static void
-unistring_escapes_to_guile_escapes (char **bufp, size_t *lenp)
+unistring_escapes_to_guile_escapes (char *buf, size_t *lenp)
{
char *before, *after;
size_t i, j;
- before = *bufp;
- after = *bufp;
+ before = buf;
+ after = buf;
i = 0;
j = 0;
while (i < *lenp)
}
}
*lenp = j;
- after = scm_realloc (after, j);
}
-/* Change libunistring escapes (\uXXXX and \UXXXXXXXX) to \xXXXX; */
+/* Change libunistring escapes (`\uXXXX' and `\UXXXXXXXX') in BUF, a
+ *LENP-byte locale-encoded string, to `\xXXXX;'. Set *LEN to the size
+ of the resulting string. BUF must be large enough to handle the
+ worst case when `\uXXXX' escapes (6 characters) are replaced by
+ `\xXXXX;' (7 characters). */
static void
-unistring_escapes_to_r6rs_escapes (char **bufp, size_t *lenp)
+unistring_escapes_to_r6rs_escapes (char *buf, size_t *lenp)
{
char *before, *after;
size_t i, j;
size_t max_out_len = (*lenp * 7) / 6 + 1;
size_t nzeros, ndigits;
- before = *bufp;
+ before = buf;
after = alloca (max_out_len);
i = 0;
j = 0;
}
}
*lenp = j;
- before = scm_realloc (before, j);
memcpy (before, after, j);
}
+char *
+scm_to_locale_string (SCM str)
+{
+ return scm_to_locale_stringn (str, NULL);
+}
char *
scm_to_locale_stringn (SCM str, size_t *lenp)
scm_i_get_conversion_strategy (SCM_BOOL_F));
}
+char *
+scm_to_latin1_string (SCM str)
+{
+ return scm_to_latin1_stringn (str, NULL);
+}
+
+char *
+scm_to_latin1_stringn (SCM str, size_t *lenp)
+#define FUNC_NAME "scm_to_latin1_stringn"
+{
+ char *result;
+
+ SCM_VALIDATE_STRING (1, str);
+
+ if (scm_i_is_narrow_string (str))
+ {
+ if (lenp)
+ *lenp = scm_i_string_length (str);
+
+ result = scm_strdup (scm_i_string_data (str));
+ }
+ else
+ result = scm_to_stringn (str, lenp, NULL,
+ SCM_FAILED_CONVERSION_ERROR);
+
+ return result;
+}
+#undef FUNC_NAME
+
+char *
+scm_to_utf8_string (SCM str)
+{
+ return scm_to_utf8_stringn (str, NULL);
+}
+
+char *
+scm_to_utf8_stringn (SCM str, size_t *lenp)
+{
+ return scm_to_stringn (str, lenp, "UTF-8", SCM_FAILED_CONVERSION_ERROR);
+}
+
+scm_t_wchar *
+scm_to_utf32_string (SCM str)
+{
+ return scm_to_utf32_stringn (str, NULL);
+}
+
+scm_t_wchar *
+scm_to_utf32_stringn (SCM str, size_t *lenp)
+#define FUNC_NAME "scm_to_utf32_stringn"
+{
+ scm_t_wchar *result;
+
+ SCM_VALIDATE_STRING (1, str);
+
+ if (scm_i_is_narrow_string (str))
+ result = (scm_t_wchar *)
+ scm_to_stringn (str, lenp, "UTF-32",
+ SCM_FAILED_CONVERSION_ERROR);
+ else
+ {
+ size_t len;
+
+ len = scm_i_string_length (str);
+ if (lenp)
+ *lenp = len;
+
+ result = scm_malloc ((len + 1) * sizeof (scm_t_wchar));
+ memcpy (result, scm_i_string_wide_chars (str),
+ len * sizeof (scm_t_wchar));
+ result[len] = 0;
+ }
+
+ return result;
+}
+#undef FUNC_NAME
+
/* 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
&buf, &len);
if (ret != 0)
- scm_encoding_error (NULL, "cannot convert to output locale ~s: \"~s\"",
- scm_list_2 (scm_from_locale_string (enc), str));
+ scm_encoding_error (__func__, errno,
+ "cannot convert narrow string to output locale",
+ SCM_BOOL_F,
+ /* FIXME: Faulty character unknown. */
+ SCM_BOOL_F);
}
else
{
NULL,
NULL, &len);
if (buf == NULL)
- scm_encoding_error (NULL, "cannot convert to output locale ~s: \"~s\"",
- scm_list_2 (scm_from_locale_string (enc), str));
+ scm_encoding_error (__func__, errno,
+ "cannot convert wide string to output locale",
+ SCM_BOOL_F,
+ /* FIXME: Faulty character unknown. */
+ SCM_BOOL_F);
}
if (handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
{
if (SCM_R6RS_ESCAPES_P)
- unistring_escapes_to_r6rs_escapes (&buf, &len);
+ {
+ /* The worst case is if the input string contains all 4-digit
+ hex escapes. "\uXXXX" (six characters) becomes "\xXXXX;"
+ (seven characters). Make BUF large enough to hold
+ that. */
+ buf = scm_realloc (buf, (len * 7) / 6 + 1);
+ unistring_escapes_to_r6rs_escapes (buf, &len);
+ }
else
- unistring_escapes_to_guile_escapes (&buf, &len);
+ unistring_escapes_to_guile_escapes (buf, &len);
+
+ buf = scm_realloc (buf, len);
}
if (lenp)
*lenp = len;
return buf;
}
-char *
-scm_to_locale_string (SCM str)
-{
- return scm_to_locale_stringn (str, NULL);
-}
-
-scm_t_uint8 *
-scm_i_to_utf8_string (SCM str)
-{
- char *u8str;
- u8str = scm_to_stringn (str, NULL, "UTF-8", SCM_FAILED_CONVERSION_ERROR);
- return (scm_t_uint8 *) u8str;
-}
-
size_t
scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len)
{
HCoop / bpt / guile.git / blobdiff