update.
[chise/xemacs-chise.git-] / src / mule-charset.c
index e9131b0..5f08959 100644 (file)
@@ -63,6 +63,7 @@ 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;
@@ -110,7 +111,7 @@ static int composite_char_col_next;
 struct charset_lookup *chlook;
 
 static const struct lrecord_description charset_lookup_description_1[] = {
-  { XD_LISP_OBJECT, offsetof(struct charset_lookup, charset_by_leading_byte),
+  { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte),
 #ifdef UTF2000
     128+4*128
 #else
@@ -120,7 +121,7 @@ static const struct lrecord_description charset_lookup_description_1[] = {
 };
 
 static const struct struct_description charset_lookup_description = {
-  sizeof(struct charset_lookup),
+  sizeof (struct charset_lookup),
   charset_lookup_description_1
 };
 
@@ -352,6 +353,7 @@ get_char_code_table (Emchar ch, Lisp_Object table)
   return cpt->property [(unsigned char) code];
 }
 
+void put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table);
 void
 put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table)
 {
@@ -433,6 +435,7 @@ Lisp_Object Qnarrow;
 Lisp_Object Qsmall;
 Lisp_Object Qfont;
 
+Emchar to_char_code (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
 Emchar
 to_char_code (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
 {
@@ -550,6 +553,8 @@ Return the value of CHARACTER's ATTRIBUTE.
   return Fcdr (Fassq (attribute, ret));
 }
 
+Lisp_Object put_char_attribute (Lisp_Object character,
+                               Lisp_Object attribute, Lisp_Object value);
 Lisp_Object
 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
                    Lisp_Object value)
@@ -573,6 +578,8 @@ put_char_attribute (Lisp_Object character, Lisp_Object attribute,
   return ret;
 }
 
+Lisp_Object remove_char_attribute (Lisp_Object character,
+                                  Lisp_Object attribute);
 Lisp_Object
 remove_char_attribute (Lisp_Object character, Lisp_Object attribute)
 {
@@ -647,7 +654,7 @@ Store CHARACTER's ATTRIBUTE with VALUE.
              rest = Fcdr (value);
              while (!NILP (rest))
                {
-                 int i;
+                 int j;
 
                  if (!CONSP (rest))
                    signal_simple_error ("Invalid value for coded-charset",
@@ -656,10 +663,10 @@ Store CHARACTER's ATTRIBUTE with VALUE.
                  if (!INTP (ret))
                    signal_simple_error ("Invalid value for coded-charset",
                                         value);
-                 i = XINT (ret);
+                 j = XINT (ret);
                  if (XCHARSET_GRAPHIC (ccs) == 1)
-                   i &= 0x7F;
-                 code_point = (code_point << 8) | i;
+                   j &= 0x7F;
+                 code_point = (code_point << 8) | j;
                  rest = Fcdr (rest);
                }
              value = make_int (code_point);
@@ -725,35 +732,56 @@ Store CHARACTER's ATTRIBUTE with VALUE.
     }
   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;
            }
        }
     }
@@ -935,6 +963,7 @@ Lisp_Object Qascii,
 #ifdef UTF2000
   Qucs_bmp,
   Qlatin_viscii,
+  Qlatin_tcvn5712,
   Qlatin_viscii_lower,
   Qlatin_viscii_upper,
   Qvietnamese_viscii_lower,
@@ -1338,7 +1367,7 @@ Lstream_funget_emchar (Lstream *stream, Emchar ch)
 static Lisp_Object
 mark_charset (Lisp_Object obj)
 {
-  struct Lisp_Charset *cs = XCHARSET (obj);
+  Lisp_Charset *cs = XCHARSET (obj);
 
   mark_object (cs->short_name);
   mark_object (cs->long_name);
@@ -1354,7 +1383,7 @@ mark_charset (Lisp_Object obj)
 static void
 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
-  struct Lisp_Charset *cs = XCHARSET (obj);
+  Lisp_Charset *cs = XCHARSET (obj);
   char buf[200];
 
   if (print_readably)
@@ -1384,9 +1413,15 @@ print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 }
 
 static const struct lrecord_description charset_description[] = {
-  { XD_LISP_OBJECT, offsetof(struct Lisp_Charset, name), 7 },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, name) },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, registry) },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) },
 #ifdef UTF2000
-  { XD_LISP_OBJECT, offsetof(struct Lisp_Charset, decoding_table), 2 },
+  { XD_LISP_OBJECT, offsetof (Lisp_Charset, decoding_table) },
 #endif
   { XD_END }
 };
@@ -1394,7 +1429,7 @@ static const struct lrecord_description charset_description[] = {
 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
                                mark_charset, print_charset, 0, 0, 0,
                               charset_description,
-                              struct Lisp_Charset);
+                              Lisp_Charset);
 /* Make a new charset. */
 
 static Lisp_Object
@@ -1410,8 +1445,10 @@ make_charset (Charset_ID id, Lisp_Object name,
 {
   unsigned char type = 0;
   Lisp_Object obj;
-  struct Lisp_Charset *cs =
-    alloc_lcrecord_type (struct Lisp_Charset, &lrecord_charset);
+  Lisp_Charset *cs = alloc_lcrecord_type (Lisp_Charset, &lrecord_charset);
+
+  zero_lcrecord (cs);
+
   XSETCHARSET (obj, cs);
 
   CHARSET_ID           (cs) = id;
@@ -1755,11 +1792,18 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
       *charset = Vcharset_ucs;
       return c;
     }
+  /*
   else if (c <= MAX_CHAR_DAIKANWA)
     {
       *charset = Vcharset_ideograph_daikanwa;
       return c - MIN_CHAR_DAIKANWA;
     }
+  */
+  else if (c <= MAX_CHAR_MOJIKYO)
+    {
+      *charset = Vcharset_mojikyo;
+      return c - MIN_CHAR_MOJIKYO;
+    }
   else if (c < MIN_CHAR_94)
     {
       *charset = Vcharset_ucs;
@@ -2135,7 +2179,7 @@ NEW-NAME is the name of the new charset.  Return the new charset.
   int id, chars, dimension, columns, graphic, final;
   int direction;
   Lisp_Object registry, doc_string, short_name, long_name;
-  struct Lisp_Charset *cs;
+  Lisp_Charset *cs;
 
   charset = Fget_charset (charset);
   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
@@ -2304,7 +2348,7 @@ Recognized properties are those listed in `make-charset', as well as
 */
        (charset, prop))
 {
-  struct Lisp_Charset *cs;
+  Lisp_Charset *cs;
 
   charset = Fget_charset (charset);
   cs = XCHARSET (charset);
@@ -2510,7 +2554,7 @@ character s with caron.
 */
        (charset, arg1, arg2))
 {
-  struct Lisp_Charset *cs;
+  Lisp_Charset *cs;
   int a1, a2;
   int lowlim, highlim;
 
@@ -2822,6 +2866,7 @@ 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");
@@ -2901,7 +2946,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.
 */ );
@@ -3174,6 +3219,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,