-/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 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 <uninorm.h>
#include <unistr.h>
#include <uniconv.h>
+#include <c-strcase.h>
#include "striconveh.h"
#include "libguile/chars.h"
#include "libguile/root.h"
#include "libguile/strings.h"
+#include "libguile/ports.h"
+#include "libguile/ports-internal.h"
#include "libguile/error.h"
#include "libguile/generalized-vectors.h"
#include "libguile/deprecation.h"
#define IS_SH_STRING(str) (SCM_CELL_TYPE(str)==SH_STRING_TAG)
+void
+scm_i_print_stringbuf (SCM exp, SCM port, scm_print_state *pstate)
+{
+ SCM str;
+
+ scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
+ SET_STRINGBUF_SHARED (exp);
+ scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
+
+ str = scm_double_cell (RO_STRING_TAG, SCM_UNPACK(exp),
+ 0, STRINGBUF_LENGTH (exp));
+
+ scm_puts ("#<stringbuf ", port);
+ scm_iprin1 (str, port, pstate);
+ scm_puts (">", port);
+}
+
SCM scm_nullstr;
+static SCM null_stringbuf;
+
+static void
+init_null_stringbuf (void)
+{
+ null_stringbuf = make_stringbuf (0);
+ SET_STRINGBUF_SHARED (null_stringbuf);
+}
+
/* 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. If READ_ONLY_P, the returned string is read-only;
SCM
scm_i_make_string (size_t len, char **charsp, int read_only_p)
{
- static SCM null_stringbuf = SCM_BOOL_F;
SCM buf;
SCM res;
if (len == 0)
{
- if (SCM_UNLIKELY (scm_is_false (null_stringbuf)))
- {
- null_stringbuf = make_stringbuf (0);
- SET_STRINGBUF_SHARED (null_stringbuf);
- }
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_null_stringbuf);
buf = null_stringbuf;
}
else
if (len == (size_t) -1)
len = strlen (str);
- if (strcmp (encoding, "ISO-8859-1") == 0 || len == 0)
+ if (c_strcasecmp (encoding, "ISO-8859-1") == 0 || len == 0)
return scm_from_latin1_stringn (str, len);
- else if (strcmp (encoding, "UTF-8") == 0
+ else if (c_strcasecmp (encoding, "UTF-8") == 0
&& handler == SCM_FAILED_CONVERSION_ERROR)
return scm_from_utf8_stringn (str, len);
scm_from_port_stringn (const char *str, size_t len, SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port);
- if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1)
+ if (pti->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)
+ else if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8
+ && (pt->ilseq_handler == SCM_FAILED_CONVERSION_ERROR
+ || (u8_check ((uint8_t *) str, len) == NULL)))
return scm_from_utf8_stringn (str, len);
else
return scm_from_stringn (str, len, pt->encoding, pt->ilseq_handler);
scm_to_port_stringn (SCM str, size_t *lenp, SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
+ scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port);
- if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1
+ if (pti->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)
+ else if (pti->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);
"string contains #\\nul character: ~S",
scm_list_1 (str));
- if (scm_i_is_narrow_string (str) && strcmp (encoding, "ISO-8859-1") == 0)
+ if (scm_i_is_narrow_string (str)
+ && c_strcasecmp (encoding, "ISO-8859-1") == 0)
{
/* If using native Latin-1 encoding, just copy the string
contents. */
*cend = scm_to_unsigned_integer (end, *cstart, len);
}
-static SCM
-string_handle_ref (scm_t_array_handle *h, size_t index)
-{
- return scm_c_string_ref (h->array, index);
-}
-
-static void
-string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
-{
- scm_c_string_set_x (h->array, index, val);
-}
-
-static void
-string_get_handle (SCM v, scm_t_array_handle *h)
-{
- h->array = v;
- h->ndims = 1;
- h->dims = &h->dim0;
- h->dim0.lbnd = 0;
- h->dim0.ubnd = scm_c_string_length (v) - 1;
- h->dim0.inc = 1;
- h->element_type = SCM_ARRAY_ELEMENT_TYPE_CHAR;
- h->elements = h->writable_elements = NULL;
-}
-
-SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f,
- string_handle_ref, string_handle_set,
- string_get_handle)
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string)
void