Sync up with r21-2-19-tomo-4.

[chise/xemacs-chise.git-] / src / mule-charset.c

diff --git a/src/mule-charset.c b/src/mule-charset.c
index 67f1049..c3e12f0 100644 (file)
--- a/src/mule-charset.c
+++ b/src/mule-charset.c
@@ -32,6 +32,7 @@ Boston, MA 02111-1307, USA.  */
 #include "lstream.h"
 #include "device.h"
 #include "faces.h"
 #include "lstream.h"
 #include "device.h"
 #include "faces.h"

+#include "mule-ccl.h"

 
 /* The various pre-defined charsets. */
 
 
 /* The various pre-defined charsets. */
 

@@ -74,11 +75,12 @@ static int composite_char_col_next;
 #endif /* ENABLE_COMPOSITE_CHARS */
 
 /* Table of charsets indexed by leading byte. */
 #endif /* ENABLE_COMPOSITE_CHARS */
 
 /* Table of charsets indexed by leading byte. */

-Lisp_Object charset_by_leading_byte[128];
+Lisp_Object charset_by_leading_byte[NUM_LEADING_BYTES];

 
 /* Table of charsets indexed by type/final-byte/direction. */
 Lisp_Object charset_by_attributes[4][128][2];
 
 
 /* Table of charsets indexed by type/final-byte/direction. */
 Lisp_Object charset_by_attributes[4][128][2];
 

+#ifndef UTF2000

 /* Table of number of bytes in the string representation of a character
    indexed by the first byte of that representation.
 
 /* Table of number of bytes in the string representation of a character
    indexed by the first byte of that representation.
 

@@ -98,12 +100,21 @@ Bytecount rep_bytes_by_first_byte[0xA0] =
   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
   /* 0x80 - 0x8f are for Dimension-1 official charsets */
   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
   /* 0x80 - 0x8f are for Dimension-1 official charsets */

+#ifdef CHAR_IS_UCS4
+  2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
+#else

   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,

+#endif

   /* 0x90 - 0x9d are for Dimension-2 official charsets */
   /* 0x9e is for Dimension-1 private charsets */
   /* 0x9f is for Dimension-2 private charsets */
   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
 };
   /* 0x90 - 0x9d are for Dimension-2 official charsets */
   /* 0x9e is for Dimension-1 private charsets */
   /* 0x9f is for Dimension-2 private charsets */
   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
 };

+#endif
+
+Lisp_Object Vutf_2000_version;
+
+int leading_code_private_11;

 
 Lisp_Object Qcharsetp;
 
 
 Lisp_Object Qcharsetp;
 

@@ -111,7 +122,6 @@ Lisp_Object Qcharsetp;
 Lisp_Object Qregistry, Qfinal, Qgraphic;
 Lisp_Object Qdirection;
 Lisp_Object Qreverse_direction_charset;
 Lisp_Object Qregistry, Qfinal, Qgraphic;
 Lisp_Object Qdirection;
 Lisp_Object Qreverse_direction_charset;

-Lisp_Object Qccl_program;

 Lisp_Object Qleading_byte;
 Lisp_Object Qshort_name, Qlong_name;
 
 Lisp_Object Qleading_byte;
 Lisp_Object Qshort_name, Qlong_name;
 

@@ -190,11 +200,54 @@ Bytecount
 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
 {
   Bufbyte *p;
 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
 {
   Bufbyte *p;

+#ifndef UTF2000

   Bufbyte lb;
   int c1, c2;
   Lisp_Object charset;
   Bufbyte lb;
   int c1, c2;
   Lisp_Object charset;

+#endif

 
   p = str;
 
   p = str;

+#ifdef UTF2000
+  if ( c <= 0x7f )
+    {
+      *p++ = c;
+    }
+  else if ( c <= 0x7ff )
+    {
+      *p++ = (c >> 6) | 0xc0;
+      *p++ = (c & 0x3f) | 0x80;
+    }
+  else if ( c <= 0xffff )
+    {
+      *p++ =  (c >> 12) | 0xe0;
+      *p++ = ((c >>  6) & 0x3f) | 0x80;
+      *p++ =  (c        & 0x3f) | 0x80;
+    }
+  else if ( c <= 0x1fffff )
+    {
+      *p++ =  (c >> 18) | 0xf0;
+      *p++ = ((c >> 12) & 0x3f) | 0x80;
+      *p++ = ((c >>  6) & 0x3f) | 0x80;
+      *p++ =  (c        & 0x3f) | 0x80;
+    }
+  else if ( c <= 0x3ffffff )
+    {
+      *p++ =  (c >> 24) | 0xf8;
+      *p++ = ((c >> 18) & 0x3f) | 0x80;
+      *p++ = ((c >> 12) & 0x3f) | 0x80;
+      *p++ = ((c >>  6) & 0x3f) | 0x80;
+      *p++ =  (c        & 0x3f) | 0x80;
+    }
+  else
+    {
+      *p++ =  (c >> 30) | 0xfc;
+      *p++ = ((c >> 24) & 0x3f) | 0x80;
+      *p++ = ((c >> 18) & 0x3f) | 0x80;
+      *p++ = ((c >> 12) & 0x3f) | 0x80;
+      *p++ = ((c >>  6) & 0x3f) | 0x80;
+      *p++ =  (c        & 0x3f) | 0x80;
+    }
+#else

   BREAKUP_CHAR (c, charset, c1, c2);
   lb = CHAR_LEADING_BYTE (c);
   if (LEADING_BYTE_PRIVATE_P (lb))
   BREAKUP_CHAR (c, charset, c1, c2);
   lb = CHAR_LEADING_BYTE (c);
   if (LEADING_BYTE_PRIVATE_P (lb))

@@ -205,7 +258,7 @@ non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
   *p++ = c1 | 0x80;
   if (c2)
     *p++ = c2 | 0x80;
   *p++ = c1 | 0x80;
   if (c2)
     *p++ = c2 | 0x80;

-
+#endif

   return (p - str);
 }
 
   return (p - str);
 }
 

@@ -216,6 +269,49 @@ non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
 Emchar
 non_ascii_charptr_emchar (CONST Bufbyte *str)
 {
 Emchar
 non_ascii_charptr_emchar (CONST Bufbyte *str)
 {

+#ifdef UTF2000
+  Bufbyte b;
+  Emchar ch;
+  int len;
+
+  b = *str++;
+  if ( b >= 0xfc )
+    {
+      ch = (b & 0x01);
+      len = 5;
+    }
+  else if ( b >= 0xf8 )
+    {
+      ch = b & 0x03;
+      len = 4;
+    }
+  else if ( b >= 0xf0 )
+    {
+      ch = b & 0x07;
+      len = 3;
+    }
+  else if ( b >= 0xe0 )
+    {
+      ch = b & 0x0f;
+      len = 2;
+    }
+  else if ( b >= 0xc0 )
+    {
+      ch = b & 0x1f;
+      len = 1;
+    }
+  else
+    {
+      ch = b;
+      len = 0;
+    }
+  for( ; len > 0; len-- )
+    {
+      b = *str++;
+      ch = ( ch << 6 ) | ( b & 0x3f );
+    }
+  return ch;
+#else

   Bufbyte i0 = *str, i1, i2 = 0;
   Lisp_Object charset;
 
   Bufbyte i0 = *str, i1, i2 = 0;
   Lisp_Object charset;
 

@@ -232,11 +328,13 @@ non_ascii_charptr_emchar (CONST Bufbyte *str)
     i2 = *++str & 0x7F;
 
   return MAKE_CHAR (charset, i1, i2);
     i2 = *++str & 0x7F;
 
   return MAKE_CHAR (charset, i1, i2);

+#endif

 }
 
 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
    Do not call this directly.  Use the macro valid_char_p() instead. */
 
 }
 
 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
    Do not call this directly.  Use the macro valid_char_p() instead. */
 

+#ifndef UTF2000

 int
 non_ascii_valid_char_p (Emchar ch)
 {
 int
 non_ascii_valid_char_p (Emchar ch)
 {

@@ -307,6 +405,7 @@ non_ascii_valid_char_p (Emchar ch)
       return (XCHARSET_CHARS (charset) == 96);
     }
 }
       return (XCHARSET_CHARS (charset) == 96);
     }
 }

+#endif

 
 \f
 /************************************************************************/
 
 \f
 /************************************************************************/

@@ -325,6 +424,10 @@ non_ascii_charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *str)
   switch (REP_BYTES_BY_FIRST_BYTE (*strptr))
     {
       /* Notice fallthrough. */
   switch (REP_BYTES_BY_FIRST_BYTE (*strptr))
     {
       /* Notice fallthrough. */

+#ifdef UTF2000
+    case 6: *++strptr = *ptr++;
+    case 5: *++strptr = *ptr++;
+#endif

     case 4: *++strptr = *ptr++;
     case 3: *++strptr = *ptr++;
     case 2: *++strptr = *ptr;
     case 4: *++strptr = *ptr++;
     case 3: *++strptr = *ptr++;
     case 2: *++strptr = *ptr;

@@ -354,6 +457,16 @@ Lstream_get_emchar_1 (Lstream *stream, int ch)
   switch (REP_BYTES_BY_FIRST_BYTE (ch))
     {
       /* Notice fallthrough. */
   switch (REP_BYTES_BY_FIRST_BYTE (ch))
     {
       /* Notice fallthrough. */

+#ifdef UTF2000
+    case 6:
+      ch = Lstream_getc (stream);
+      assert (ch >= 0);
+      *++strptr = (Bufbyte) ch;
+    case 5:
+      ch = Lstream_getc (stream);
+      assert (ch >= 0);
+      *++strptr = (Bufbyte) ch;
+#endif

     case 4:
       ch = Lstream_getc (stream);
       assert (ch >= 0);
     case 4:
       ch = Lstream_getc (stream);
       assert (ch >= 0);

@@ -441,8 +554,13 @@ print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
   write_c_string (buf, printcharfun);
 }
 
   write_c_string (buf, printcharfun);
 }
 

+static const struct lrecord_description charset_description[] = {
+  { XD_LISP_OBJECT, offsetof(struct Lisp_Charset, name), 7 },
+  { XD_END }
+};
+

 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,

-                               mark_charset, print_charset, 0, 0, 0,
+                               mark_charset, print_charset, 0, 0, 0, charset_description,

                               struct Lisp_Charset);
 /* Make a new charset. */
 
                               struct Lisp_Charset);
 /* Make a new charset. */
 

@@ -487,11 +605,13 @@ make_charset (int id, Lisp_Object name, unsigned char rep_bytes,
       charset_by_attributes[type][final][direction] = obj;
     }
 
       charset_by_attributes[type][final][direction] = obj;
     }
 

-  assert (NILP (charset_by_leading_byte[id - 128]));
-  charset_by_leading_byte[id - 128] = obj;
+  assert (NILP (charset_by_leading_byte[id - MIN_LEADING_BYTE]));
+  charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj;
+#ifndef UTF2000

   if (id < 0xA0)
     /* official leading byte */
     rep_bytes_by_first_byte[id] = rep_bytes;
   if (id < 0xA0)
     /* official leading byte */
     rep_bytes_by_first_byte[id] = rep_bytes;

+#endif

 
   /* Some charsets are "faux" and don't have names or really exist at
      all except in the leading-byte table. */
 
   /* Some charsets are "faux" and don't have names or really exist at
      all except in the leading-byte table. */

@@ -1050,7 +1170,10 @@ Set the 'registry property of CHARSET to REGISTRY.
 /************************************************************************/
 
 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
 /************************************************************************/
 
 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*

-Make a multi-byte character from CHARSET and octets ARG1 and ARG2.
+Make a character from CHARSET and octets ARG1 and ARG2.
+ARG2 is required only for characters from two-dimensional charsets.
+For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
+character s with caron.

 */
        (charset, arg1, arg2))
 {
 */
        (charset, arg1, arg2))
 {

@@ -1102,27 +1225,33 @@ Return the character set of char CH.
                        (CHAR_LEADING_BYTE (XCHAR (ch))));
 }
 
                        (CHAR_LEADING_BYTE (XCHAR (ch))));
 }
 

-DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
-Return the octet numbered N (should be 0 or 1) of char CH.
-N defaults to 0 if omitted.
+DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
+Return list of charset and one or two position-codes of CHAR.

 */
 */

-       (ch, n))
+       (character))

 {
 {

-  Lisp_Object charset;
-  int c1, c2, int_n;
+  /* This function can GC */
+  struct gcpro gcpro1, gcpro2;
+  Lisp_Object charset = Qnil;
+  Lisp_Object rc = Qnil;
+  int c1, c2;

 
 

-  CHECK_CHAR_COERCE_INT (ch);
-  if (NILP (n))
-    int_n = 0;
+  GCPRO2 (charset, rc);
+  CHECK_CHAR_COERCE_INT (character);
+
+  BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
+
+  if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
+    {
+      rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
+    }

   else
     {
   else
     {

-      CHECK_INT (n);
-      int_n = XINT (n);
-      if (int_n != 0 && int_n != 1)
-       signal_simple_error ("Octet number must be 0 or 1", n);
+      rc = list2 (XCHARSET_NAME (charset), make_int (c1));

     }
     }

-  BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
-  return make_int (int_n == 0 ? c1 : c2);
+  UNGCPRO;
+
+  return rc;

 }
 
 \f
 }
 
 \f

@@ -1227,7 +1356,7 @@ syms_of_mule_charset (void)
 
   DEFSUBR (Fmake_char);
   DEFSUBR (Fchar_charset);
 
   DEFSUBR (Fmake_char);
   DEFSUBR (Fchar_charset);

-  DEFSUBR (Fchar_octet);
+  DEFSUBR (Fsplit_char);

 
 #ifdef ENABLE_COMPOSITE_CHARS
   DEFSUBR (Fmake_composite_char);
 
 #ifdef ENABLE_COMPOSITE_CHARS
   DEFSUBR (Fmake_composite_char);

@@ -1240,7 +1369,6 @@ syms_of_mule_charset (void)
   defsymbol (&Qgraphic, "graphic");
   defsymbol (&Qdirection, "direction");
   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
   defsymbol (&Qgraphic, "graphic");
   defsymbol (&Qdirection, "direction");
   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");

-  defsymbol (&Qccl_program, "ccl-program");

   defsymbol (&Qshort_name, "short-name");
   defsymbol (&Qlong_name, "long-name");
 
   defsymbol (&Qshort_name, "short-name");
   defsymbol (&Qlong_name, "long-name");
 

@@ -1274,6 +1402,19 @@ syms_of_mule_charset (void)
   defsymbol (&Qchinese_big5_2,         "chinese-big5-2");
 
   defsymbol (&Qcomposite,              "composite");
   defsymbol (&Qchinese_big5_2,         "chinese-big5-2");
 
   defsymbol (&Qcomposite,              "composite");

+
+#ifdef UTF2000
+  Vutf_2000_version = build_string("0.4 (Shin-Imamiya)");
+  DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
+Version number of UTF-2000.
+*/ );
+#endif
+
+  leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
+  DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
+Leading-code of private TYPE9N charset of column-width 1.
+*/ );
+  leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;

 }
 
 void
 }
 
 void