summaryrefslogtreecommitdiff
path: root/libguile/print.c
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2014-01-14 22:23:39 -0500
committerMark H Weaver <mhw@netris.org>2014-01-14 22:23:39 -0500
commitc92ee2b38cb1ace800de081c9211120afea0c595 (patch)
treeb36dc3fd52891ea5e53c94e22bb777f6e7d6e4f4 /libguile/print.c
parentcb8aaef4d08989aea2b7f088d298f71a03ecc1b2 (diff)
parent6e504a7b44a9a25787bdfb2d86fdddd3029f4ba9 (diff)
downloadguile-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.c75
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