From 33d92fe6ca726a51c079a6524c18217bbe371cee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Sep 2010 00:52:40 +0200 Subject: [PATCH] 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. --- libguile/print.c | 50 ++++++++++++++++++++++++- test-suite/tests/chars.test | 19 ++++++++-- test-suite/tests/encoding-iso88591.test | 10 ++++- test-suite/tests/encoding-utf8.test | 8 ++++ 4 files changed, 82 insertions(+), 5 deletions(-) diff --git a/libguile/print.c b/libguile/print.c index ce48f88f0..2ffe70ec0 100644 --- 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 509f07066..bdc9bdb41 100644 --- 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 ;;;; -;;;; 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 bcc8aa75a..f7bec5ef5 100644 --- 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 b82994c3a..966a04dde 100644 --- 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")