Block system asyncs while 'overrides_lock' is held.
[bpt/guile.git] / libguile / print.c
index 4afd12c..4e68fd6 100644 (file)
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995-1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008,
- *   2009, 2010, 2011 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013 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
@@ -30,6 +30,7 @@
 
 #include <uniconv.h>
 #include <unictype.h>
+#include <c-strcase.h>
 
 #include "libguile/_scm.h"
 #include "libguile/chars.h"
@@ -45,6 +46,7 @@
 #include "libguile/alist.h"
 #include "libguile/struct.h"
 #include "libguile/ports.h"
+#include "libguile/ports-internal.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
 #include "libguile/strports.h"
@@ -61,6 +63,9 @@
 
 /* Character printers.  */
 
+#define PORT_CONVERSION_HANDLER(port)          \
+  SCM_PTAB_ENTRY (port)->ilseq_handler
+
 static size_t display_string (const void *, int, size_t, SCM,
                              scm_t_string_failed_conversion_handler);
 
@@ -107,8 +112,9 @@ scm_t_option scm_print_opts[] = {
   { SCM_OPTION_SCM, "quote-keywordish-symbols", (scm_t_bits)SCM_BOOL_F_BITS,
     "How to print symbols that have a colon as their first or last character. "
     "The value '#f' does not quote the colons; '#t' quotes them; "
-    "'reader' quotes them when the reader option 'keywords' is not '#f'." 
-  },
+    "'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'." },
   { 0 },
 };
 
@@ -392,7 +398,7 @@ print_extended_symbol (SCM sym, SCM port)
   scm_t_string_failed_conversion_handler strategy;
 
   len = scm_i_symbol_length (sym);
-  strategy = scm_i_get_conversion_strategy (port);
+  strategy = PORT_CONVERSION_HANDLER (port);
 
   scm_lfwrite ("#{", 2, port);
 
@@ -404,7 +410,8 @@ print_extended_symbol (SCM sym, SCM port)
                                             SUBSEQUENT_IDENTIFIER_MASK
                                             | UC_CATEGORY_MASK_Zs))
         {
-          if (!display_character (c, port, strategy))
+          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));
@@ -499,7 +506,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
          else
            {
              if (!display_character (SCM_CHAR (exp), port,
-                                     scm_i_get_conversion_strategy (port)))
+                                     PORT_CONVERSION_HANDLER (port)))
                scm_encoding_error (__func__, errno,
                                    "cannot convert to output locale",
                                    port, exp);
@@ -585,7 +592,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
              printed = display_string (scm_i_string_data (exp),
                                        scm_i_is_narrow_string (exp),
                                        len, port,
-                                       scm_i_get_conversion_strategy (port));
+                                       PORT_CONVERSION_HANDLER (port));
              if (SCM_UNLIKELY (printed < len))
                scm_encoding_error (__func__, errno,
                                    "cannot convert to output locale",
@@ -645,6 +652,17 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
        case scm_tc7_with_fluids:
          scm_i_with_fluids_print (exp, port, pstate);
          break;
+       case scm_tc7_array:
+         ENTER_NESTED_DATA (pstate, exp, circref);
+          scm_i_print_array (exp, port, pstate);
+          EXIT_NESTED_DATA (pstate);
+          break;
+       case scm_tc7_bytevector:
+         scm_i_print_bytevector (exp, port, pstate);
+         break;
+       case scm_tc7_bitvector:
+         scm_i_print_bitvector (exp, port, pstate);
+         break;
        case scm_tc7_wvect:
          ENTER_NESTED_DATA (pstate, exp, circref);
          if (SCM_IS_WHVEC (exp))
@@ -652,10 +670,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
          else
            scm_puts ("#w(", port);
          goto common_vector_printer;
-
-       case scm_tc7_bytevector:
-         scm_i_print_bytevector (exp, port, pstate);
-         break;
        case scm_tc7_vector:
          ENTER_NESTED_DATA (pstate, exp, circref);
          scm_puts ("#(", port);
@@ -868,9 +882,25 @@ display_string_using_iconv (const void *str, int narrow_p, size_t len,
                            scm_t_string_failed_conversion_handler strategy)
 {
   size_t printed;
-  scm_t_port *pt;
+  scm_t_iconv_descriptors *id;
+  scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port);
+
+  id = scm_i_port_iconv_descriptors (port, SCM_PORT_WRITE);
+
+  if (SCM_UNLIKELY (pti->at_stream_start_for_bom_write && len > 0))
+    {
+      scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
-  pt = SCM_PTAB_ENTRY (port);
+      /* Record that we're no longer at stream start.  */
+      pti->at_stream_start_for_bom_write = 0;
+      if (pt->rw_random)
+        pti->at_stream_start_for_bom_read = 0;
+
+      /* Write a BOM if appropriate.  */
+      if (SCM_UNLIKELY (c_strcasecmp(pt->encoding, "UTF-16") == 0
+                        || c_strcasecmp(pt->encoding, "UTF-32") == 0))
+        display_character (SCM_UNICODE_BOM, port, iconveh_error);
+    }
 
   printed = 0;
 
@@ -899,7 +929,7 @@ display_string_using_iconv (const void *str, int narrow_p, size_t len,
       output = encoded_output;
       output_left = sizeof (encoded_output);
 
-      done = iconv (pt->output_cd, &input, &input_left,
+      done = iconv (id->output_cd, &input, &input_left,
                    &output, &output_left);
 
       output_len = sizeof (encoded_output) - output_left;
@@ -909,7 +939,7 @@ display_string_using_iconv (const void *str, int narrow_p, size_t len,
           int errno_save = errno;
 
          /* Reset the `iconv' state.  */
-         iconv (pt->output_cd, NULL, NULL, NULL, NULL);
+         iconv (id->output_cd, NULL, NULL, NULL, NULL);
 
          /* Print the OUTPUT_LEN bytes successfully converted.  */
          scm_lfwrite (encoded_output, output_len, port);
@@ -969,16 +999,11 @@ display_string (const void *str, int narrow_p,
                scm_t_string_failed_conversion_handler strategy)
 
 {
-  scm_t_port *pt;
+  scm_t_port_internal *pti;
 
-  pt = SCM_PTAB_ENTRY (port);
+  pti = SCM_PORT_GET_INTERNAL (port);
 
-  if (pt->output_cd == (iconv_t) -1)
-    /* Initialize the conversion descriptors, if needed.  */
-    scm_i_set_port_encoding_x (port, pt->encoding);
-
-  /* FIXME: In 2.1, add a flag to determine whether a port is UTF-8.  */
-  if (pt->output_cd == (iconv_t) -1)
+  if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8)
     return display_string_as_utf8 (str, narrow_p, len, port);
   else
     return display_string_using_iconv (str, narrow_p, len,
@@ -1108,7 +1133,7 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
   int printed = 0;
   scm_t_string_failed_conversion_handler strategy;
 
-  strategy = scm_i_get_conversion_strategy (port);
+  strategy = PORT_CONVERSION_HANDLER (port);
 
   if (string_escapes_p)
     {
@@ -1119,6 +1144,12 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
          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;
+        }
       else if (ch == ' ' || ch == '\n')
        {
          display_character (ch, port, strategy);
@@ -1150,6 +1181,29 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
     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));
+}
+
+\f
 /* Print an integer.
  */
 
@@ -1336,7 +1390,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
            "@var{message} can contain @code{~A} (was @code{%s}) and\n"
            "@code{~S} (was @code{%S}) escapes.  When printed,\n"
            "the escapes are replaced with corresponding members of\n"
-           "@var{ARGS}:\n"
+           "@var{args}:\n"
            "@code{~A} formats using @code{display} and @code{~S} formats\n"
            "using @code{write}.\n"
            "If @var{destination} is @code{#t}, then use the current output\n"
@@ -1455,7 +1509,7 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
 
   port = SCM_COERCE_OUTPORT (port);
   if (!display_character (SCM_CHAR (chr), port,
-                         scm_i_get_conversion_strategy (port)))
+                         PORT_CONVERSION_HANDLER (port)))
     scm_encoding_error (__func__, errno,
                        "cannot convert to output locale",
                        port, chr);
@@ -1527,21 +1581,12 @@ SCM_DEFINE (scm_get_print_state, "get-print-state", 1, 0, 0,
 void
 scm_init_print ()
 {
-  SCM vtable, layout, type;
-
-  scm_init_opts (scm_print_options, scm_print_opts);
-
-  scm_print_options (scm_list_4 (scm_from_latin1_symbol ("highlight-prefix"),
-                                scm_from_locale_string ("{"),
-                                scm_from_latin1_symbol ("highlight-suffix"),
-                                scm_from_locale_string ("}")));
+  SCM type;
 
   scm_gc_register_root (&print_state_pool);
   scm_gc_register_root (&scm_print_state_vtable);
-  vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
-  layout =
-    scm_make_struct_layout (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT));
-  type = scm_make_struct (vtable, SCM_INUM0, scm_list_1 (layout));
+  type = scm_make_vtable (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT),
+                          SCM_BOOL_F);
   scm_set_struct_vtable_name_x (type, scm_from_latin1_symbol ("print-state"));
   scm_print_state_vtable = type;
 
@@ -1551,6 +1596,11 @@ scm_init_print ()
 
 #include "libguile/print.x"
 
+  scm_init_opts (scm_print_options, scm_print_opts);
+  scm_print_opts[SCM_PRINT_HIGHLIGHT_PREFIX_I].val =
+    SCM_UNPACK (scm_from_locale_string ("{"));
+  scm_print_opts[SCM_PRINT_HIGHLIGHT_SUFFIX_I].val =
+    SCM_UNPACK (scm_from_locale_string ("}"));
   scm_print_opts[SCM_PRINT_KEYWORD_STYLE_I].val = SCM_UNPACK (sym_reader);
 }