Merge remote-tracking branch 'origin/stable-2.0'
[bpt/guile.git] / libguile / read.c
index d977cff..c8db812 100644 (file)
 #endif
 
 #include <stdio.h>
-#include <ctype.h>
 #include <string.h>
 #include <unistd.h>
 #include <unicase.h>
 #include <unictype.h>
+#include <c-strcase.h>
 
 #include "libguile/_scm.h"
 #include "libguile/bytevectors.h"
@@ -43,6 +43,7 @@
 #include "libguile/hashtab.h"
 #include "libguile/hash.h"
 #include "libguile/ports.h"
+#include "libguile/ports-internal.h"
 #include "libguile/fports.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
@@ -704,7 +705,6 @@ scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   SCM result, str = SCM_EOL;
   char local_buffer[READER_BUFFER_SIZE], *buffer;
   size_t bytes_read;
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
   /* Need to capture line and column numbers here. */
   long line = SCM_LINUM (port);
@@ -714,7 +714,7 @@ scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
                                &bytes_read);
 
-  str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
+  str = scm_from_port_stringn (buffer, bytes_read, port);
 
   result = scm_string_to_number (str, SCM_UNDEFINED);
   if (scm_is_false (result))
@@ -739,7 +739,6 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   size_t bytes_read;
   int postfix = (opts->keyword_style == KEYWORD_STYLE_POSTFIX);
   char local_buffer[READER_BUFFER_SIZE], *buffer;
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
   SCM str;
 
   scm_ungetc_unlocked (chr, port);
@@ -750,8 +749,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 
   if (postfix && ends_with_colon && (bytes_read > 1))
     {
-      str = scm_from_stringn (buffer, bytes_read - 1,
-                             pt->encoding, pt->ilseq_handler);
+      str = scm_from_port_stringn (buffer, bytes_read - 1, port);
 
       if (opts->case_insensitive_p)
         str = scm_string_downcase_x (str);
@@ -759,8 +757,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
     }
   else
     {
-      str = scm_from_stringn (buffer, bytes_read,
-                             pt->encoding, pt->ilseq_handler);
+      str = scm_from_port_stringn (buffer, bytes_read, port);
 
       if (opts->case_insensitive_p)
         str = scm_string_downcase_x (str);
@@ -780,7 +777,6 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   char local_buffer[READER_BUFFER_SIZE], *buffer;
   unsigned int radix;
   SCM str;
-  scm_t_port *pt;
 
   switch (chr)
     {
@@ -813,8 +809,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
                                &read);
 
-  pt = SCM_PTAB_ENTRY (port);
-  str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
+  str = scm_from_port_stringn (buffer, read, port);
 
   result = scm_string_to_number (str, scm_from_uint (radix));
 
@@ -975,7 +970,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   size_t charname_len, bytes_read;
   scm_t_wchar cp;
   int overflow;
-  scm_t_port *pt;
+  scm_t_port_internal *pti;
 
   overflow = read_token (port, opts, buffer, READER_CHAR_NAME_MAX_SIZE,
                          &bytes_read);
@@ -993,12 +988,14 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
       return (SCM_MAKE_CHAR (chr));
     }
 
-  pt = SCM_PTAB_ENTRY (port);
+  pti = SCM_PORT_GET_INTERNAL (port);
 
   /* Simple ASCII characters can be processed immediately.  Also, simple
      ISO-8859-1 characters can be processed immediately if the encoding for this
      port is ISO-8859-1.  */
-  if (bytes_read == 1 && ((unsigned char) buffer[0] <= 127 || pt->encoding == NULL))
+  if (bytes_read == 1 &&
+      ((unsigned char) buffer[0] <= 127
+       || pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1))
     {
       SCM_COL (port) += 1;
       return SCM_MAKE_CHAR (buffer[0]);
@@ -1006,8 +1003,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 
   /* Otherwise, convert the buffer into a proper scheme string for
      processing.  */
-  charname = scm_from_stringn (buffer, bytes_read, pt->encoding,
-                              pt->ilseq_handler);
+  charname = scm_from_port_stringn (buffer, bytes_read, port);
   charname_len = scm_i_string_length (charname);
   SCM_COL (port) += charname_len;
   cp = scm_i_string_ref (charname, 0);
@@ -1956,6 +1952,15 @@ scm_get_hash_procedure (int c)
 
 #define SCM_ENCODING_SEARCH_SIZE (500)
 
+static int
+is_encoding_char (char c)
+{
+  if (c >= 'a' && c <= 'z') return 1;
+  if (c >= 'A' && c <= 'Z') return 1;
+  if (c >= '0' && c <= '9') return 1;
+  return strchr ("_-.:/,+=()", c) != NULL;
+}
+
 /* Search the first few hundred characters of a file for an Emacs-like coding
    declaration.  Returns either NULL or a string whose storage has been
    allocated with `scm_gc_malloc ()'.  */
@@ -1966,7 +1971,6 @@ scm_i_scan_for_encoding (SCM port)
   char header[SCM_ENCODING_SEARCH_SIZE+1];
   size_t bytes_read, encoding_length, i;
   char *encoding = NULL;
-  int utf8_bom = 0;
   char *pos, *encoding_start;
   int in_comment;
 
@@ -2011,10 +2015,6 @@ scm_i_scan_for_encoding (SCM port)
       scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
     }
 
-  if (bytes_read > 3 
-      && header[0] == '\xef' && header[1] == '\xbb' && header[2] == '\xbf')
-    utf8_bom = 1;
-
   /* search past "coding[:=]" */
   pos = header;
   while (1)
@@ -2041,8 +2041,7 @@ scm_i_scan_for_encoding (SCM port)
   i = 0;
   while (encoding_start + i - header <= SCM_ENCODING_SEARCH_SIZE
          && encoding_start + i - header < bytes_read
-        && (isalnum ((int) encoding_start[i])
-            || strchr ("_-.:/,+=()", encoding_start[i]) != NULL))
+        && is_encoding_char (encoding_start[i]))
     i++;
 
   encoding_length = i;
@@ -2050,8 +2049,6 @@ scm_i_scan_for_encoding (SCM port)
     return NULL;
 
   encoding = scm_gc_strndup (encoding_start, encoding_length, "encoding");
-  for (i = 0; i < encoding_length; i++)
-    encoding[i] = toupper ((int) encoding[i]);
 
   /* push backwards to make sure we were in a comment */
   in_comment = 0;
@@ -2083,11 +2080,6 @@ scm_i_scan_for_encoding (SCM port)
     /* This wasn't in a comment */
     return NULL;
 
-  if (utf8_bom && strcmp(encoding, "UTF-8"))
-    scm_misc_error (NULL,
-                   "the port input declares the encoding ~s but is encoded as UTF-8",
-                   scm_list_1 (scm_from_locale_string (encoding)));
-
   return encoding;
 }
 
@@ -2112,7 +2104,7 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
     return SCM_BOOL_F;
   else
     {
-      s_enc = scm_from_locale_string (enc);
+      s_enc = scm_string_upcase (scm_from_locale_string (enc));
       return s_enc;
     }
 
@@ -2124,8 +2116,9 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
 /* Per-port read options.
 
    We store per-port read options in the 'port-read-options' key of the
-   port's alist.  The value stored in the alist is a single integer that
-   contains a two-bit field for each read option.
+   port's alist, which is stored in the internal port structure.  The
+   value stored in the alist is a single integer that contains a two-bit
+   field for each read option.
 
    If a bit field contains READ_OPTION_INHERIT (3), that indicates that
    the applicable value should be inherited from the corresponding
@@ -2160,12 +2153,12 @@ SCM_SYMBOL (sym_port_read_options, "port-read-options");
 static void
 set_port_read_option (SCM port, int option, int new_value)
 {
-  SCM scm_read_options;
+  SCM alist, scm_read_options;
   unsigned int read_options;
 
   new_value &= READ_OPTION_MASK;
-  scm_read_options = scm_assq_ref (SCM_PTAB_ENTRY(port)->alist,
-                                   sym_port_read_options);
+  alist = scm_i_port_alist (port);
+  scm_read_options = scm_assq_ref (alist, sym_port_read_options);
   if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
     read_options = scm_to_uint (scm_read_options);
   else
@@ -2173,9 +2166,8 @@ set_port_read_option (SCM port, int option, int new_value)
   read_options &= ~(READ_OPTION_MASK << option);
   read_options |= new_value << option;
   scm_read_options = scm_from_uint (read_options);
-  SCM_PTAB_ENTRY(port)->alist = scm_assq_set_x (SCM_PTAB_ENTRY(port)->alist,
-                                                sym_port_read_options,
-                                                scm_read_options);
+  alist = scm_assq_set_x (alist, sym_port_read_options, scm_read_options);
+  scm_i_set_port_alist_x (port, alist);
 }
 
 /* Set OPTS and PORT's case-insensitivity according to VALUE. */
@@ -2210,11 +2202,11 @@ set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value)
 static void
 init_read_options (SCM port, scm_t_read_opts *opts)
 {
-  SCM val, scm_read_options;
+  SCM alist, val, scm_read_options;
   unsigned int read_options, x;
 
-  scm_read_options = scm_assq_ref (SCM_PTAB_ENTRY(port)->alist,
-                                   sym_port_read_options);
+  alist = scm_i_port_alist (port);
+  scm_read_options = scm_assq_ref (alist, sym_port_read_options);
 
   if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
     read_options = scm_to_uint (scm_read_options);