guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 07/09: Simplify string, symbol, char display/write impls


From: Andy Wingo
Subject: [Guile-commits] 07/09: Simplify string, symbol, char display/write impls
Date: Wed, 1 Jun 2016 10:11:30 +0000 (UTC)

wingo pushed a commit to branch master
in repository guile.

commit 0e888cd00b3a02fe73b2f678f992d3957d74d875
Author: Andy Wingo <address@hidden>
Date:   Mon May 30 18:49:25 2016 +0200

    Simplify string, symbol, char display/write impls
    
    * libguile/print.h:
    * libguile/print.c: Use the new routines from ports.[ch].
---
 libguile/print.c |  599 +++++++-----------------------------------------------
 libguile/print.h |    2 -
 2 files changed, 74 insertions(+), 527 deletions(-)

diff --git a/libguile/print.c b/libguile/print.c
index 519393c..2485d97 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -60,26 +60,8 @@
 
 /* Character printers.  */
 
-#define PORT_CONVERSION_HANDLER(port)          \
-  scm_i_string_failed_conversion_handler (scm_port_conversion_strategy (port))
-
-SCM_SYMBOL (sym_UTF_8, "UTF-8");
-SCM_SYMBOL (sym_ISO_8859_1, "ISO-8859-1");
-SCM_SYMBOL (sym_UTF_16, "UTF-16");
-SCM_SYMBOL (sym_UTF_32, "UTF-32");
-
-static size_t display_string (const void *, int, size_t, SCM,
-                             scm_t_string_failed_conversion_handler);
-
-static size_t write_string (const void *, int, size_t, SCM,
-                           scm_t_string_failed_conversion_handler);
-
-static int display_character (scm_t_wchar, SCM,
-                             scm_t_string_failed_conversion_handler);
-
-static void write_character (scm_t_wchar, SCM, int);
-
-static void write_character_escaped (scm_t_wchar, int, SCM);
+static void write_string (const void *, int, size_t, SCM);
+static void write_character (scm_t_wchar, SCM);
 
 
 
@@ -454,11 +436,8 @@ static void
 print_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_lfwrite ("#{", 2, port);
 
   for (pos = 0; pos < len; pos++)
@@ -468,13 +447,7 @@ print_extended_symbol (SCM sym, SCM port)
       if (uc_is_general_category_withtable (c,
                                             SUBSEQUENT_IDENTIFIER_MASK
                                             | UC_CATEGORY_MASK_Zs))
-        {
-          if (!display_character (c, port, strategy)
-              || (c == '\\' && !display_character (c, port, strategy)))
-            scm_encoding_error ("print_extended_symbol", errno,
-                                "cannot convert to output locale",
-                                port, SCM_MAKE_CHAR (c));
-        }
+        scm_c_put_char (port, c);
       else
         {
           scm_lfwrite ("\\x", 2, port);
@@ -490,10 +463,8 @@ 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 ('|', port);
 
@@ -518,12 +489,7 @@ print_r7rs_extended_symbol (SCM sym, SCM port)
                                                 | UC_CATEGORY_MASK_P
                                                 | UC_CATEGORY_MASK_S)
               || (c == ' '))
-            {
-              if (!display_character (c, port, strategy))
-                scm_encoding_error ("print_r7rs_extended_symbol", errno,
-                                    "cannot convert to output locale",
-                                    port, SCM_MAKE_CHAR (c));
-            }
+            scm_c_put_char (port, c);
           else
             {
               scm_lfwrite ("\\x", 2, port);
@@ -564,21 +530,6 @@ SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, 
g_display);
 static void iprin1 (SCM exp, SCM port, scm_print_state *pstate);
 
 
-/* Print a character as an octal or hex escape.  */
-#define PRINT_CHAR_ESCAPE(i, port)              \
-  do                                            \
-    {                                           \
-      if (!SCM_R6RS_ESCAPES_P)                  \
-        scm_intprint (i, 8, port);              \
-      else                                      \
-        {                                       \
-          scm_puts ("x", port);                 \
-          scm_intprint (i, 16, port);           \
-        }                                       \
-    }                                           \
-  while (0)
-
-  
 void 
 scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 {
@@ -641,15 +592,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
       if (SCM_CHARP (exp))
        {
          if (SCM_WRITINGP (pstate))
-           write_character (SCM_CHAR (exp), port, 0);
+           write_character (SCM_CHAR (exp), port);
          else
-           {
-             if (!display_character (SCM_CHAR (exp), port,
-                                     PORT_CONVERSION_HANDLER (port)))
-               scm_encoding_error (__func__, errno,
-                                   "cannot convert to output locale",
-                                   port, exp);
-           }
+            scm_c_put_char (port, SCM_CHAR (exp));
        }
       else if (SCM_IFLAGP (exp)
               && ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof 
(char *))))
@@ -715,26 +660,15 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
           break;
         case scm_tc7_string:
          {
-           size_t len, printed;
+           size_t len = scm_i_string_length (exp);
 
-           printed = len = scm_i_string_length (exp);
            if (SCM_WRITINGP (pstate))
-             {
-               printed = write_string (scm_i_string_data (exp),
-                                       scm_i_is_narrow_string (exp),
-                                       len, port,
-                                       PORT_CONVERSION_HANDLER (port));
-               len += 2;                   /* account for the quotes */
-             }
+              write_string (scm_i_string_data (exp),
+                            scm_i_is_narrow_string (exp),
+                            len, port);
            else
               scm_c_put_string (port, exp, 0, len);
-
-           if (SCM_UNLIKELY (printed < len))
-             scm_encoding_error (__func__, errno,
-                                 "cannot convert to output locale",
-                                 port, scm_c_string_ref (exp, printed));
          }
-
           scm_remember_upto_here_1 (exp);
           break;
        case scm_tc7_symbol:
@@ -889,471 +823,89 @@ scm_prin1 (SCM exp, SCM port, int writingp)
     }
 }
 
-/* Convert codepoint CH to UTF-8 and store the result in UTF8.  Return
-   the number of bytes of the UTF-8-encoded string.  */
-static size_t
-codepoint_to_utf8 (scm_t_wchar ch, scm_t_uint8 utf8[4])
-{
-  size_t len;
-  scm_t_uint32 codepoint;
-
-  codepoint = (scm_t_uint32) ch;
-
-  if (codepoint <= 0x7f)
-    {
-      len = 1;
-      utf8[0] = (scm_t_uint8) codepoint;
-    }
-  else if (codepoint <= 0x7ffUL)
-    {
-      len = 2;
-      utf8[0] = 0xc0 | (codepoint >> 6);
-      utf8[1] = 0x80 | (codepoint & 0x3f);
-    }
-  else if (codepoint <= 0xffffUL)
-    {
-      len = 3;
-      utf8[0] = 0xe0 | (codepoint >> 12);
-      utf8[1] = 0x80 | ((codepoint >> 6) & 0x3f);
-      utf8[2] = 0x80 | (codepoint & 0x3f);
-    }
-  else
-    {
-      len = 4;
-      utf8[0] = 0xf0 | (codepoint >> 18);
-      utf8[1] = 0x80 | ((codepoint >> 12) & 0x3f);
-      utf8[2] = 0x80 | ((codepoint >> 6) & 0x3f);
-      utf8[3] = 0x80 | (codepoint & 0x3f);
-    }
-
-  return len;
-}
-
-#define STR_REF(s, x)                          \
-  (narrow_p                                    \
-   ? (scm_t_wchar) ((unsigned char *) (s))[x]  \
-   : ((scm_t_wchar *) (s))[x])
-
-/* Write STR to PORT as UTF-8.  STR is a LEN-codepoint string; it is
-   narrow if NARROW_P is true, wide otherwise.  Return LEN.  */
-static size_t
-display_string_as_utf8 (const void *str, int narrow_p, size_t len,
-                       SCM port)
-{
-  size_t printed = 0;
-
-  while (len > printed)
-    {
-      size_t utf8_len, i;
-      char *input, utf8_buf[256];
-
-      /* Convert STR to UTF-8.  */
-      for (i = printed, utf8_len = 0, input = utf8_buf;
-          i < len && utf8_len + 4 < sizeof (utf8_buf);
-          i++)
-       {
-         utf8_len += codepoint_to_utf8 (STR_REF (str, i),
-                                        (scm_t_uint8 *) input);
-         input = utf8_buf + utf8_len;
-       }
-
-      /* INPUT was successfully converted, entirely; print the
-        result.  */
-      scm_lfwrite (utf8_buf, utf8_len, port);
-      printed += i - printed;
-    }
-
-  assert (printed == len);
-
-  return len;
-}
-
-/* Write STR to PORT as ISO-8859-1.  STR is a LEN-codepoint string; it
-   is narrow if NARROW_P is true, wide otherwise.  Return LEN.  */
-static size_t
-display_string_as_latin1 (const void *str, int narrow_p, size_t len,
-                          SCM port,
-                          scm_t_string_failed_conversion_handler strategy)
-{
-  size_t printed = 0;
-
-  if (narrow_p)
-    {
-      scm_lfwrite (str, len, port);
-      return len;
-    }
-
-  while (printed < len)
-    {
-      char buf[256];
-      size_t i;
-
-      for (i = 0; i < sizeof(buf) && printed < len; i++, printed++)
-        {
-          scm_t_wchar c = STR_REF (str, printed);
-
-          if (c < 256)
-            buf[i] = c;
-          else
-            break;
-        }
-
-      scm_lfwrite (buf, i, port);
-
-      if (i < sizeof(buf) && printed < len)
-        {
-          if (strategy == SCM_FAILED_CONVERSION_ERROR)
-            break;
-          else if (strategy == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
-            write_character_escaped (STR_REF (str, printed), 1, port);
-          else
-            /* STRATEGY is `SCM_FAILED_CONVERSION_QUESTION_MARK'.  */
-            display_string ("?", 1, 1, port, strategy);
-          printed++;
-        }
-    }
-
-  return printed;
-}
-
-/* Convert STR through PORT's output conversion descriptor and write the
-   output to PORT.  Return the number of codepoints written.  */
-static size_t
-display_string_using_iconv (const void *str, int narrow_p, size_t len,
-                           SCM port,
-                           scm_t_string_failed_conversion_handler strategy)
+static void
+write_string (const void *str, int narrow_p, size_t len, SCM port)
 {
-  size_t printed;
-  iconv_t output_cd;
+  size_t i;
 
-  printed = 0;
+  scm_c_put_char (port, (scm_t_uint8) '"');
 
-  while (len > printed)
+  for (i = 0; i < len; ++i)
     {
-      size_t done, utf8_len, input_left, output_left, i;
-      size_t codepoints_read, output_len;
-      char *input, *output;
-      char utf8_buf[256], encoded_output[256];
-      size_t offsets[256];
-
-      /* Convert STR to UTF-8.  */
-      for (i = printed, utf8_len = 0, input = utf8_buf;
-          i < len && utf8_len + 4 < sizeof (utf8_buf);
-          i++)
-       {
-         offsets[utf8_len] = i;
-         utf8_len += codepoint_to_utf8 (STR_REF (str, i),
-                                        (scm_t_uint8 *) input);
-         input = utf8_buf + utf8_len;
-       }
-
-      input = utf8_buf;
-      input_left = utf8_len;
-
-      output = encoded_output;
-      output_left = sizeof (encoded_output);
-
-      scm_port_acquire_iconv_descriptors (port, NULL, &output_cd);
-      done = iconv (output_cd, &input, &input_left, &output, &output_left);
-      scm_port_release_iconv_descriptors (port);
-
-      output_len = sizeof (encoded_output) - output_left;
-
-      if (SCM_UNLIKELY (done == (size_t) -1))
-       {
-          int errno_save = errno;
-
-         /* Reset the `iconv' state.  */
-          scm_port_acquire_iconv_descriptors (port, NULL, &output_cd);
-         iconv (output_cd, NULL, NULL, NULL, NULL);
-          scm_port_release_iconv_descriptors (port);
-
-         /* Print the OUTPUT_LEN bytes successfully converted.  */
-         scm_lfwrite (encoded_output, output_len, port);
-
-         /* See how many input codepoints these OUTPUT_LEN bytes
-            corresponds to.  */
-         codepoints_read = offsets[input - utf8_buf] - printed;
-         printed += codepoints_read;
-
-         if (errno_save == EILSEQ &&
-             strategy != SCM_FAILED_CONVERSION_ERROR)
-           {
-             /* Conversion failed somewhere in INPUT and we want to
-                escape or substitute the offending input character.  */
-
-             if (strategy == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
-               {
-                 scm_t_wchar ch;
-
-                 /* Find CH, the offending codepoint, and escape it.  */
-                 ch = STR_REF (str, offsets[input - utf8_buf]);
-                 write_character_escaped (ch, 1, port);
-               }
-             else
-               /* STRATEGY is `SCM_FAILED_CONVERSION_QUESTION_MARK'.  */
-               display_string ("?", 1, 1, port, strategy);
-
-             printed++;
-           }
-         else
-           /* Something bad happened that we can't handle: bail out.  */
-           break;
-       }
+      scm_t_wchar ch;
+      if (narrow_p)
+        ch = (scm_t_wchar) ((unsigned char *) (str))[i];
       else
-       {
-         /* INPUT was successfully converted, entirely; print the
-            result.  */
-         scm_lfwrite (encoded_output, output_len, port);
-         codepoints_read = i - printed;
-         printed += codepoints_read;
-       }
-    }
-
-  return printed;
-}
-
-/* Display the LEN codepoints in STR to PORT according to STRATEGY;
-   return the number of codepoints successfully displayed.  If NARROW_P,
-   then STR is interpreted as a sequence of `char', denoting a Latin-1
-   string; otherwise it's interpreted as a sequence of
-   `scm_t_wchar'.  */
-static size_t
-display_string (const void *str, int narrow_p,
-               size_t len, SCM port,
-               scm_t_string_failed_conversion_handler strategy)
-{
-  scm_t_port *pt;
-
-  pt = SCM_PORT (port);
-
-  if (scm_is_eq (pt->encoding, sym_UTF_8))
-    return display_string_as_utf8 (str, narrow_p, len, port);
-  else if (scm_is_eq (pt->encoding, sym_ISO_8859_1))
-    return display_string_as_latin1 (str, narrow_p, len, port, strategy);
-  else
-    return display_string_using_iconv (str, narrow_p, len, port, strategy);
-}
-
-/* Attempt to display CH to PORT according to STRATEGY.  Return one if
-   CH was successfully displayed, zero otherwise (e.g., if it was not
-   representable in PORT's encoding.)  */
-static int
-display_character (scm_t_wchar ch, SCM port,
-                  scm_t_string_failed_conversion_handler strategy)
-{
-  return display_string (&ch, 0, 1, port, strategy) == 1;
-}
-
-/* Same as 'display_string', but using the 'write' syntax.  */
-static size_t
-write_string (const void *str, int narrow_p,
-             size_t len, SCM port,
-             scm_t_string_failed_conversion_handler strategy)
-{
-  size_t printed;
-
-  printed = display_character ('"', port, strategy);
-
-  if (printed > 0)
-    {
-      size_t i;
-
-      for (i = 0; i < len; ++i)
-       {
-         write_character (STR_REF (str, i), port, 1);
-         printed++;
-       }
-
-      printed += display_character ('"', port, strategy);
+        ch = ((scm_t_wchar *) (str))[i];
+
+      /* Write CH to PORT, escaping it if it's non-graphic or not
+         representable in PORT's encoding.  If CH needs to be escaped,
+         it is escaped using the in-string escape syntax.  */
+      if (ch == '"')
+        scm_c_put_latin1_chars (port, (const scm_t_uint8 *) "\\\"", 2);
+      else if (ch == '\\')
+        scm_c_put_latin1_chars (port, (const scm_t_uint8 *) "\\\\", 2);
+      else if (ch == '\n' && SCM_PRINT_ESCAPE_NEWLINES_P)
+        scm_c_put_latin1_chars (port, (const scm_t_uint8 *) "\\n", 2);
+      else if (ch == ' ' || ch == '\n'
+               || (uc_is_general_category_withtable (ch,
+                                                     UC_CATEGORY_MASK_L |
+                                                     UC_CATEGORY_MASK_M |
+                                                     UC_CATEGORY_MASK_N |
+                                                     UC_CATEGORY_MASK_P |
+                                                     UC_CATEGORY_MASK_S)
+                   && scm_c_can_put_char (port, ch)))
+        scm_c_put_char (port, ch);
+      else
+        scm_c_put_escaped_char (port, ch);
     }
 
-  return printed;
+  scm_c_put_char (port, (scm_t_uint8) '"');
 }
 
-#undef STR_REF
-
-/* 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)
-{
-  scm_t_wchar str[2];
-
-  str[0] = SCM_CODEPOINT_DOTTED_CIRCLE;
-  str[1] = ch;
-
-  return display_string (str, 0, 2, port, iconveh_error) == 2;
-}
-
-/* Write CH to PORT in its escaped form, using the string escape syntax
-   if STRING_ESCAPES_P is non-zero.  */
+/* Write CH to PORT, escaping it if it's non-graphic or not
+   representable in PORT's encoding.  The character escape syntax is
+   used.  */
 static void
-write_character_escaped (scm_t_wchar ch, int string_escapes_p, SCM port)
+write_character (scm_t_wchar ch, SCM port)
 {
-  if (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];
+  scm_puts ("#\\", port);
 
-      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)
-           {
-             buf[0] = '\\';
-             buf[1] = 'x';
-             buf[2] = hex[ch / 16];
-             buf[3] = hex[ch % 16];
-             scm_lfwrite (buf, 4, port);
-           }
-         else if (ch <= 0xFFFF)
-           {
-             buf[0] = '\\';
-             buf[1] = 'u';
-             buf[2] = hex[(ch & 0xF000) >> 12];
-             buf[3] = hex[(ch & 0xF00) >> 8];
-             buf[4] = hex[(ch & 0xF0) >> 4];
-             buf[5] = hex[(ch & 0xF)];
-             scm_lfwrite (buf, 6, port);
-           }
-         else if (ch > 0xFFFF)
-           {
-             buf[0] = '\\';
-             buf[1] = 'U';
-             buf[2] = hex[(ch & 0xF00000) >> 20];
-             buf[3] = hex[(ch & 0xF0000) >> 16];
-             buf[4] = hex[(ch & 0xF000) >> 12];
-             buf[5] = hex[(ch & 0xF00) >> 8];
-             buf[6] = hex[(ch & 0xF0) >> 4];
-             buf[7] = hex[(ch & 0xF)];
-             scm_lfwrite (buf, 8, port);
-           }
-       }
-      else
-       {
-         /* Print an R6RS variable-length hex escape: "\xNNNN;".  */
-         scm_t_wchar ch2 = ch;
-
-         int i = 8;
-         buf[i] = ';';
-         i --;
-         if (ch == 0)
-           buf[i--] = '0';
-         else
-           while (ch2 > 0)
-             {
-               buf[i] = hex[ch2 & 0xF];
-               ch2 >>= 4;
-               i --;
-             }
-         buf[i] = 'x';
-         i --;
-         buf[i] = '\\';
-         scm_lfwrite (buf + i, 9 - i, port);
-       }
+  /* Pretty-print a combining characters over dotted circles, if
+     possible, to make them more visible.  */
+  if (uc_combining_class (ch) != UC_CCC_NR
+      && scm_c_can_put_char (port, SCM_CODEPOINT_DOTTED_CIRCLE)
+      && scm_c_can_put_char (port, ch))
+    {
+      scm_c_put_char (port, SCM_CODEPOINT_DOTTED_CIRCLE);
+      scm_c_put_char (port, ch);
     }
+  else if (uc_is_general_category_withtable (ch,
+                                             UC_CATEGORY_MASK_L |
+                                             UC_CATEGORY_MASK_M |
+                                             UC_CATEGORY_MASK_N |
+                                             UC_CATEGORY_MASK_P |
+                                             UC_CATEGORY_MASK_S)
+           && scm_c_can_put_char (port, ch))
+    /* CH is graphic and encodeable; display it.  */
+    scm_c_put_char (port, ch);
   else
+    /* CH isn't graphic or cannot be represented in PORT's encoding.  */
     {
       /* Represent CH using the character escape syntax.  */
       const char *name;
 
       name = scm_i_charname (SCM_MAKE_CHAR (ch));
       if (name != NULL)
-       scm_puts (name, port);
+        scm_puts (name, port);
+      else if (!SCM_R6RS_ESCAPES_P)
+        scm_intprint (ch, 8, port);
       else
-       PRINT_CHAR_ESCAPE (ch, port);
-    }
-}
-
-/* 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;
-   otherwise the character escape syntax is used.  */
-static void
-write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
-{
-  int printed = 0;
-  scm_t_string_failed_conversion_handler strategy;
-
-  strategy = PORT_CONVERSION_HANDLER (port);
-
-  if (string_escapes_p)
-    {
-      /* Check if CH deserves special treatment.  */
-      if (ch == '"' || ch == '\\')
-       {
-         display_character ('\\', port, iconveh_question_mark);
-         display_character (ch, port, strategy);
-         printed = 1;
-       }
-      else if (ch == '\n' && SCM_PRINT_ESCAPE_NEWLINES_P)
         {
-         display_character ('\\', port, iconveh_question_mark);
-         display_character ('n', port, strategy);
-         printed = 1;
+          scm_puts ("x", port);
+          scm_intprint (ch, 16, port);
         }
-      else if (ch == ' ' || ch == '\n')
-       {
-         display_character (ch, port, strategy);
-         printed = 1;
-       }
     }
-  else
-    {
-      display_string ("#\\", 1, 2, port, iconveh_question_mark);
-
-      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,
-                                          UC_CATEGORY_MASK_L |
-                                          UC_CATEGORY_MASK_M |
-                                          UC_CATEGORY_MASK_N |
-                                          UC_CATEGORY_MASK_P |
-                                          UC_CATEGORY_MASK_S))
-    /* CH is graphic; attempt to display it.  */
-    printed = display_character (ch, port, iconveh_error);
-
-  if (!printed)
-    /* CH isn't graphic or cannot be represented in PORT's encoding.  */
-    write_character_escaped (ch, string_escapes_p, port);
-}
-
-/* Display STR to PORT from START inclusive to END exclusive.  */
-void
-scm_i_display_substring (SCM str, size_t start, size_t end, SCM port)
-{
-  int narrow_p;
-  const char *buf;
-  size_t len, printed;
-
-  buf = scm_i_string_data (str);
-  len = end - start;
-  narrow_p = scm_i_is_narrow_string (str);
-  buf += start * (narrow_p ? sizeof (char) : sizeof (scm_t_wchar));
-
-  printed = display_string (buf, narrow_p, end - start, port,
-                           PORT_CONVERSION_HANDLER (port));
-
-  if (SCM_UNLIKELY (printed < len))
-    scm_encoding_error (__func__, errno,
-                       "cannot convert to output locale",
-                       port, scm_c_string_ref (str, printed + start));
 }
 
 
@@ -1655,16 +1207,13 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
 {
   if (SCM_UNBNDP (port))
     port = scm_current_output_port ();
+  else
+    port = SCM_COERCE_OUTPORT (port);
 
   SCM_VALIDATE_CHAR (1, chr);
-  SCM_VALIDATE_OPORT_VALUE (2, port);
-
-  port = SCM_COERCE_OUTPORT (port);
-  if (!display_character (SCM_CHAR (chr), port,
-                         PORT_CONVERSION_HANDLER (port)))
-    scm_encoding_error (__func__, errno,
-                       "cannot convert to output locale",
-                       port, chr);
+  SCM_VALIDATE_OPOUTPORT (2, port);
+
+  scm_c_put_char (port, SCM_CHAR (chr));
 
   return SCM_UNSPECIFIED;
 }
diff --git a/libguile/print.h b/libguile/print.h
index 80a9922..14318c0 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -79,8 +79,6 @@ SCM_API SCM scm_print_options (SCM setting);
 SCM_API SCM scm_make_print_state (void);
 SCM_API void scm_free_print_state (SCM print_state);
 SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state);
-SCM_INTERNAL void scm_i_display_substring (SCM str, size_t start, size_t end,
-                                          SCM port);
 SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port);
 SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port);
 SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);



reply via email to

[Prev in Thread] Current Thread [Next in Thread]