--- a/src/mule-coding.c	Sat Sep 19 17:56:23 2009 +0200
+++ b/src/mule-coding.c	Sat Sep 19 22:53:13 2009 +0100
@@ -36,6 +36,10 @@
 #include "charset.h"
 #include "mule-ccl.h"
 #include "file-coding.h"
+#include "elhash.h"
+#include "rangetab.h"
+#include "buffer.h"
+#include "extents.h"
 
 Lisp_Object Qshift_jis, Qiso2022, Qbig5, Qccl;
 
@@ -48,6 +52,9 @@
 
 Lisp_Object Qiso_7, Qiso_8_designate, Qiso_8_1, Qiso_8_2, Qiso_lock_shift;
 
+Lisp_Object Qfrom_unicode, Qquery_skip_chars, Qinvalid_sequences_skip_chars;
+Lisp_Object Qfixed_width;
+
 
 /************************************************************************/
 /*                          Shift-JIS methods                           */
@@ -3388,6 +3395,503 @@
   else
     return Qunbound;
 }
+
+/************************************************************************/
+/*                   FIXED_WIDTH methods                            */
+/************************************************************************/
+
+struct fixed_width_coding_system
+{
+  /* For a fixed_width coding system, these specify the CCL programs
+     used for decoding (input) and encoding (output). */
+  Lisp_Object decode;
+  Lisp_Object encode;
+  Lisp_Object from_unicode;
+  Lisp_Object invalid_sequences_skip_chars;
+  Lisp_Object query_skip_chars;
+
+  /* This is not directly accessible from Lisp; it is a concatenation of the
+     previous two strings, used for simplicity of implementation. */
+  Lisp_Object invalid_and_query_skip_chars;
+};
+
+#define CODING_SYSTEM_FIXED_WIDTH_DECODE(codesys) \
+  (CODING_SYSTEM_TYPE_DATA (codesys, fixed_width)->decode)
+#define CODING_SYSTEM_FIXED_WIDTH_ENCODE(codesys) \
+  (CODING_SYSTEM_TYPE_DATA (codesys, fixed_width)->encode)
+#define CODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE(codesys) \
+  (CODING_SYSTEM_TYPE_DATA (codesys, fixed_width)->from_unicode)
+#define CODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS(codesys) \
+  (CODING_SYSTEM_TYPE_DATA (codesys, \
+                            fixed_width)->invalid_sequences_skip_chars)
+#define CODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS(codesys) \
+  (CODING_SYSTEM_TYPE_DATA (codesys, fixed_width)->query_skip_chars)
+#define CODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS(codesys) \
+  (CODING_SYSTEM_TYPE_DATA (codesys, \
+                            fixed_width)->invalid_and_query_skip_chars)
+
+#define XCODING_SYSTEM_FIXED_WIDTH_DECODE(codesys) \
+  CODING_SYSTEM_FIXED_WIDTH_DECODE (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_FIXED_WIDTH_ENCODE(codesys) \
+  CODING_SYSTEM_FIXED_WIDTH_ENCODE (XCODING_SYSTEM (codesys))
+#define XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE(codesys) \
+  (CODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (XCODING_SYSTEM (codesys)))
+#define XCODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS(codesys) \
+  (CODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS \
+   (XCODING_SYSTEM (codesys)))
+#define XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS(codesys) \
+  (CODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS (XCODING_SYSTEM (codesys)))
+#define XCODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS(codesys) \
+  (CODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS \
+   (XCODING_SYSTEM(codesys)))
+
+struct fixed_width_coding_stream
+{
+  /* state of the running CCL program */
+  struct ccl_program ccl;
+};
+
+static const struct memory_description
+fixed_width_coding_system_description[] = {
+  { XD_LISP_OBJECT, offsetof (struct fixed_width_coding_system, decode) },
+  { XD_LISP_OBJECT, offsetof (struct fixed_width_coding_system, encode) },
+  { XD_LISP_OBJECT, offsetof (struct fixed_width_coding_system,
+                              from_unicode) },
+  { XD_LISP_OBJECT, offsetof (struct fixed_width_coding_system,
+                              invalid_sequences_skip_chars) },
+  { XD_LISP_OBJECT, offsetof (struct fixed_width_coding_system,
+                              query_skip_chars) },
+  { XD_LISP_OBJECT, offsetof (struct fixed_width_coding_system,
+                              invalid_and_query_skip_chars) },
+  { XD_END }
+};
+
+DEFINE_CODING_SYSTEM_TYPE_WITH_DATA (fixed_width);
+
+static void
+fixed_width_mark (Lisp_Object codesys)
+{
+  mark_object (XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys));
+  mark_object (XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys));
+  mark_object (XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (codesys));
+  mark_object
+    (XCODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS (codesys));
+  mark_object (XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS (codesys) );
+  mark_object
+    (XCODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS(codesys));
+}
+
+static Bytecount
+fixed_width_convert (struct coding_stream *str, const UExtbyte *src,
+                     unsigned_char_dynarr *dst, Bytecount n)
+{
+  struct fixed_width_coding_stream *data =
+    CODING_STREAM_TYPE_DATA (str, fixed_width);
+  Bytecount orign = n;
+
+  data->ccl.last_block = str->eof;
+  /* When applying a CCL program to a stream, SRC must not be NULL -- this
+     is a special signal to the driver that read and write operations are
+     not allowed.  The code does not actually look at what SRC points to if
+     N == 0. */
+  ccl_driver (&data->ccl, src ? src : (const unsigned char *) "",
+	      dst, n, 0,
+	      str->direction == CODING_DECODE ? CCL_MODE_DECODING :
+	      CCL_MODE_ENCODING);
+  return orign;
+}
+
+static void
+fixed_width_init_coding_stream (struct coding_stream *str)
+{
+  struct fixed_width_coding_stream *data =
+    CODING_STREAM_TYPE_DATA (str, fixed_width);
+
+  setup_ccl_program (&data->ccl,
+		     str->direction == CODING_DECODE ?
+		     XCODING_SYSTEM_FIXED_WIDTH_DECODE (str->codesys) :
+		     XCODING_SYSTEM_FIXED_WIDTH_ENCODE (str->codesys));
+}
+
+static void
+fixed_width_rewind_coding_stream (struct coding_stream *str)
+{
+  fixed_width_init_coding_stream (str);
+}
+
+static void
+fixed_width_init (Lisp_Object codesys)
+{
+  XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys) = Qnil;
+  XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys) = Qnil;
+  XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (codesys) = Qnil;
+  XCODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS (codesys) = Qnil;
+  XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS (codesys)  = Qnil;
+  XCODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS(codesys) = Qnil;
+}
+
+static int
+fixed_width_putprop (Lisp_Object codesys, Lisp_Object key,
+                     Lisp_Object value)
+{
+  struct ccl_program test_ccl;
+
+  if (EQ (key, Qdecode) || EQ (key, Qencode))
+    {
+      /* Check if the CCL infrastructure thinks this is a sane CCL
+         program: */
+      if (setup_ccl_program (&test_ccl, value) < 0)
+        {
+          invalid_argument ("Invalid CCL program", value);
+        }
+
+      if (EQ (key, Qdecode))
+        {
+          XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys) = value;
+        }
+      else 
+        {
+          XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys) = value;
+        }
+    }
+  else if (EQ (key, Qfrom_unicode))
+    {
+      CHECK_HASH_TABLE (value);
+      XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (codesys) = value; 
+    }
+  else if (EQ (key, Qinvalid_sequences_skip_chars))
+    {
+      CHECK_STRING (value);
+
+      /* Make sure Lisp can't make our data inconsistent: */
+      value = Fcopy_sequence (value);
+
+      XCODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS (codesys)
+        = value;
+
+      XCODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS (codesys)
+        = concat2 (value,
+                   XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS (codesys));
+    }
+  else if (EQ (key, Qquery_skip_chars))
+    {
+      CHECK_STRING (value);
+
+      /* Make sure Lisp can't make our data inconsistent: */
+      value = Fcopy_sequence (value);
+
+      XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS (codesys) = value; 
+
+      XCODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS (codesys)
+        = concat2 (value,
+                   XCODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS
+                   (codesys));
+    }
+  else
+    {
+      return 0;
+    }
+
+  return 1;
+}
+
+static Lisp_Object
+fixed_width_getprop (Lisp_Object codesys, Lisp_Object prop)
+{
+  if (EQ (prop, Qdecode))
+    {
+      return XCODING_SYSTEM_FIXED_WIDTH_DECODE (codesys);
+    }
+  else if (EQ (prop, Qencode))
+    {
+      return XCODING_SYSTEM_FIXED_WIDTH_ENCODE (codesys);
+    }
+  else if (EQ (prop, Qfrom_unicode))
+    {
+      return XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (codesys); 
+    }
+  else if (EQ (prop, Qinvalid_sequences_skip_chars))
+    {
+      /* Make sure Lisp can't make our data inconsistent: */
+      return
+        Fcopy_sequence
+          (XCODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS (codesys));
+    }
+  else if (EQ (prop, Qquery_skip_chars))
+    {
+      return
+        Fcopy_sequence (XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS (codesys)); 
+    }
+
+  return Qunbound;
+}
+
+static Lisp_Object Vfixed_width_query_ranges_cache;
+
+static Lisp_Object
+fixed_width_skip_chars_data_given_strings (Lisp_Object string,
+                                           Lisp_Object query_skip_chars,
+                                           Lisp_Object
+                                           invalid_sequences_skip_chars,
+                                           Binbyte *fastmap,
+                                           int fastmap_len)
+{
+  Lisp_Object result = Fgethash (string,
+                                 Vfixed_width_query_ranges_cache, 
+                                 Qnil);
+  REGISTER Ibyte *p, *pend;
+  REGISTER Ichar c;
+
+  memset (fastmap, query_coding_unencodable, fastmap_len);
+
+  if (!NILP (result))
+    {
+      int i; 
+      Lisp_Object ranged;
+      assert (RANGE_TABLEP (result));
+      for (i = 0; i < fastmap_len; ++i)
+        {
+          ranged = Fget_range_table (make_int (i), result, Qnil);
+
+          if (EQ (ranged, Qsucceeded))
+            {
+              fastmap [i] = query_coding_succeeded;
+            }
+          else if (EQ (ranged, Qinvalid_sequence))
+            {
+              fastmap [i] = query_coding_invalid_sequence;
+            }
+        }
+      return result; 
+    }
+
+  result = Fmake_range_table (Qstart_closed_end_closed);
+
+  p = XSTRING_DATA (query_skip_chars);
+  pend = p + XSTRING_LENGTH (query_skip_chars);
+
+  while (p != pend)
+    {
+      c = itext_ichar (p);
+
+      INC_IBYTEPTR (p);
+
+      if (c == '\\')
+        {
+          if (p == pend) break;
+          c = itext_ichar (p);
+          INC_IBYTEPTR (p);
+        }
+
+      if (p != pend && *p == '-')
+        {
+          Ichar cend;
+
+          /* Skip over the dash.  */
+          p++;
+          if (p == pend) break;
+          cend = itext_ichar (p);
+
+          Fput_range_table (make_int (c), make_int (cend), Qsucceeded,
+                            result);
+
+          while (c <= cend && c < fastmap_len)
+            {
+              fastmap[c] = query_coding_succeeded;
+              c++;
+            }
+
+          INC_IBYTEPTR (p);
+        }
+      else
+        {
+          if (c < fastmap_len)
+            fastmap[c] = query_coding_succeeded;
+
+          Fput_range_table (make_int (c), make_int (c), Qsucceeded, result);
+        }
+    }
+
+
+  p = XSTRING_DATA (invalid_sequences_skip_chars);
+  pend = p + XSTRING_LENGTH (invalid_sequences_skip_chars);
+
+  while (p != pend)
+    {
+      c = itext_ichar (p);
+
+      INC_IBYTEPTR (p);
+
+      if (c == '\\')
+        {
+          if (p == pend) break;
+          c = itext_ichar (p);
+          INC_IBYTEPTR (p);
+        }
+
+      if (p != pend && *p == '-')
+        {
+          Ichar cend;
+
+          /* Skip over the dash.  */
+          p++;
+          if (p == pend) break;
+          cend = itext_ichar (p);
+
+          Fput_range_table (make_int (c), make_int (cend), Qinvalid_sequence,
+                            result);
+
+          while (c <= cend && c < fastmap_len)
+            {
+              fastmap[c] = query_coding_invalid_sequence;
+              c++;
+            }
+
+          INC_IBYTEPTR (p);
+        }
+      else
+        {
+          if (c < fastmap_len)
+            fastmap[c] = query_coding_invalid_sequence;
+
+          Fput_range_table (make_int (c), make_int (c), Qinvalid_sequence,
+                            result);
+        }
+    }
+
+  Fputhash (string, result, Vfixed_width_query_ranges_cache);
+
+  return result;
+}
+
+static  Lisp_Object
+fixed_width_query (Lisp_Object codesys, struct buffer *buf, 
+                   Charbpos end, int flags)
+{
+  Charbpos pos = BUF_PT (buf), fail_range_start, fail_range_end;
+  Charbpos pos_byte = BYTE_BUF_PT (buf);
+  Lisp_Object skip_chars_range_table, from_unicode, checked_unicode,
+    result = Qnil;
+  enum query_coding_failure_reasons failed_reason,
+    previous_failed_reason = query_coding_succeeded;
+  Binbyte fastmap[0xff];
+
+  from_unicode = XCODING_SYSTEM_FIXED_WIDTH_FROM_UNICODE (codesys);
+
+  skip_chars_range_table =
+    fixed_width_skip_chars_data_given_strings
+        ((flags & QUERY_METHOD_IGNORE_INVALID_SEQUENCES ?
+          XCODING_SYSTEM_FIXED_WIDTH_INVALID_AND_QUERY_SKIP_CHARS
+          (codesys) : 
+          XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS(codesys)), 
+         XCODING_SYSTEM_FIXED_WIDTH_QUERY_SKIP_CHARS(codesys), 
+         (flags & QUERY_METHOD_IGNORE_INVALID_SEQUENCES ?
+          build_string("") :
+          XCODING_SYSTEM_FIXED_WIDTH_INVALID_SEQUENCES_SKIP_CHARS (codesys)),
+         fastmap, (int)(sizeof (fastmap)));
+
+  if (flags & QUERY_METHOD_HIGHLIGHT && 
+      /* If we're being called really early, live without highlights getting
+         cleared properly: */
+      !(UNBOUNDP (XSYMBOL (Qquery_coding_clear_highlights)->function)))
+    {
+      /* It's okay to call Lisp here, the only non-stack object we may have
+         allocated up to this point is skip_chars_range_table, and that's
+         reachable from its entry in Vfixed_width_query_ranges_cache. */
+      call3 (Qquery_coding_clear_highlights, make_int (pos), make_int (end),
+             wrap_buffer (buf));
+    }
+
+  while (pos < end)
+    {
+      Ichar ch = BYTE_BUF_FETCH_CHAR (buf, pos_byte);
+      if ((ch < (int) (sizeof(fastmap))) ?
+          (fastmap[ch] == query_coding_succeeded) :
+          (EQ (Qsucceeded, Fget_range_table (make_int (ch),
+                                             skip_chars_range_table, Qnil))))
+        {
+          pos++;
+          INC_BYTEBPOS (buf, pos_byte);
+        }
+      else
+        {
+          fail_range_start = pos;
+          while ((pos < end) &&  
+                 ((!(flags & QUERY_METHOD_IGNORE_INVALID_SEQUENCES) &&
+                   EQ (Qinvalid_sequence, Fget_range_table
+                       (make_int (ch), skip_chars_range_table, Qnil))
+                   && (failed_reason = query_coding_invalid_sequence))
+                  || ((NILP ((checked_unicode = 
+                              Fgethash (Fchar_to_unicode (make_char (ch)),
+                                        from_unicode, Qnil))))
+                      && (failed_reason = query_coding_unencodable)))
+                 && (previous_failed_reason == query_coding_succeeded
+                     || previous_failed_reason == failed_reason))
+            {
+              pos++;
+              INC_BYTEBPOS (buf, pos_byte);
+              ch = BYTE_BUF_FETCH_CHAR (buf, pos_byte);
+              previous_failed_reason = failed_reason;
+            }
+
+          if (fail_range_start == pos)
+            {
+              /* The character can actually be encoded; move on. */
+              pos++;
+              INC_BYTEBPOS (buf, pos_byte);
+            }
+          else
+            {
+              assert (previous_failed_reason == query_coding_invalid_sequence
+                      || previous_failed_reason == query_coding_unencodable);
+
+              if (flags & QUERY_METHOD_ERRORP)
+                {
+                  DECLARE_EISTRING (error_details);
+
+                  eicpy_ascii (error_details, "Cannot encode ");
+                  eicat_lstr (error_details,
+                              make_string_from_buffer (buf, fail_range_start, 
+                                                       pos - fail_range_start));
+                  eicat_ascii (error_details, " using coding system");
+
+                  signal_error (Qtext_conversion_error, 
+                                (const CIbyte *)(eidata (error_details)),
+                                XCODING_SYSTEM_NAME (codesys));
+                }
+
+              if (NILP (result))
+                {
+                  result = Fmake_range_table (Qstart_closed_end_open);
+                }
+
+              fail_range_end = pos;
+
+              Fput_range_table (make_int (fail_range_start), 
+                                make_int (fail_range_end),
+                                (previous_failed_reason
+                                 == query_coding_unencodable ?
+                                 Qunencodable : Qinvalid_sequence), 
+                                result);
+              previous_failed_reason = query_coding_succeeded;
+
+              if (flags & QUERY_METHOD_HIGHLIGHT) 
+                {
+                  Lisp_Object extent
+                    = Fmake_extent (make_int (fail_range_start),
+                                    make_int (fail_range_end), 
+                                    wrap_buffer (buf));
+                  
+                  Fset_extent_priority
+                    (extent, make_int (2 + mouse_highlight_priority));
+                  Fset_extent_face (extent, Qquery_coding_warning_face);
+                }
+            }
+        }
+    }
+
+  return result;
+}
 
 
 /************************************************************************/
@@ -3430,6 +3934,11 @@
   DEFSYMBOL (Qiso_8_1);
   DEFSYMBOL (Qiso_8_2);
   DEFSYMBOL (Qiso_lock_shift);
+
+  DEFSYMBOL (Qfrom_unicode);
+  DEFSYMBOL (Qinvalid_sequences_skip_chars);
+  DEFSYMBOL (Qquery_skip_chars);
+  DEFSYMBOL (Qfixed_width);
 }
 
 void
@@ -3465,6 +3974,17 @@
   CODING_SYSTEM_HAS_METHOD (ccl, putprop);
   CODING_SYSTEM_HAS_METHOD (ccl, getprop);
 
+  INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA (fixed_width,
+                                           "fixed-width-coding-system-p");
+  CODING_SYSTEM_HAS_METHOD (fixed_width, mark);
+  CODING_SYSTEM_HAS_METHOD (fixed_width, convert);
+  CODING_SYSTEM_HAS_METHOD (fixed_width, query);
+  CODING_SYSTEM_HAS_METHOD (fixed_width, init);
+  CODING_SYSTEM_HAS_METHOD (fixed_width, init_coding_stream);
+  CODING_SYSTEM_HAS_METHOD (fixed_width, rewind_coding_stream);
+  CODING_SYSTEM_HAS_METHOD (fixed_width, putprop);
+  CODING_SYSTEM_HAS_METHOD (fixed_width, getprop);
+
   INITIALIZE_CODING_SYSTEM_TYPE (shift_jis, "shift-jis-coding-system-p");
   CODING_SYSTEM_HAS_METHOD (shift_jis, convert);
 
@@ -3485,6 +4005,7 @@
 {
   REINITIALIZE_CODING_SYSTEM_TYPE (iso2022);
   REINITIALIZE_CODING_SYSTEM_TYPE (ccl);
+  REINITIALIZE_CODING_SYSTEM_TYPE (fixed_width);
   REINITIALIZE_CODING_SYSTEM_TYPE (shift_jis);
   REINITIALIZE_CODING_SYSTEM_TYPE (big5);
 }
@@ -3497,4 +4018,9 @@
 void
 vars_of_mule_coding (void)
 {
+  /* This needs to be HASH_TABLE_EQ, there's a corner case where
+     HASH_TABLE_EQUAL won't work. */
+  Vfixed_width_query_ranges_cache
+   = make_lisp_hash_table (32, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);
+  staticpro (&Vfixed_width_query_ranges_cache);
 }