update.
[chise/xemacs-chise.git-] / src / mule-charset.c
index 2c240d1..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;
@@ -579,7 +581,7 @@ remove_char_attribute (Lisp_Object character, Lisp_Object attribute)
   Lisp_Object alist
     = get_char_code_table (char_code, Vcharacter_attribute_table);
 
-  if (!EQ (attribute, Fcar (Fcar (alist))))
+  if (EQ (attribute, Fcar (Fcar (alist))))
     {
       alist = Fcdr (alist);
     }
@@ -603,6 +605,8 @@ remove_char_attribute (Lisp_Object character, Lisp_Object attribute)
   return alist;
 }
 
+Lisp_Object Qucs;
+
 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
 Store CHARACTER's ATTRIBUTE with VALUE.
 */
@@ -614,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;
            }
        }
     }
@@ -818,8 +852,6 @@ Remove CHARACTER's ATTRIBUTE.
   return remove_char_attribute (character, attribute);
 }
 
-Lisp_Object Qucs;
-
 EXFUN (Fmake_char, 3);
 EXFUN (Fdecode_char, 2);
 
@@ -841,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))
@@ -923,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,
@@ -2809,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");
@@ -2887,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.
 */ );
@@ -3160,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,
@@ -3196,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,