update.
[chise/xemacs-chise.git-] / src / mule-charset.c
index cf3b4ac..593492e 100644 (file)
@@ -63,9 +63,11 @@ Lisp_Object Vcharset_chinese_cns11643_2;
 Lisp_Object Vcharset_ucs;
 Lisp_Object Vcharset_ucs_bmp;
 Lisp_Object Vcharset_latin_viscii;
+Lisp_Object Vcharset_latin_tcvn5712;
 Lisp_Object Vcharset_latin_viscii_lower;
 Lisp_Object Vcharset_latin_viscii_upper;
 Lisp_Object Vcharset_ideograph_daikanwa;
+Lisp_Object Vcharset_mojikyo;
 Lisp_Object Vcharset_mojikyo_pj_1;
 Lisp_Object Vcharset_mojikyo_pj_2;
 Lisp_Object Vcharset_mojikyo_pj_3;
@@ -571,7 +573,40 @@ put_char_attribute (Lisp_Object character, Lisp_Object attribute,
   put_char_code_table (char_code, ret, Vcharacter_attribute_table);
   return ret;
 }
-  
+
+Lisp_Object
+remove_char_attribute (Lisp_Object character, Lisp_Object attribute)
+{
+  Emchar char_code = XCHAR (character);
+  Lisp_Object alist
+    = get_char_code_table (char_code, Vcharacter_attribute_table);
+
+  if (EQ (attribute, Fcar (Fcar (alist))))
+    {
+      alist = Fcdr (alist);
+    }
+  else
+    {
+      Lisp_Object pr = alist;
+      Lisp_Object r = Fcdr (alist);
+
+      while (!NILP (r))
+       {
+         if (EQ (attribute, Fcar (Fcar (r))))
+           {
+             XCDR (pr) = Fcdr (r);
+             break;
+           }
+         pr = r;
+         r = Fcdr (r);
+       }
+    }
+  put_char_code_table (char_code, alist, Vcharacter_attribute_table);
+  return alist;
+}
+
+Lisp_Object Qucs;
+
 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
 Store CHARACTER's ATTRIBUTE with VALUE.
 */
@@ -583,134 +618,164 @@ Store CHARACTER's ATTRIBUTE with VALUE.
   ccs = Ffind_charset (attribute);
   if (!NILP (ccs))
     {
-      Lisp_Object cpos, rest;
-      Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
-      Lisp_Object nv;
-      int i = -1;
-      int ccs_len;
-      int dim;
-      int code_point;
-             
-      /* ad-hoc method for `ascii' */
-      if ((XCHARSET_CHARS (ccs) == 94) &&
-         (XCHARSET_BYTE_OFFSET (ccs) != 33))
-       ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs);
-      else
-       ccs_len = XCHARSET_CHARS (ccs);
-         
-      if (CONSP (value))
+      if (!EQ (XCHARSET_NAME (ccs), Qucs)
+         || (XCHAR (character) != XINT (value)))
        {
-         Lisp_Object ret = Fcar (value);
+         Lisp_Object cpos, rest;
+         Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
+         Lisp_Object nv;
+         int i = -1;
+         int ccs_len;
+         int dim;
+         int code_point;
+
+         /* ad-hoc method for `ascii' */
+         if ((XCHARSET_CHARS (ccs) == 94) &&
+             (XCHARSET_BYTE_OFFSET (ccs) != 33))
+           ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs);
+         else
+           ccs_len = XCHARSET_CHARS (ccs);
 
-         if (!INTP (ret))
-           signal_simple_error ("Invalid value for coded-charset", value);
-         code_point = XINT (ret);
-         if (XCHARSET_GRAPHIC (ccs) == 1)
-           code_point &= 0x7F;
-         rest = Fcdr (value);
-         while (!NILP (rest))
+         if (CONSP (value))
            {
-             int i;
+             Lisp_Object ret = Fcar (value);
 
-             if (!CONSP (rest))
-               signal_simple_error ("Invalid value for coded-charset", value);
-             ret = Fcar (rest);
              if (!INTP (ret))
                signal_simple_error ("Invalid value for coded-charset", value);
-             i = XINT (ret);
+             code_point = XINT (ret);
              if (XCHARSET_GRAPHIC (ccs) == 1)
-               i &= 0x7F;
-             code_point = (code_point << 8) | i;
-             rest = Fcdr (rest);
+               code_point &= 0x7F;
+             rest = Fcdr (value);
+             while (!NILP (rest))
+               {
+                 int i;
+
+                 if (!CONSP (rest))
+                   signal_simple_error ("Invalid value for coded-charset",
+                                        value);
+                 ret = Fcar (rest);
+                 if (!INTP (ret))
+                   signal_simple_error ("Invalid value for coded-charset",
+                                        value);
+                 i = XINT (ret);
+                 if (XCHARSET_GRAPHIC (ccs) == 1)
+                   i &= 0x7F;
+                 code_point = (code_point << 8) | i;
+                 rest = Fcdr (rest);
+               }
+             value = make_int (code_point);
            }
-         value = make_int (code_point);
-       }
-      else if (INTP (value))
-       {
-         if (XCHARSET_GRAPHIC (ccs) == 1)
-           value = make_int (XINT (value) & 0x7F7F7F7F);
-       }
-      else
-       signal_simple_error ("Invalid value for coded-charset", value);
+         else if (INTP (value))
+           {
+             if (XCHARSET_GRAPHIC (ccs) == 1)
+               value = make_int (XINT (value) & 0x7F7F7F7F);
+           }
+         else
+           signal_simple_error ("Invalid value for coded-charset", value);
 
-      attribute = ccs;
-      cpos = Fget_char_attribute (character, attribute);
-      if (VECTORP (v))
-       {
-         if (!NILP (cpos))
+         attribute = ccs;
+         cpos = Fget_char_attribute (character, attribute);
+         if (VECTORP (v))
            {
-             dim = XCHARSET_DIMENSION (ccs);
-             code_point = XINT (cpos);
-             while (dim > 0)
+             if (!NILP (cpos))
                {
-                 dim--;
-                 i = ((code_point >> (8 * dim)) & 255)
-                   - XCHARSET_BYTE_OFFSET (ccs);
-                 nv = XVECTOR_DATA(v)[i];
-                 if (!VECTORP (nv))
-                   break;
-                 v = nv;
+                 dim = XCHARSET_DIMENSION (ccs);
+                 code_point = XINT (cpos);
+                 while (dim > 0)
+                   {
+                     dim--;
+                     i = ((code_point >> (8 * dim)) & 255)
+                       - XCHARSET_BYTE_OFFSET (ccs);
+                     nv = XVECTOR_DATA(v)[i];
+                     if (!VECTORP (nv))
+                       break;
+                     v = nv;
+                   }
+                 if (i >= 0)
+                   XVECTOR_DATA(v)[i] = Qnil;
+                 v = XCHARSET_DECODING_TABLE (ccs);
                }
-             if (i >= 0)
-               XVECTOR_DATA(v)[i] = Qnil;
-             v = XCHARSET_DECODING_TABLE (ccs);
            }
-       }
-      else
-       {
-         XCHARSET_DECODING_TABLE (ccs) = v = make_vector (ccs_len, Qnil);
-       }
+         else
+           {
+             XCHARSET_DECODING_TABLE (ccs) = v = make_vector (ccs_len, Qnil);
+           }
 
-      dim = XCHARSET_DIMENSION (ccs);
-      code_point = XINT (value);
-      i = -1;
-      while (dim > 0)
-       {
-         dim--;
-         i = ((code_point >> (8 * dim)) & 255) - XCHARSET_BYTE_OFFSET (ccs);
-         nv = XVECTOR_DATA(v)[i];
-         if (dim > 0)
+         dim = XCHARSET_DIMENSION (ccs);
+         code_point = XINT (value);
+         i = -1;
+         while (dim > 0)
            {
-             if (!VECTORP (nv))
-               nv = (XVECTOR_DATA(v)[i] = make_vector (ccs_len, Qnil));
-             v = nv;
+             dim--;
+             i = ((code_point >> (8 * dim)) & 255)
+               - XCHARSET_BYTE_OFFSET (ccs);
+             nv = XVECTOR_DATA(v)[i];
+             if (dim > 0)
+               {
+                 if (!VECTORP (nv))
+                   nv = (XVECTOR_DATA(v)[i] = make_vector (ccs_len, Qnil));
+                 v = nv;
+               }
+             else
+               break;
            }
-         else
-           break;
+         XVECTOR_DATA(v)[i] = character;
        }
-      XVECTOR_DATA(v)[i] = character;
+      else
+       attribute = ccs;
     }
   else if (EQ (attribute, Q_decomposition))
     {
-      Lisp_Object rest = value;
-      Lisp_Object table = Vcharacter_composition_table;
-
       if (!CONSP (value))
        signal_simple_error ("Invalid value for ->decomposition",
                             value);
 
-      while (CONSP (rest))
+      if (CONSP (Fcdr (value)))
        {
-         Lisp_Object v = Fcar (rest);
-         Lisp_Object ntable;
-         Emchar c
-           = to_char_code (v, "Invalid value for ->decomposition", value);
+         Lisp_Object rest = value;
+         Lisp_Object table = Vcharacter_composition_table;
 
-         rest = Fcdr (rest);
-         if (!CONSP (rest))
+         while (CONSP (rest))
            {
-             put_char_code_table (c, character, table);
-             break;
+             Lisp_Object v = Fcar (rest);
+             Lisp_Object ntable;
+             Emchar c
+               = to_char_code (v,
+                               "Invalid value for ->decomposition", value);
+
+             rest = Fcdr (rest);
+             if (!CONSP (rest))
+               {
+                 put_char_code_table (c, character, table);
+                 break;
+               }
+             else
+               {
+                 ntable = get_char_code_table (c, table);
+                 if (!CHAR_CODE_TABLE_P (ntable))
+                   {
+                     ntable = make_char_code_table (Qnil);
+                     put_char_code_table (c, ntable, table);
+                   }
+                 table = ntable;
+               }
            }
-         else
+       }
+      else
+       {
+         Lisp_Object v = Fcar (value);
+
+         if (INTP (v))
            {
-             ntable = get_char_code_table (c, table);
-             if (!CHAR_CODE_TABLE_P (ntable))
+             Emchar c = XINT (v);
+             Lisp_Object ret
+               = get_char_code_table (c, Vcharacter_variant_table);
+
+             if (NILP (Fmemq (v, ret)))
                {
-                 ntable = make_char_code_table (Qnil);
-                 put_char_code_table (c, ntable, table);
+                 put_char_code_table (c, Fcons (character, ret),
+                                      Vcharacter_variant_table);
                }
-             table = ntable;
            }
        }
     }
@@ -733,8 +798,59 @@ Store CHARACTER's ATTRIBUTE with VALUE.
     }
   return put_char_attribute (character, attribute, value);
 }
+  
+DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
+Remove CHARACTER's ATTRIBUTE.
+*/
+       (character, attribute))
+{
+  Lisp_Object ccs;
 
-Lisp_Object Qucs;
+  CHECK_CHAR (character);
+  ccs = Ffind_charset (attribute);
+  if (!NILP (ccs))
+    {
+      Lisp_Object cpos;
+      Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
+      Lisp_Object nv;
+      int i = -1;
+      int ccs_len;
+      int dim;
+      int code_point;
+             
+      /* ad-hoc method for `ascii' */
+      if ((XCHARSET_CHARS (ccs) == 94) &&
+         (XCHARSET_BYTE_OFFSET (ccs) != 33))
+       ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs);
+      else
+       ccs_len = XCHARSET_CHARS (ccs);
+
+      attribute = ccs;
+      cpos = Fget_char_attribute (character, attribute);
+      if (VECTORP (v))
+       {
+         if (!NILP (cpos))
+           {
+             dim = XCHARSET_DIMENSION (ccs);
+             code_point = XINT (cpos);
+             while (dim > 0)
+               {
+                 dim--;
+                 i = ((code_point >> (8 * dim)) & 255)
+                   - XCHARSET_BYTE_OFFSET (ccs);
+                 nv = XVECTOR_DATA(v)[i];
+                 if (!VECTORP (nv))
+                   break;
+                 v = nv;
+               }
+             if (i >= 0)
+               XVECTOR_DATA(v)[i] = Qnil;
+             v = XCHARSET_DECODING_TABLE (ccs);
+           }
+       }
+    }
+  return remove_char_attribute (character, attribute);
+}
 
 EXFUN (Fmake_char, 3);
 EXFUN (Fdecode_char, 2);
@@ -757,7 +873,9 @@ Store character's ATTRIBUTES.
 
          if (!LISTP (cell))
            signal_simple_error ("Invalid argument", attributes);
-         if (!NILP (ccs = Ffind_charset (Fcar (cell))))
+         if (!NILP (ccs = Ffind_charset (Fcar (cell)))
+             && ((XCHARSET_FINAL (ccs) != 0) ||
+                 (XCHARSET_UCS_MAX (ccs) > 0)) )
            {
              cell = Fcdr (cell);
              if (CONSP (cell))
@@ -839,11 +957,13 @@ Lisp_Object Qascii,
 #ifdef UTF2000
   Qucs_bmp,
   Qlatin_viscii,
+  Qlatin_tcvn5712,
   Qlatin_viscii_lower,
   Qlatin_viscii_upper,
   Qvietnamese_viscii_lower,
   Qvietnamese_viscii_upper,
   Qideograph_daikanwa,
+  Qmojikyo,
   Qmojikyo_pj_1,
   Qmojikyo_pj_2,
   Qmojikyo_pj_3,
@@ -1618,12 +1738,12 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
       *charset = Vcharset_latin_iso8859_1;
       return c & 0x7F;
     }
+  /*
   else if ((MIN_CHAR_GREEK <= c) && (c <= MAX_CHAR_GREEK))
     {
       *charset = Vcharset_greek_iso8859_7;
       return c - MIN_CHAR_GREEK + 0x20;
     }
-  /*
   else if ((MIN_CHAR_CYRILLIC <= c) && (c <= MAX_CHAR_CYRILLIC))
     {
       *charset = Vcharset_cyrillic_iso8859_5;
@@ -2397,6 +2517,7 @@ Make a character from CHARSET and code-point CODE.
   int c;
 
   charset = Fget_charset (charset);
+  CHECK_INT (code);
   c = XINT (code);
   if (XCHARSET_GRAPHIC (charset) == 1)
     c &= 0x7F7F7F7F;
@@ -2645,6 +2766,7 @@ syms_of_mule_charset (void)
   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fput_char_attribute);
+  DEFSUBR (Fremove_char_attribute);
   DEFSUBR (Fdefine_char);
   DEFSUBR (Fchar_variants);
   DEFSUBR (Fget_composite_char);
@@ -2723,11 +2845,13 @@ syms_of_mule_charset (void)
   defsymbol (&Qucs,                    "ucs");
   defsymbol (&Qucs_bmp,                        "ucs-bmp");
   defsymbol (&Qlatin_viscii,           "latin-viscii");
+  defsymbol (&Qlatin_tcvn5712,         "latin-tcvn5712");
   defsymbol (&Qlatin_viscii_lower,     "latin-viscii-lower");
   defsymbol (&Qlatin_viscii_upper,     "latin-viscii-upper");
   defsymbol (&Qvietnamese_viscii_lower,        "vietnamese-viscii-lower");
   defsymbol (&Qvietnamese_viscii_upper,        "vietnamese-viscii-upper");
   defsymbol (&Qideograph_daikanwa,     "ideograph-daikanwa");
+  defsymbol (&Qmojikyo,                        "mojikyo");
   defsymbol (&Qmojikyo_pj_1,           "mojikyo-pj-1");
   defsymbol (&Qmojikyo_pj_2,           "mojikyo-pj-2");
   defsymbol (&Qmojikyo_pj_3,           "mojikyo-pj-3");
@@ -2801,7 +2925,7 @@ Leading-code of private TYPE9N charset of column-width 1.
 #endif
 
 #ifdef UTF2000
-  Vutf_2000_version = build_string("0.14 (Kawachi-Katakami)");
+  Vutf_2000_version = build_string("0.15 (Sangō)");
   DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
 Version number of UTF-2000.
 */ );
@@ -2855,14 +2979,10 @@ complex_vars_of_mule_charset (void)
 #else
 # define MIN_CHAR_THAI 0
 # define MAX_CHAR_THAI 0
-# define MIN_CHAR_GREEK 0
-# define MAX_CHAR_GREEK 0
 # define MIN_CHAR_HEBREW 0
 # define MAX_CHAR_HEBREW 0
 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
-# define MIN_CHAR_CYRILLIC 0
-# define MAX_CHAR_CYRILLIC 0
 #endif
   staticpro (&Vcharset_ascii);
   Vcharset_ascii =
@@ -2935,7 +3055,9 @@ complex_vars_of_mule_charset (void)
                  build_string ("ISO8859-7 (Greek)"),
                  build_string ("ISO8859-7 (Greek)"),
                  build_string ("iso8859-7"),
-                 Qnil, MIN_CHAR_GREEK, MAX_CHAR_GREEK, 0, 32);
+                 Qnil,
+                 0 /* MIN_CHAR_GREEK */,
+                 0 /* MAX_CHAR_GREEK */, 0, 32);
   staticpro (&Vcharset_arabic_iso8859_6);
   Vcharset_arabic_iso8859_6 =
     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
@@ -3076,6 +3198,15 @@ complex_vars_of_mule_charset (void)
                  build_string (CHINESE_CNS_PLANE_RE("2")),
                  Qnil, 0, 0, 0, 33);
 #ifdef UTF2000
+  staticpro (&Vcharset_latin_tcvn5712);
+  Vcharset_latin_tcvn5712 =
+    make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
+                 1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
+                 build_string ("TCVN 5712"),
+                 build_string ("TCVN 5712 (VSCII-2)"),
+                 build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
+                 build_string ("tcvn5712-1"),
+                 Qnil, 0, 0, 0, 32);
   staticpro (&Vcharset_latin_viscii_lower);
   Vcharset_latin_viscii_lower =
     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
@@ -3112,6 +3243,15 @@ complex_vars_of_mule_charset (void)
                  build_string ("Daikanwa dictionary by MOROHASHI Tetsuji"),
                  build_string ("Daikanwa"),
                  Qnil, MIN_CHAR_DAIKANWA, MAX_CHAR_DAIKANWA, 0, 0);
+  staticpro (&Vcharset_mojikyo);
+  Vcharset_mojikyo =
+    make_charset (LEADING_BYTE_MOJIKYO, Qmojikyo, 256, 3,
+                 2, 2, 0, CHARSET_LEFT_TO_RIGHT,
+                 build_string ("Mojikyo"),
+                 build_string ("Mojikyo"),
+                 build_string ("Konjaku-Mojikyo"),
+                 build_string (""),
+                 Qnil, MIN_CHAR_MOJIKYO, MAX_CHAR_MOJIKYO, 0, 0);
   staticpro (&Vcharset_mojikyo_pj_1);
   Vcharset_mojikyo_pj_1 =
     make_charset (LEADING_BYTE_MOJIKYO_PJ_1, Qmojikyo_pj_1, 94, 2,