diff options
author | Michael Gran <spk121@yahoo.com> | 2009-08-25 07:54:37 -0700 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2009-08-25 07:54:37 -0700 |
commit | 889975e51accb80491af76fc5db980aeb3edd342 (patch) | |
tree | 43b57c4388abcf86e97f8f413abc4ebbcaeac1a8 /libguile/print.c | |
parent | 9db8cf1634ca9a91cb88b2532f7b87f2502b4abd (diff) | |
download | guile-889975e51accb80491af76fc5db980aeb3edd342.tar.gz |
Add full Unicode capability to ports and the default reader
Ports are given two additional properties: a character encoding and
a conversion failure strategy. These properties have getters and setters.
The new properties are used to convert any locale text to/from the
internal representation of strings.
If unspecified, ports use a default value. The default value of these
properties is held in a fluid. The default character encoding can be
modified by calling setlocale.
ISO-8859-1 is treated specially. Since it is a native encoding of
strings, it can be processed more quickly. Source code is assumed to be
ISO-8859-1 unless otherwise specified. The encoding of a source code
file can be given as 'coding: XXXXX' in a magic comment at the top of a
file.
The C functions that deal with encoding often use a null pointer
as shorthand for the native Latin-1 encoding, for efficiency's sake.
* test-suite/tests/encoding-iso88591.test: new tests
* test-suite/tests/encoding-iso88597.test: new tests
* test-suite/tests/encoding-utf8.test: new tests
* test-suite/tests/encoding-escapes.test: new tests
* test-suite/tests/numbers.test: declare 'binary' encoding
* test-suite/tests/ports.test: declare 'binary' encoding
* test-suite/tests/r6rs-ports.test: declare 'binary' encoding
* module/system/base/compile.scm (compile-file): use source-code
file's self-declared encoding when compiling files
* libguile/strports.c: store string ports in locale encoding
(scm_strport_to_locale_u8vector, scm_call_with_output_locale_u8vector)
(scm_open_input_locale_u8vector, scm_get_output_locale_u8vector):
new functions
* libguile/strings.h: new declaration for scm_i_string_contains_char
* libguile/strings.c (scm_i_string_contains_char): new function
(scm_from_stringn, scm_to_stringn): use NULL for Latin-1
(scm_from_locale_stringn, scm_to_locale_stringn): respect character
encoding of input and output ports
* libguile/read.h: declaration for scm_scan_for_encoding
* libguile/read.c:
(read_token): now takes scheme string instead of C string/length
(read_complete_token): new function
(scm_read_sexp, scm_read_number, scm_read_mixed_case_symbol)
(scm_read_number_and_radix, scm_read_quote, scm_read_semicolon_comment)
(scm_read_srfi4_vector, scm_read_bytevector, scm_read_guile_bit_vector)
(scm_read_scsh_block_comment, scm_read_commented_expression)
(scm_read_extended_symbol, scm_read_sharp_extension, scm_read_shart)
(scm_read_expression): use scm_t_wchar for char type, use read_complete_token
(scm_scan_for_encoding): new function to find a file's character encoding
(scm_file_encoding): new function to find a port's character encoding
* libguile/rdelim.c: don't unpack strings
* libguile/print.h: declaration for modified function
scm_i_charprint
* libguile/print.c: use locale when printing characters and
strings
(scm_i_charprint): input parameter is now scm_t_wchar
(scm_simple_format): don't unpack strings
* libguile/posix.h: new declaration for scm_setbinary.
* libguile/posix.c (scm_setlocale): set default and stdio port
encodings based on the locale's character encoding
(scm_setbinary): new function
* libguile/ports.h (scm_t_port): add encoding and failed
conversion handler to port type. Declarations for new or modified
functions scm_getc, scm_unget_byte, scm_ungetc,
scm_i_get_port_encoding, scm_i_set_port_encoding_x,
scm_port_encoding, scm_set_port_encoding_x,
scm_i_get_conversion_strategy, scm_i_set_conversion_strategy_x,
scm_port_conversion_strategy, scm_set_port_conversion_strategy_x.
* libguile/ports.c: assign the current ports to zero on startup so
we can see if they've been set.
(scm_current_input_port, scm_current_output_port,
scm_current_error_port): return #f if the port is not yet
initialized
(scm_new_port_table_entry): set up a new port's encoding and
illegal sequence handler based on the thread's current defaults
(scm_i_remove_port): free port encoding name when port is removed
(scm_i_mode_bits_n): now takes a scheme string instead of a c
string and length. All callers changed.
(SCM_MBCHAR_BUF_SIZE): new const
(scm_getc): new function, since the scm_getc in inline.h is now
scm_get_byte_or_eof. This pulls one codepoint from a port.
(scm_lfwrite_substr, scm_lfwrite_str): now uses port's encoding
(scm_unget_byte): new function, incorportaing the low-level functionality
of scm_ungetc
(scm_ungetc): uses scm_unget_byte
* libguile/numbers.h (scm_t_wchar): compilation order problem with
scm_t_wchar being use in functions in multiple headers. Forward
declare scm_t_wchar.
* libguile/load.c (scm_primitive_load): scan for file encoding at
top of file and use it to set the load port's encoding
* libguile/inline.h (scm_get_byte_or_eof): new function
incorporating most of the functionality of scm_getc.
* libguile/fports.c (fport_fill_input): now returns scm_t_wchar
* libguile/chars.h (scm_t_wchar): avoid compilation order problem
with declaration of scm_t_wchar
Diffstat (limited to 'libguile/print.c')
-rw-r--r-- | libguile/print.c | 103 |
1 files changed, 69 insertions, 34 deletions
diff --git a/libguile/print.c b/libguile/print.c index 07bff47fd..520a2d95c 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -463,20 +463,45 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) | UC_CATEGORY_MASK_S)) /* Print the character if is graphic character. */ { - if (i<256) - /* Character is graphic. Print it. */ - scm_putc (i, port); + scm_t_wchar *wbuf; + SCM wstr = scm_i_make_wide_string (1, &wbuf); + char *buf; + size_t len; + const char *enc; + + enc = scm_i_get_port_encoding (port); + wbuf[0] = i; + if (enc == NULL && i <= 0xFF) + { + /* Character is graphic and Latin-1. Print it */ + scm_lfwrite_str (wstr, port); + } else - /* Character is graphic but unrepresentable in - this port's encoding. */ - scm_intprint (i, 8, port); + { + buf = u32_conv_to_encoding (enc, + iconveh_error, + (scm_t_uint32 *) wbuf, + 1, + NULL, + NULL, &len); + if (buf != NULL) + { + /* Character is graphic. Print it. */ + scm_lfwrite_str (wstr, port); + free (buf); + } + else + /* Character is graphic but unrepresentable in + this port's encoding. */ + scm_intprint (i, 8, port); + } } else /* Character is a non-graphical character. */ scm_intprint (i, 8, port); } else - scm_putc (i, port); + scm_i_charprint (i, port); } else if (SCM_IFLAGP (exp) && ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof (char *)))) @@ -608,21 +633,32 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) SCM wstr = scm_i_make_wide_string (1, &wbuf); char *buf; size_t len; - - wbuf[0] = ch; - - buf = u32_conv_to_encoding ("ISO-8859-1", - iconveh_error, - (scm_t_uint32 *) wbuf, - 1, NULL, NULL, &len); - if (buf != NULL) + + if (scm_i_get_port_encoding (port)) { - /* Character is graphic and representable in - this encoding. Print it. */ - scm_lfwrite_str (wstr, port); - free (buf); - printed = 1; + wstr = scm_i_make_wide_string (1, &wbuf); + wbuf[0] = ch; + buf = u32_conv_to_encoding (scm_i_get_port_encoding (port), + iconveh_error, + (scm_t_uint32 *) wbuf, + 1 , + NULL, + NULL, &len); + if (buf != NULL) + { + /* Character is graphic and representable in + this encoding. Print it. */ + scm_lfwrite_str (wstr, port); + free (buf); + printed = 1; + } } + else + if (ch <= 0xFF) + { + scm_putc (ch, port); + printed = 1; + } } if (!printed) @@ -835,7 +871,7 @@ scm_prin1 (SCM exp, SCM port, int writingp) /* Print a character. */ void -scm_i_charprint (scm_t_uint32 ch, SCM port) +scm_i_charprint (scm_t_wchar ch, SCM port) { scm_t_wchar *wbuf; SCM wstr = scm_i_make_wide_string (1, &wbuf); @@ -1057,9 +1093,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, SCM port, answer = SCM_UNSPECIFIED; int fReturnString = 0; int writingp; - const char *start; - const char *end; - const char *p; + size_t start, p, end; if (scm_is_eq (destination, SCM_BOOL_T)) { @@ -1082,15 +1116,16 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, SCM_VALIDATE_STRING (2, message); SCM_VALIDATE_REST_ARGUMENT (args); - start = scm_i_string_chars (message); - end = start + scm_i_string_length (message); + p = 0; + start = 0; + end = scm_i_string_length (message); for (p = start; p != end; ++p) - if (*p == '~') + if (scm_i_string_ref (message, p) == '~') { if (++p == end) break; - switch (*p) + switch (scm_i_string_ref (message, p)) { case 'A': case 'a': writingp = 0; @@ -1099,33 +1134,33 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, writingp = 1; break; case '~': - scm_lfwrite (start, p - start, port); + scm_lfwrite_substr (message, start, p, port); start = p + 1; continue; case '%': - scm_lfwrite (start, p - start - 1, port); + scm_lfwrite_substr (message, start, p - 1, port); scm_newline (port); start = p + 1; continue; default: SCM_MISC_ERROR ("FORMAT: Unsupported format option ~~~A - use (ice-9 format) instead", - scm_list_1 (SCM_MAKE_CHAR (*p))); + scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref (message, p)))); } if (!scm_is_pair (args)) SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A", - scm_list_1 (SCM_MAKE_CHAR (*p))); + scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref (message, p)))); - scm_lfwrite (start, p - start - 1, port); + scm_lfwrite_substr (message, start, p - 1, port); /* we pass destination here */ scm_prin1 (SCM_CAR (args), destination, writingp); args = SCM_CDR (args); start = p + 1; } - scm_lfwrite (start, p - start, port); + scm_lfwrite_substr (message, start, p, port); if (!scm_is_eq (args, SCM_EOL)) SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments", scm_list_1 (scm_length (args))); |