diff options
author | Mark H Weaver <mhw@netris.org> | 2014-01-14 22:23:39 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2014-01-14 22:23:39 -0500 |
commit | c92ee2b38cb1ace800de081c9211120afea0c595 (patch) | |
tree | b36dc3fd52891ea5e53c94e22bb777f6e7d6e4f4 /libguile/print.c | |
parent | cb8aaef4d08989aea2b7f088d298f71a03ecc1b2 (diff) | |
parent | 6e504a7b44a9a25787bdfb2d86fdddd3029f4ba9 (diff) | |
download | guile-c92ee2b38cb1ace800de081c9211120afea0c595.tar.gz |
Merge branch 'stable-2.0'
Conflicts:
libguile/print.c
libguile/read.c
test-suite/tests/print.test
Diffstat (limited to 'libguile/print.c')
-rw-r--r-- | libguile/print.c | 75 |
1 files changed, 68 insertions, 7 deletions
diff --git a/libguile/print.c b/libguile/print.c index a8f220b63..4fe9b7770 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, 2012, 2013 Free Software Foundation, Inc. + * 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 @@ -113,6 +113,8 @@ scm_t_option scm_print_opts[] = { "'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'." }, + { SCM_OPTION_BOOLEAN, "r7rs-symbols", 0, + "Escape symbols using R7RS |...| symbol notation." }, { 0 }, }; @@ -359,6 +361,13 @@ symbol_has_extended_read_syntax (SCM sym) case '#': /* Some initial-character constraints. */ return 1; + + case '|': + case '\\': + /* R7RS allows neither '|' nor '\' in bare symbols. */ + if (SCM_PRINT_R7RS_SYMBOLS_P) + return 1; + break; case ':': /* Symbols that look like keywords. */ @@ -409,6 +418,9 @@ symbol_has_extended_read_syntax (SCM sym) return 1; else if (c == '"' || c == ';' || c == '#') return 1; + else if ((c == '|' || c == '\\') && SCM_PRINT_R7RS_SYMBOLS_P) + /* R7RS allows neither '|' nor '\' in bare symbols. */ + return 1; } return 0; @@ -456,23 +468,72 @@ print_extended_symbol (SCM sym, SCM port) } else { - display_string ("\\x", 1, 2, port, iconveh_question_mark); + scm_lfwrite_unlocked ("\\x", 2, port); scm_intprint (c, 16, port); - display_character (';', port, iconveh_question_mark); + scm_putc_unlocked (';', port); } } scm_lfwrite_unlocked ("}#", 2, port); } -/* FIXME: allow R6RS hex escapes instead of #{...}#. */ +static void +print_r7rs_extended_symbol (SCM sym, SCM port) +{ + size_t pos, len; + scm_t_string_failed_conversion_handler strategy; + + len = scm_i_symbol_length (sym); + strategy = PORT_CONVERSION_HANDLER (port); + + scm_putc_unlocked ('|', port); + + for (pos = 0; pos < len; pos++) + { + scm_t_wchar c = scm_i_symbol_ref (sym, pos); + + switch (c) + { + case '\a': scm_lfwrite_unlocked ("\\a", 2, port); break; + case '\b': scm_lfwrite_unlocked ("\\b", 2, port); break; + case '\t': scm_lfwrite_unlocked ("\\t", 2, port); break; + case '\n': scm_lfwrite_unlocked ("\\n", 2, port); break; + case '\r': scm_lfwrite_unlocked ("\\r", 2, port); break; + case '|': scm_lfwrite_unlocked ("\\|", 2, port); break; + case '\\': scm_lfwrite_unlocked ("\\x5c;", 5, port); break; + default: + if (uc_is_general_category_withtable (c, + SUBSEQUENT_IDENTIFIER_MASK + | UC_CATEGORY_MASK_Zs)) + { + if (!display_character (c, port, strategy)) + scm_encoding_error ("print_r7rs_extended_symbol", errno, + "cannot convert to output locale", + port, SCM_MAKE_CHAR (c)); + } + else + { + scm_lfwrite_unlocked ("\\x", 2, port); + scm_intprint (c, 16, port); + scm_putc_unlocked (';', port); + } + break; + } + } + + scm_putc_unlocked ('|', port); +} + +/* FIXME: allow R6RS hex escapes instead of #{...}# or |...|. */ static void print_symbol (SCM sym, SCM port) { - if (symbol_has_extended_read_syntax (sym)) - print_extended_symbol (sym, port); - else + if (!symbol_has_extended_read_syntax (sym)) print_normal_symbol (sym, port); + else if (SCM_PRINT_R7RS_SYMBOLS_P) + print_r7rs_extended_symbol (sym, port); + else + print_extended_symbol (sym, port); } void |