(GT-K02180): New character.
[chise/xemacs-chise.git-] / src / chartab.c
index 381eb53..0e33354 100644 (file)
@@ -4,7 +4,7 @@
    Copyright (C) 1995, 1996 Ben Wing.
    Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
    Licensed to the Free Software Foundation.
-   Copyright (C) 1999,2000,2001,2002 MORIOKA Tomohiko
+   Copyright (C) 1999,2000,2001,2002,2003 MORIOKA Tomohiko
 
 This file is part of XEmacs.
 
@@ -65,6 +65,9 @@ Lisp_Object Vword_combining_categories, Vword_separating_categories;
 \f
 #ifdef UTF2000
 
+EXFUN (Fchar_refs_simplify_char_specs, 1);
+extern Lisp_Object Qideographic_structure;
+
 EXFUN (Fmap_char_attribute, 3);
 
 #if defined(HAVE_CHISE_CLIENT)
@@ -319,7 +322,8 @@ map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
 static void
 save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
                       Lisp_Object db,
-                      Emchar ofs, int place)
+                      Emchar ofs, int place,
+                      Lisp_Object (*filter)(Lisp_Object value))
 {
   struct chartab_range rainj;
   int i, retval;
@@ -630,7 +634,8 @@ map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
 static void
 save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
                        Lisp_Object db,
-                       Emchar ofs, int place)
+                       Emchar ofs, int place,
+                       Lisp_Object (*filter)(Lisp_Object value))
 {
   struct chartab_range rainj;
   int i, retval;
@@ -890,7 +895,8 @@ map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
 static void
 save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
                 Lisp_Object db,
-                Emchar ofs, int place)
+                Emchar ofs, int place,
+                Lisp_Object (*filter)(Lisp_Object value))
 {
   int i, retval;
   Lisp_Object v;
@@ -903,19 +909,19 @@ save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
       if (UINT8_BYTE_TABLE_P (v))
        {
          save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root, db,
-                                c, place - 1);
+                                c, place - 1, filter);
          c += unit;
        }
       else if (UINT16_BYTE_TABLE_P (v))
        {
          save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root, db,
-                                 c, place - 1);
+                                 c, place - 1, filter);
          c += unit;
        }
       else if (BYTE_TABLE_P (v))
        {
          save_byte_table (XBYTE_TABLE(v), root, db,
-                          c, place - 1);
+                          c, place - 1, filter);
          c += unit;
        }
       else if (EQ (v, Qunloaded))
@@ -927,6 +933,9 @@ save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
          struct chartab_range rainj;
          Emchar c1 = c + unit;
 
+         if (filter != NULL)
+           v = (*filter)(v);
+
          rainj.type = CHARTAB_RANGE_CHAR;
 
          for (; c < c1 && retval == 0; c++)
@@ -3153,86 +3162,93 @@ Return DEFAULT-VALUE if the value is not exist.
   return default_value;
 }
 
-DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
-Store CHARACTER's ATTRIBUTE with VALUE.
-*/
-       (character, attribute, value))
+void put_char_composition (Lisp_Object character, Lisp_Object value);
+void
+put_char_composition (Lisp_Object character, Lisp_Object value)
 {
-  Lisp_Object ccs = Ffind_charset (attribute);
+  if (!CONSP (value))
+    signal_simple_error ("Invalid value for ->decomposition",
+                        value);
 
-  if (!NILP (ccs))
+  if (CONSP (Fcdr (value)))
     {
-      CHECK_CHAR (character);
-      value = put_char_ccs_code_point (character, ccs, value);
-    }
-  else if (EQ (attribute, Q_decomposition))
-    {
-      CHECK_CHAR (character);
-      if (!CONSP (value))
-       signal_simple_error ("Invalid value for ->decomposition",
-                            value);
-
-      if (CONSP (Fcdr (value)))
+      if (NILP (Fcdr (Fcdr (value))))
        {
-         if (NILP (Fcdr (Fcdr (value))))
-           {
-             Lisp_Object base = Fcar (value);
-             Lisp_Object modifier = Fcar (Fcdr (value));
+         Lisp_Object base = Fcar (value);
+         Lisp_Object modifier = Fcar (Fcdr (value));
 
-             if (INTP (base))
-               {
-                 base = make_char (XINT (base));
-                 Fsetcar (value, base);
-               }
-             if (INTP (modifier))
-               {
-                 modifier = make_char (XINT (modifier));
-                 Fsetcar (Fcdr (value), modifier);
-               }
-             if (CHARP (base))
-               {
-                 Lisp_Object alist = Fget_char_attribute (base, Qcomposition, Qnil);
-                 Lisp_Object ret = Fassq (modifier, alist);
-
-                 if (NILP (ret))
-                   Fput_char_attribute (base, Qcomposition,
-                                        Fcons (Fcons (modifier, character), alist));
-                 else
-                   Fsetcdr (ret, character);
-               }
+         if (INTP (base))
+           {
+             base = make_char (XINT (base));
+             Fsetcar (value, base);
+           }
+         if (INTP (modifier))
+           {
+             modifier = make_char (XINT (modifier));
+             Fsetcar (Fcdr (value), modifier);
+           }
+         if (CHARP (base))
+           {
+             Lisp_Object alist
+               = Fget_char_attribute (base, Qcomposition, Qnil);
+             Lisp_Object ret = Fassq (modifier, alist);
+
+             if (NILP (ret))
+               Fput_char_attribute (base, Qcomposition,
+                                    Fcons (Fcons (modifier, character),
+                                           alist));
+             else
+               Fsetcdr (ret, character);
            }
        }
-      else
+    }
+  else
+    {
+      Lisp_Object v = Fcar (value);
+
+      if (INTP (v))
        {
-         Lisp_Object v = Fcar (value);
+         Emchar c = XINT (v);
+         Lisp_Object ret
+           = Fget_char_attribute (make_char (c), Q_ucs_variants, Qnil);
 
-         if (INTP (v))
+         if (!CONSP (ret))
            {
-             Emchar c = XINT (v);
-             Lisp_Object ret
-               = Fget_char_attribute (make_char (c), Q_ucs_variants, Qnil);
-
-             if (!CONSP (ret))
-               {
-                 Fput_char_attribute (make_char (c), Q_ucs_variants,
-                                      Fcons (character, Qnil));
-               }
-             else if (NILP (Fmemq (character, ret)))
-               {
-                 Fput_char_attribute (make_char (c), Q_ucs_variants,
-                                      Fcons (character, ret));
-               }
+             Fput_char_attribute (make_char (c), Q_ucs_variants,
+                                  Fcons (character, Qnil));
+           }
+         else if (NILP (Fmemq (character, ret)))
+           {
+             Fput_char_attribute (make_char (c), Q_ucs_variants,
+                                  Fcons (character, ret));
            }
        }
     }
+}
+
+DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
+Store CHARACTER's ATTRIBUTE with VALUE.
+*/
+       (character, attribute, value))
+{
+  Lisp_Object ccs = Ffind_charset (attribute);
+
+  CHECK_CHAR (character);
+
+  if (!NILP (ccs))
+    {
+      value = put_char_ccs_code_point (character, ccs, value);
+      attribute = XCHARSET_NAME (ccs);
+    }
+  else if (EQ (attribute, Q_decomposition))
+    put_char_composition (character, value);
   else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
     {
       Lisp_Object ret;
       Emchar c;
 
-      CHECK_CHAR (character);
       if (!INTP (value))
-       signal_simple_error ("Invalid value for ->ucs", value);
+       signal_simple_error ("Invalid value for =>ucs", value);
 
       c = XINT (value);
 
@@ -3252,6 +3268,10 @@ Store CHARACTER's ATTRIBUTE with VALUE.
        attribute = Qto_ucs;
 #endif
     }
+#if 0
+  else if (EQ (attribute, Qideographic_structure))
+    value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
+#endif
   {
     Lisp_Object table = Fgethash (attribute,
                                  Vchar_attribute_hash_table,
@@ -3371,12 +3391,21 @@ Save values of ATTRIBUTE into database file.
   db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
   if (!NILP (db))
     {
+      Lisp_Object (*filter)(Lisp_Object value);
+
+      if (EQ (attribute, Qideographic_structure))
+       filter = &Fchar_refs_simplify_char_specs;
+      else
+       filter = NULL;
+
       if (UINT8_BYTE_TABLE_P (ct->table))
-       save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, db, 0, 3);
+       save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, db,
+                              0, 3, filter);
       else if (UINT16_BYTE_TABLE_P (ct->table))
-       save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, db, 0, 3);
+       save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, db,
+                               0, 3, filter);
       else if (BYTE_TABLE_P (ct->table))
-       save_byte_table (XBYTE_TABLE(ct->table), ct, db, 0, 3);
+       save_byte_table (XBYTE_TABLE(ct->table), ct, db, 0, 3, filter);
       Fclose_database (db);
       return Qt;
     }