summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/foreign.c4
-rw-r--r--libguile/ports.c198
-rw-r--r--libguile/ports.h7
-rw-r--r--libguile/print.c15
-rw-r--r--libguile/strings.c6
-rw-r--r--libguile/strports.c8
6 files changed, 126 insertions, 112 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 832913147..072b4b62b 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -372,7 +372,7 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
ret = scm_from_pointer
(scm_to_stringn (string, NULL, enc,
- scm_i_get_conversion_strategy (SCM_BOOL_F)),
+ scm_i_default_port_conversion_handler ()),
free);
scm_dynwind_end ();
@@ -417,7 +417,7 @@ SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0,
scm_dynwind_free (enc);
ret = scm_from_stringn (SCM_POINTER_VALUE (pointer), len, enc,
- scm_i_get_conversion_strategy (SCM_BOOL_F));
+ scm_i_default_port_conversion_handler ());
scm_dynwind_end ();
diff --git a/libguile/ports.c b/libguile/ports.c
index b45378592..f91b80ee3 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -627,7 +627,7 @@ scm_c_make_port (scm_t_bits tag, unsigned long mode_bits, scm_t_bits stream)
{
return scm_c_make_port_with_encoding (tag, mode_bits,
scm_i_default_port_encoding (),
- scm_i_get_conversion_strategy (SCM_BOOL_F),
+ scm_i_default_port_conversion_handler (),
stream);
}
@@ -847,6 +847,83 @@ scm_i_default_port_encoding (void)
}
}
+/* A fluid specifying the default conversion handler for newly created
+ ports. Its value should be one of the symbols below. */
+SCM_VARIABLE (default_conversion_strategy_var,
+ "%default-port-conversion-strategy");
+
+/* Whether the above fluid is initialized. */
+static int scm_conversion_strategy_init = 0;
+
+/* The possible conversion strategies. */
+SCM_SYMBOL (sym_error, "error");
+SCM_SYMBOL (sym_substitute, "substitute");
+SCM_SYMBOL (sym_escape, "escape");
+
+/* Return the default failed encoding conversion policy for new created
+ ports. */
+scm_t_string_failed_conversion_handler
+scm_i_default_port_conversion_handler (void)
+{
+ scm_t_string_failed_conversion_handler handler;
+
+ if (!scm_conversion_strategy_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else
+ {
+ SCM fluid, value;
+
+ fluid = SCM_VARIABLE_REF (default_conversion_strategy_var);
+ value = scm_fluid_ref (fluid);
+
+ if (scm_is_eq (sym_substitute, value))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else if (scm_is_eq (sym_escape, value))
+ handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+ else
+ /* Default to 'error also when the fluid's value is not one of
+ the valid symbols. */
+ handler = SCM_FAILED_CONVERSION_ERROR;
+ }
+
+ return handler;
+}
+
+/* Use HANDLER as the default conversion strategy for future ports. */
+void
+scm_i_set_default_port_conversion_handler (scm_t_string_failed_conversion_handler
+ handler)
+{
+ SCM strategy;
+
+ if (!scm_conversion_strategy_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+ scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
+ SCM_EOL);
+
+ switch (handler)
+ {
+ case SCM_FAILED_CONVERSION_ERROR:
+ strategy = sym_error;
+ break;
+
+ case SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE:
+ strategy = sym_escape;
+ break;
+
+ case SCM_FAILED_CONVERSION_QUESTION_MARK:
+ strategy = sym_substitute;
+ break;
+
+ default:
+ abort ();
+ }
+
+ scm_fluid_set_x (SCM_VARIABLE_REF (default_conversion_strategy_var),
+ strategy);
+}
+
static void
finalize_iconv_descriptors (GC_PTR ptr, GC_PTR data)
{
@@ -1031,65 +1108,6 @@ SCM_DEFINE (scm_set_port_encoding_x, "set-port-encoding!", 2, 0, 0,
}
#undef FUNC_NAME
-
-/* This determines how conversions handle unconvertible characters. */
-SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
-static int scm_conversion_strategy_init = 0;
-
-scm_t_string_failed_conversion_handler
-scm_i_get_conversion_strategy (SCM port)
-{
- SCM encoding;
-
- if (scm_is_false (port))
- {
- if (!scm_conversion_strategy_init
- || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
- return SCM_FAILED_CONVERSION_QUESTION_MARK;
- else
- {
- encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
- if (scm_is_false (encoding))
- return SCM_FAILED_CONVERSION_QUESTION_MARK;
- else
- return (scm_t_string_failed_conversion_handler) scm_to_int (encoding);
- }
- }
- else
- {
- scm_t_port *pt;
- pt = SCM_PTAB_ENTRY (port);
- return pt->ilseq_handler;
- }
-
-}
-
-void
-scm_i_set_conversion_strategy_x (SCM port,
- scm_t_string_failed_conversion_handler handler)
-{
- SCM strategy;
- scm_t_port *pt;
-
- strategy = scm_from_int ((int) handler);
-
- if (scm_is_false (port))
- {
- /* Set the default encoding for future ports. */
- if (!scm_conversion_strategy_init
- || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
- scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
- SCM_EOL);
- scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
- }
- else
- {
- /* Set the character encoding for this port. */
- pt = SCM_PTAB_ENTRY (port);
- pt->ilseq_handler = handler;
- }
-}
-
SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
1, 0, 0, (SCM port),
"Returns the behavior of the port when handling a character that\n"
@@ -1109,12 +1127,18 @@ SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
SCM_VALIDATE_OPPORT (1, port);
- if (!scm_is_false (port))
+ if (scm_is_false (port))
+ h = scm_i_default_port_conversion_handler ();
+ else
{
+ scm_t_port *pt;
+
SCM_VALIDATE_OPPORT (1, port);
+ pt = SCM_PTAB_ENTRY (port);
+
+ h = pt->ilseq_handler;
}
- h = scm_i_get_conversion_strategy (port);
if (h == SCM_FAILED_CONVERSION_ERROR)
return scm_from_latin1_symbol ("error");
else if (h == SCM_FAILED_CONVERSION_QUESTION_MARK)
@@ -1149,40 +1173,25 @@ SCM_DEFINE (scm_set_port_conversion_strategy_x, "set-port-conversion-strategy!",
"this thread.\n")
#define FUNC_NAME s_scm_set_port_conversion_strategy_x
{
- SCM err;
- SCM qm;
- SCM esc;
-
- if (!scm_is_false (port))
- {
- SCM_VALIDATE_OPPORT (1, port);
- }
-
- err = scm_from_latin1_symbol ("error");
- if (scm_is_true (scm_eqv_p (sym, err)))
- {
- scm_i_set_conversion_strategy_x (port, SCM_FAILED_CONVERSION_ERROR);
- return SCM_UNSPECIFIED;
- }
+ scm_t_string_failed_conversion_handler handler;
- qm = scm_from_latin1_symbol ("substitute");
- if (scm_is_true (scm_eqv_p (sym, qm)))
- {
- scm_i_set_conversion_strategy_x (port,
- SCM_FAILED_CONVERSION_QUESTION_MARK);
- return SCM_UNSPECIFIED;
- }
+ if (scm_is_eq (sym, sym_error))
+ handler = SCM_FAILED_CONVERSION_ERROR;
+ else if (scm_is_eq (sym, sym_substitute))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else if (scm_is_eq (sym, sym_escape))
+ handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+ else
+ SCM_MISC_ERROR ("unknown conversion strategy ~s", scm_list_1 (sym));
- esc = scm_from_latin1_symbol ("escape");
- if (scm_is_true (scm_eqv_p (sym, esc)))
+ if (scm_is_false (port))
+ scm_i_set_default_port_conversion_handler (handler);
+ else
{
- scm_i_set_conversion_strategy_x (port,
- SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
- return SCM_UNSPECIFIED;
+ SCM_VALIDATE_OPPORT (1, port);
+ SCM_PTAB_ENTRY (port)->ilseq_handler = handler;
}
- SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
-
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -2857,11 +2866,10 @@ scm_init_ports ()
scm_make_fluid_with_default (SCM_BOOL_F));
scm_port_encoding_init = 1;
- SCM_VARIABLE_SET (scm_conversion_strategy,
- scm_make_fluid_with_default
- (scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK)));
+ SCM_VARIABLE_SET (default_conversion_strategy_var,
+ scm_make_fluid_with_default (sym_substitute));
scm_conversion_strategy_init = 1;
-
+
/* These bindings are used when boot-9 turns `current-input-port' et
al into parameters. They are then removed from the guile module. */
scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
diff --git a/libguile/ports.h b/libguile/ports.h
index f33f792b9..92e388e82 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -297,13 +297,14 @@ SCM_API SCM scm_close_output_port (SCM port);
characters. */
SCM_INTERNAL const char *scm_i_default_port_encoding (void);
SCM_INTERNAL void scm_i_set_default_port_encoding (const char *);
+SCM_INTERNAL scm_t_string_failed_conversion_handler
+scm_i_default_port_conversion_handler (void);
+SCM_INTERNAL void
+scm_i_set_default_port_conversion_handler (scm_t_string_failed_conversion_handler);
SCM_INTERNAL scm_t_iconv_descriptors *scm_i_port_iconv_descriptors (SCM port);
SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str);
SCM_API SCM scm_port_encoding (SCM port);
SCM_API SCM scm_set_port_encoding_x (SCM port, SCM encoding);
-SCM_INTERNAL scm_t_string_failed_conversion_handler scm_i_get_conversion_strategy (SCM port);
-SCM_INTERNAL void scm_i_set_conversion_strategy_x (SCM port,
- scm_t_string_failed_conversion_handler h);
SCM_API SCM scm_port_conversion_strategy (SCM port);
SCM_API SCM scm_set_port_conversion_strategy_x (SCM port, SCM behavior);
diff --git a/libguile/print.c b/libguile/print.c
index 1f447bb99..90bc9adf8 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -60,6 +60,9 @@
/* Character printers. */
+#define PORT_CONVERSION_HANDLER(port) \
+ SCM_PTAB_ENTRY (port)->ilseq_handler
+
static size_t display_string (const void *, int, size_t, SCM,
scm_t_string_failed_conversion_handler);
@@ -417,7 +420,7 @@ print_normal_symbol (SCM sym, SCM port)
scm_t_string_failed_conversion_handler strategy;
len = scm_i_symbol_length (sym);
- strategy = scm_i_get_conversion_strategy (port);
+ strategy = SCM_PTAB_ENTRY (port)->ilseq_handler;
if (scm_i_is_narrow_symbol (sym))
display_string (scm_i_symbol_chars (sym), 1, len, port, strategy);
@@ -432,7 +435,7 @@ print_extended_symbol (SCM sym, SCM port)
scm_t_string_failed_conversion_handler strategy;
len = scm_i_symbol_length (sym);
- strategy = scm_i_get_conversion_strategy (port);
+ strategy = PORT_CONVERSION_HANDLER (port);
scm_lfwrite_unlocked ("#{", 2, port);
@@ -539,7 +542,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
else
{
if (!display_character (SCM_CHAR (exp), port,
- scm_i_get_conversion_strategy (port)))
+ PORT_CONVERSION_HANDLER (port)))
scm_encoding_error (__func__, errno,
"cannot convert to output locale",
port, exp);
@@ -625,7 +628,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
printed = display_string (scm_i_string_data (exp),
scm_i_is_narrow_string (exp),
len, port,
- scm_i_get_conversion_strategy (port));
+ PORT_CONVERSION_HANDLER (port));
if (SCM_UNLIKELY (printed < len))
scm_encoding_error (__func__, errno,
"cannot convert to output locale",
@@ -1178,7 +1181,7 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
int printed = 0;
scm_t_string_failed_conversion_handler strategy;
- strategy = scm_i_get_conversion_strategy (port);
+ strategy = PORT_CONVERSION_HANDLER (port);
if (string_escapes_p)
{
@@ -1539,7 +1542,7 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
port = SCM_COERCE_OUTPORT (port);
if (!display_character (SCM_CHAR (chr), port,
- scm_i_get_conversion_strategy (port)))
+ PORT_CONVERSION_HANDLER (port)))
scm_encoding_error (__func__, errno,
"cannot convert to output locale",
port, chr);
diff --git a/libguile/strings.c b/libguile/strings.c
index bc715e0c1..7c5550fb3 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1578,7 +1578,7 @@ SCM
scm_from_locale_stringn (const char *str, size_t len)
{
return scm_from_stringn (str, len, locale_charset (),
- scm_i_get_conversion_strategy (SCM_BOOL_F));
+ scm_i_default_port_conversion_handler ());
}
SCM
@@ -1877,9 +1877,9 @@ scm_to_locale_string (SCM str)
char *
scm_to_locale_stringn (SCM str, size_t *lenp)
{
- return scm_to_stringn (str, lenp,
+ return scm_to_stringn (str, lenp,
locale_charset (),
- scm_i_get_conversion_strategy (SCM_BOOL_F));
+ scm_i_default_port_conversion_handler ());
}
char *
diff --git a/libguile/strports.c b/libguile/strports.c
index 7b51a8c87..702022740 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006,
+ * 2009, 2010, 2011, 2012 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
* as published by the Free Software Foundation; either version 3 of
@@ -292,10 +293,11 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
z = scm_c_make_port_with_encoding (scm_tc16_strport, modes,
encoding,
- SCM_FAILED_CONVERSION_ERROR,
+ scm_i_default_port_conversion_handler (),
(scm_t_bits)buf);
pt = SCM_PTAB_ENTRY (z);
+
pt->write_buf = pt->read_buf = (unsigned char *) c_buf;
pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
pt->read_buf_size = read_buf_size;