X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/b2b33168b18c6c4fd65b0e77becba1a66a00dae1..dc59631d3094ad39bba5e40d5c36200fb99023f9:/libguile/print.c diff --git a/libguile/print.c b/libguile/print.c index 4afd12c92..4e68fd6c4 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995-1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008, - * 2009, 2010, 2011 Free Software Foundation, Inc. + * 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 @@ -30,6 +30,7 @@ #include #include +#include #include "libguile/_scm.h" #include "libguile/chars.h" @@ -45,6 +46,7 @@ #include "libguile/alist.h" #include "libguile/struct.h" #include "libguile/ports.h" +#include "libguile/ports-internal.h" #include "libguile/root.h" #include "libguile/strings.h" #include "libguile/strports.h" @@ -61,6 +63,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); @@ -107,8 +112,9 @@ scm_t_option scm_print_opts[] = { { SCM_OPTION_SCM, "quote-keywordish-symbols", (scm_t_bits)SCM_BOOL_F_BITS, "How to print symbols that have a colon as their first or last character. " "The value '#f' does not quote the colons; '#t' quotes them; " - "'reader' quotes them when the reader option 'keywords' is not '#f'." - }, + "'reader' quotes them when the reader option 'keywords' is not '#f'." }, + { SCM_OPTION_BOOLEAN, "escape-newlines", 1, + "Render newlines as \\n when printing using `write'." }, { 0 }, }; @@ -392,7 +398,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 ("#{", 2, port); @@ -404,7 +410,8 @@ print_extended_symbol (SCM sym, SCM port) SUBSEQUENT_IDENTIFIER_MASK | UC_CATEGORY_MASK_Zs)) { - if (!display_character (c, port, strategy)) + if (!display_character (c, port, strategy) + || (c == '\\' && !display_character (c, port, strategy))) scm_encoding_error ("print_extended_symbol", errno, "cannot convert to output locale", port, SCM_MAKE_CHAR (c)); @@ -499,7 +506,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); @@ -585,7 +592,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", @@ -645,6 +652,17 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) case scm_tc7_with_fluids: scm_i_with_fluids_print (exp, port, pstate); break; + case scm_tc7_array: + ENTER_NESTED_DATA (pstate, exp, circref); + scm_i_print_array (exp, port, pstate); + EXIT_NESTED_DATA (pstate); + break; + case scm_tc7_bytevector: + scm_i_print_bytevector (exp, port, pstate); + break; + case scm_tc7_bitvector: + scm_i_print_bitvector (exp, port, pstate); + break; case scm_tc7_wvect: ENTER_NESTED_DATA (pstate, exp, circref); if (SCM_IS_WHVEC (exp)) @@ -652,10 +670,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) else scm_puts ("#w(", port); goto common_vector_printer; - - case scm_tc7_bytevector: - scm_i_print_bytevector (exp, port, pstate); - break; case scm_tc7_vector: ENTER_NESTED_DATA (pstate, exp, circref); scm_puts ("#(", port); @@ -868,9 +882,25 @@ display_string_using_iconv (const void *str, int narrow_p, size_t len, scm_t_string_failed_conversion_handler strategy) { size_t printed; - scm_t_port *pt; + scm_t_iconv_descriptors *id; + scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port); + + id = scm_i_port_iconv_descriptors (port, SCM_PORT_WRITE); + + if (SCM_UNLIKELY (pti->at_stream_start_for_bom_write && len > 0)) + { + scm_t_port *pt = SCM_PTAB_ENTRY (port); - pt = SCM_PTAB_ENTRY (port); + /* Record that we're no longer at stream start. */ + pti->at_stream_start_for_bom_write = 0; + if (pt->rw_random) + pti->at_stream_start_for_bom_read = 0; + + /* Write a BOM if appropriate. */ + if (SCM_UNLIKELY (c_strcasecmp(pt->encoding, "UTF-16") == 0 + || c_strcasecmp(pt->encoding, "UTF-32") == 0)) + display_character (SCM_UNICODE_BOM, port, iconveh_error); + } printed = 0; @@ -899,7 +929,7 @@ display_string_using_iconv (const void *str, int narrow_p, size_t len, output = encoded_output; output_left = sizeof (encoded_output); - done = iconv (pt->output_cd, &input, &input_left, + done = iconv (id->output_cd, &input, &input_left, &output, &output_left); output_len = sizeof (encoded_output) - output_left; @@ -909,7 +939,7 @@ display_string_using_iconv (const void *str, int narrow_p, size_t len, int errno_save = errno; /* Reset the `iconv' state. */ - iconv (pt->output_cd, NULL, NULL, NULL, NULL); + iconv (id->output_cd, NULL, NULL, NULL, NULL); /* Print the OUTPUT_LEN bytes successfully converted. */ scm_lfwrite (encoded_output, output_len, port); @@ -969,16 +999,11 @@ display_string (const void *str, int narrow_p, scm_t_string_failed_conversion_handler strategy) { - scm_t_port *pt; + scm_t_port_internal *pti; - pt = SCM_PTAB_ENTRY (port); + pti = SCM_PORT_GET_INTERNAL (port); - if (pt->output_cd == (iconv_t) -1) - /* Initialize the conversion descriptors, if needed. */ - scm_i_set_port_encoding_x (port, pt->encoding); - - /* FIXME: In 2.1, add a flag to determine whether a port is UTF-8. */ - if (pt->output_cd == (iconv_t) -1) + if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8) return display_string_as_utf8 (str, narrow_p, len, port); else return display_string_using_iconv (str, narrow_p, len, @@ -1108,7 +1133,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) { @@ -1119,6 +1144,12 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p) display_character (ch, port, strategy); printed = 1; } + else if (ch == '\n' && SCM_PRINT_ESCAPE_NEWLINES_P) + { + display_character ('\\', port, iconveh_question_mark); + display_character ('n', port, strategy); + printed = 1; + } else if (ch == ' ' || ch == '\n') { display_character (ch, port, strategy); @@ -1150,6 +1181,29 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p) write_character_escaped (ch, string_escapes_p, port); } +/* Display STR to PORT from START inclusive to END exclusive. */ +void +scm_i_display_substring (SCM str, size_t start, size_t end, SCM port) +{ + int narrow_p; + const char *buf; + size_t len, printed; + + buf = scm_i_string_data (str); + len = end - start; + narrow_p = scm_i_is_narrow_string (str); + buf += start * (narrow_p ? sizeof (char) : sizeof (scm_t_wchar)); + + printed = display_string (buf, narrow_p, end - start, port, + PORT_CONVERSION_HANDLER (port)); + + if (SCM_UNLIKELY (printed < len)) + scm_encoding_error (__func__, errno, + "cannot convert to output locale", + port, scm_c_string_ref (str, printed + start)); +} + + /* Print an integer. */ @@ -1336,7 +1390,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, "@var{message} can contain @code{~A} (was @code{%s}) and\n" "@code{~S} (was @code{%S}) escapes. When printed,\n" "the escapes are replaced with corresponding members of\n" - "@var{ARGS}:\n" + "@var{args}:\n" "@code{~A} formats using @code{display} and @code{~S} formats\n" "using @code{write}.\n" "If @var{destination} is @code{#t}, then use the current output\n" @@ -1455,7 +1509,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); @@ -1527,21 +1581,12 @@ SCM_DEFINE (scm_get_print_state, "get-print-state", 1, 0, 0, void scm_init_print () { - SCM vtable, layout, type; - - scm_init_opts (scm_print_options, scm_print_opts); - - scm_print_options (scm_list_4 (scm_from_latin1_symbol ("highlight-prefix"), - scm_from_locale_string ("{"), - scm_from_latin1_symbol ("highlight-suffix"), - scm_from_locale_string ("}"))); + SCM type; scm_gc_register_root (&print_state_pool); scm_gc_register_root (&scm_print_state_vtable); - vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL); - layout = - scm_make_struct_layout (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT)); - type = scm_make_struct (vtable, SCM_INUM0, scm_list_1 (layout)); + type = scm_make_vtable (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT), + SCM_BOOL_F); scm_set_struct_vtable_name_x (type, scm_from_latin1_symbol ("print-state")); scm_print_state_vtable = type; @@ -1551,6 +1596,11 @@ scm_init_print () #include "libguile/print.x" + scm_init_opts (scm_print_options, scm_print_opts); + scm_print_opts[SCM_PRINT_HIGHLIGHT_PREFIX_I].val = + SCM_UNPACK (scm_from_locale_string ("{")); + scm_print_opts[SCM_PRINT_HIGHLIGHT_SUFFIX_I].val = + SCM_UNPACK (scm_from_locale_string ("}")); scm_print_opts[SCM_PRINT_KEYWORD_STYLE_I].val = SCM_UNPACK (sym_reader); }