diff options
author | Michael Gran <spk121@yahoo.com> | 2010-01-12 21:02:41 -0800 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2010-01-12 21:02:41 -0800 |
commit | dea901d66e46041f96d3d3a0f95bf0ab209387c9 (patch) | |
tree | f46c70881aac3180a26b2b716725794e3fc14269 /libguile/print.c | |
parent | 8470b3f45b48bf627642e8f41938492be4eacf2c (diff) | |
download | guile-dea901d66e46041f96d3d3a0f95bf0ab209387c9.tar.gz |
Reader option for R6RS hex escapes
This adds a reader option 'r6rs-hex-escapes that modifies the
behavior of numeric escapes in characters and strings. When enabled,
variable-length character hex escapes (#\xNNN) are allowed and become
the default output format for numerically-escaped characters. Also,
string hex escapes switch to a semicolon terminated hex escape (\xNNNN;).
* libguile/print.c (PRINT_CHAR_ESCAPE): new macro
(iprin1): use new macro PRINT_CHAR_ESCAPE
* libguile/private-options.h (SCM_R6RS_ESCAPES_P): new #define
* libguile/read.c (scm_read_opts): add new option r6rs-hex-escapes
(SCM_READ_HEX_ESCAPE): modify to take a terminator parameter
(scm_read_string): parse R6RS hex string escapes
(scm_read_character): parse R6RS hex character escapes
* test-suite/tests/chars.test (with-read-options): new procedure
(R6RS hex escapes): new tests
* test-suite/tests/strings.test (with-read-options): new procedure
(R6RS hex escapes): new tests
Diffstat (limited to 'libguile/print.c')
-rw-r--r-- | libguile/print.c | 106 |
1 files changed, 73 insertions, 33 deletions
diff --git a/libguile/print.c b/libguile/print.c index aef575d80..dcf28c7c2 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -409,6 +409,22 @@ SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display); static void iprin1 (SCM exp, SCM port, scm_print_state *pstate); + +/* Print a character as an octal or hex escape. */ +#define PRINT_CHAR_ESCAPE(i, port) \ + do \ + { \ + if (!SCM_R6RS_ESCAPES_P) \ + scm_intprint (i, 8, port); \ + else \ + { \ + scm_puts ("x", port); \ + scm_intprint (i, 16, port); \ + } \ + } \ + while (0) + + void scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) { @@ -488,7 +504,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) else /* Character is graphic but unrepresentable in this port's encoding. */ - scm_intprint (i, 8, port); + PRINT_CHAR_ESCAPE (i, port); } else { @@ -507,12 +523,12 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) else /* Character is graphic but unrepresentable in this port's encoding. */ - scm_intprint (i, 8, port); + PRINT_CHAR_ESCAPE (i, port); } } else /* Character is a non-graphical character. */ - scm_intprint (i, 8, port); + PRINT_CHAR_ESCAPE (i, port); } else scm_i_charprint (i, port); @@ -579,9 +595,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) case scm_tc7_string: if (SCM_WRITINGP (pstate)) { - size_t i, j, len; + size_t i, len; static char const hex[] = "0123456789abcdef"; - char buf[8]; + char buf[9]; scm_putc ('"', port); @@ -647,37 +663,61 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) { /* Character is graphic but unrepresentable in this port's encoding or is not graphic. */ - if (ch <= 0xFF) + if (!SCM_R6RS_ESCAPES_P) { - buf[0] = '\\'; - buf[1] = 'x'; - buf[2] = hex[ch / 16]; - buf[3] = hex[ch % 16]; - scm_lfwrite (buf, 4, port); - } - else if (ch <= 0xFFFF) - { - buf[0] = '\\'; - buf[1] = 'u'; - buf[2] = hex[(ch & 0xF000) >> 12]; - buf[3] = hex[(ch & 0xF00) >> 8]; - buf[4] = hex[(ch & 0xF0) >> 4]; - buf[5] = hex[(ch & 0xF)]; - scm_lfwrite (buf, 6, port); - j = i + 1; + if (ch <= 0xFF) + { + buf[0] = '\\'; + buf[1] = 'x'; + buf[2] = hex[ch / 16]; + buf[3] = hex[ch % 16]; + scm_lfwrite (buf, 4, port); + } + else if (ch <= 0xFFFF) + { + buf[0] = '\\'; + buf[1] = 'u'; + buf[2] = hex[(ch & 0xF000) >> 12]; + buf[3] = hex[(ch & 0xF00) >> 8]; + buf[4] = hex[(ch & 0xF0) >> 4]; + buf[5] = hex[(ch & 0xF)]; + scm_lfwrite (buf, 6, port); + } + else if (ch > 0xFFFF) + { + buf[0] = '\\'; + buf[1] = 'U'; + buf[2] = hex[(ch & 0xF00000) >> 20]; + buf[3] = hex[(ch & 0xF0000) >> 16]; + buf[4] = hex[(ch & 0xF000) >> 12]; + buf[5] = hex[(ch & 0xF00) >> 8]; + buf[6] = hex[(ch & 0xF0) >> 4]; + buf[7] = hex[(ch & 0xF)]; + scm_lfwrite (buf, 8, port); + } } - else if (ch > 0xFFFF) + else { - buf[0] = '\\'; - buf[1] = 'U'; - buf[2] = hex[(ch & 0xF00000) >> 20]; - buf[3] = hex[(ch & 0xF0000) >> 16]; - buf[4] = hex[(ch & 0xF000) >> 12]; - buf[5] = hex[(ch & 0xF00) >> 8]; - buf[6] = hex[(ch & 0xF0) >> 4]; - buf[7] = hex[(ch & 0xF)]; - scm_lfwrite (buf, 8, port); - j = i + 1; + scm_t_wchar ch2 = ch; + + /* Print an R6RS variable-length hex escape: "\xNNNN;" + */ + int i = 8; + buf[i] = ';'; + i --; + if (ch == 0) + buf[i--] = '0'; + else + while (ch2 > 0) + { + buf[i] = hex[ch2 & 0xF]; + ch2 >>= 4; + i --; + } + buf[i] = 'x'; + i --; + buf[i] = '\\'; + scm_lfwrite (buf + i, 9 - i, port); } } } |