From c03ef352bcdfcc4f00a943477f4a6eaa7499f5eb Mon Sep 17 00:00:00 2001
From: Michael Gran <spk121@yahoo.com>
Date: Sun, 26 Sep 2010 12:25:18 -0700
Subject: [PATCH] Favor non-hex string escapes over hex escapes when writing
 strings

The characters U+0007 to U+000D have non-hex forms for their
escapes when in written strings.

* libguile/print.c (write_character): use non-hex escapes
* test-suite/tests/reader.test (write R6RS string escapes): adjust test
---
 libguile/print.c             | 10 +++++++++-
 test-suite/tests/reader.test |  3 ++-
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/libguile/print.c b/libguile/print.c
index bdc6c9f20..ad3e8c09a 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -904,9 +904,17 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
 	  /* Represent CH using the in-string escape syntax.  */
 
 	  static const char hex[] = "0123456789abcdef";
+          static const char escapes[7] = "abtnvfr";
 	  char buf[9];
 
-	  if (!SCM_R6RS_ESCAPES_P)
+          if (ch >= 0x07 && ch <= 0x0D && ch != 0x0A)
+            {
+              /* Use special escapes for some C0 controls.  */
+              buf[0] = '\\';
+              buf[1] = escapes[ch - 0x07];
+              scm_lfwrite (buf, 2, port);
+            }
+          else if (!SCM_R6RS_ESCAPES_P)
 	    {
 	      if (ch <= 0xFF)
 		{
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 6fe7a23bc..6686ca2be 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -309,6 +309,7 @@
     (pass-if "write R6RS string escapes"
        (let* ((s1 (apply string
                          (map integer->char '(#x8 ; backspace
+                                              #x18 ; cancel
                                               #x20 ; space
                                               #x30 ; zero
                                               #x40 ; at sign
@@ -319,7 +320,7 @@
                         (lambda () (write s1)))))))
          (lset= eqv?
                 (string->list s2)
-                (list #\" #\\ #\x #\8 #\; #\space #\0 #\@ #\"))))
+                (list #\" #\\ #\b #\\ #\x #\1 #\8 #\; #\space #\0 #\@ #\"))))
 
     (pass-if "display R6RS string escapes"
       (string=?