Re-introduce pretty-printing of combining characters.

This had been removed by commit 07f49ac786e0f1c007eb336e2fb7a572e8405316
("Factorize and optimize `write' for strings and characters.").
Thanks Mike!

* libguile/print.c (write_combining_character): New procedure.
  (write_character): Use it.

* test-suite/tests/chars.test ("basic char handling")["combining accent
  is pretty-printed", "combining X is pretty-printed"]: New tests.

* test-suite/tests/encoding-iso88591.test ("characters")["write A
  followed by combining accent"]: New test.

* test-suite/tests/encoding-utf8.test ("characters")["write A followed
  by combining accent"]: New test.

diff --git a/libguile/print.c b/libguile/print.c
index ce48f88..2ffe70e 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -800,6 +800,47 @@ display_character (scm_t_wchar ch, SCM port,
   return printed;
 }
 
+/* Attempt to pretty-print CH, a combining character, to PORT.  Return
+   zero upon failure, non-zero otherwise.  The idea is to print CH above
+   a dotted circle to make it more visible.  */
+static int
+write_combining_character (scm_t_wchar ch, SCM port)
+{
+  int printed;
+  const char *encoding;
+
+  encoding = scm_i_get_port_encoding (port);
+  if (encoding != NULL)
+    {
+      scm_t_wchar str[2];
+      char locale_encoded[sizeof (str)], *result;
+      size_t len;
+
+      str[0] = SCM_CODEPOINT_DOTTED_CIRCLE;
+      str[1] = ch;
+
+      len = sizeof (locale_encoded);
+      result = u32_conv_to_encoding (encoding, iconveh_error,
+                                    (scm_t_uint32 *) str, 2,
+                                    NULL, locale_encoded, &len);
+      if (result != NULL)
+       {
+         scm_lfwrite (result, len, port);
+         printed = 1;
+         if (SCM_UNLIKELY (result != locale_encoded))
+           free (result);
+       }
+      else
+       /* Can't write the result to PORT.  */
+       printed = 0;
+    }
+  else
+    /* PORT is Latin-1-encoded and can't display the fancy things.  */
+    printed = 0;
+
+  return printed;
+}
+
 /* Write CH to PORT, escaping it if it's non-graphic or not
    representable in PORT's encoding.  If STRING_ESCAPES_P is true and CH
    needs to be escaped, it is escaped using the in-string escape syntax;
@@ -825,7 +866,14 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
        }
     }
   else
-    scm_puts ("#\\", port);
+    {
+      scm_puts ("#\\", port);
+
+      if (uc_combining_class (ch) != UC_CCC_NR)
+       /* Character is a combining character, so attempt to
+          pretty-print it.  */
+       printed = write_combining_character (ch, port);
+    }
 
   if (!printed
       && uc_is_general_category_withtable (ch,

diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index 509f070..bdc9bdb 100644 (file)
--- a/test-suite/tests/chars.test
+++ b/test-suite/tests/chars.test
@@ -1,7 +1,7 @@
-;;;; chars.test --- test suite for Guile's char functions    -*- scheme -*-
+;;;; chars.test --- Characters.       -*- coding: utf-8; mode: scheme; -*-
 ;;;; Greg J. Badros <gjb@cs.washington.edu>
 ;;;;
-;;;;   Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2000, 2006, 2009, 2010 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
@@ -311,5 +311,18 @@
     (pass-if "C0 control character names are preferred write format"
       (string=?
        (with-output-to-string (lambda () (write #\soh)))
-       "#\\soh"))))
-
+       "#\\soh"))
+
+    (pass-if "combining accent is pretty-printed"
+      (let ((accent (integer->char #x030f))) ; COMBINING DOUBLE GRAVE ACCENT
+        (string=?
+         (with-fluids ((%default-port-encoding "UTF-8"))
+           (with-output-to-string (lambda () (write accent))))
+         "#\\◌̏")))
+
+    (pass-if "combining X is pretty-printed"
+      (let ((x (integer->char #x0353))) ; COMBINING X BELOW
+        (string=?
+         (with-fluids ((%default-port-encoding "UTF-8"))
+           (with-output-to-string (lambda () (write x))))
+         "#\\◌͓")))))

diff --git a/test-suite/tests/encoding-iso88591.test b/test-suite/tests/encoding-iso88591.test
index bcc8aa7..f7bec5e 100644 (file)
--- a/test-suite/tests/encoding-iso88591.test
+++ b/test-suite/tests/encoding-iso88591.test
@@ -87,7 +87,15 @@
              (set-port-conversion-strategy! pt 'escape)
              (write a-acute pt)
              (string=? "#\\Á"
-                       (get-output-string pt)))))
+                       (get-output-string pt))))
+
+  (pass-if "write A followed by combining accent"
+           (let ((pt (open-output-string)))
+             (set-port-encoding! pt "ISO-8859-1")
+             (set-port-conversion-strategy! pt 'escape)
+             (write (string #\A (integer->char #x030f)) pt)
+             (string-ci=? "\"A\\u030f\""
+                          (get-output-string pt)))))
 
 
 (define s1 "última")

diff --git a/test-suite/tests/encoding-utf8.test b/test-suite/tests/encoding-utf8.test
index b82994c..966a04d 100644 (file)
--- a/test-suite/tests/encoding-utf8.test
+++ b/test-suite/tests/encoding-utf8.test
@@ -94,6 +94,14 @@
              (string=? "#\\Á"
                        (get-output-string pt))))
 
+  (pass-if "write A followed by combining accent"
+           (let ((pt (open-output-string)))
+             (set-port-encoding! pt "UTF-8")
+             (set-port-conversion-strategy! pt 'escape)
+             (write (string #\A (integer->char #x030f)) pt)
+             (string-ci=? "\"Ȁ\""
+                          (get-output-string pt))))
+
   (pass-if "write alpha"
            (let ((pt (open-output-string)))
              (set-port-encoding! pt "UTF-8")