+ cte = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table);
+
+ cte->table = make_byte_table (initval);
+
+ XSETCHAR_ID_TABLE (obj, cte);
+ return obj;
+}
+
+
+Lisp_Object
+get_char_id_table (Emchar ch, Lisp_Object table)
+{
+ unsigned int code = ch;
+
+ return
+ get_byte_table
+ (get_byte_table
+ (get_byte_table
+ (get_byte_table
+ (XCHAR_ID_TABLE (table)->table,
+ (unsigned char)(code >> 24)),
+ (unsigned char) (code >> 16)),
+ (unsigned char) (code >> 8)),
+ (unsigned char) code);
+}
+
+void put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table);
+void
+put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table)
+{
+ unsigned int code = ch;
+ Lisp_Object table1, table2, table3, table4;
+
+ table1 = XCHAR_ID_TABLE (table)->table;
+ table2 = get_byte_table (table1, (unsigned char)(code >> 24));
+ table3 = get_byte_table (table2, (unsigned char)(code >> 16));
+ table4 = get_byte_table (table3, (unsigned char)(code >> 8));
+
+ table4 = put_byte_table (table4, (unsigned char)code, value);
+ table3 = put_byte_table (table3, (unsigned char)(code >> 8), table4);
+ table2 = put_byte_table (table2, (unsigned char)(code >> 16), table3);
+ XCHAR_ID_TABLE (table)->table
+ = put_byte_table (table1, (unsigned char)(code >> 24), table2);
+}
+
+
+Lisp_Object Vchar_attribute_hash_table;
+Lisp_Object Vcharacter_composition_table;
+Lisp_Object Vcharacter_variant_table;
+
+Lisp_Object Qideograph_daikanwa;
+Lisp_Object Q_decomposition;
+Lisp_Object Qucs;
+Lisp_Object Q_ucs;
+Lisp_Object Qcompat;
+Lisp_Object Qisolated;
+Lisp_Object Qinitial;
+Lisp_Object Qmedial;
+Lisp_Object Qfinal;
+Lisp_Object Qvertical;
+Lisp_Object QnoBreak;
+Lisp_Object Qfraction;
+Lisp_Object Qsuper;
+Lisp_Object Qsub;
+Lisp_Object Qcircle;
+Lisp_Object Qsquare;
+Lisp_Object Qwide;
+Lisp_Object Qnarrow;
+Lisp_Object Qsmall;
+Lisp_Object Qfont;
+
+Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
+
+Lisp_Object put_char_ccs_code_point (Lisp_Object character,
+ Lisp_Object ccs, Lisp_Object value);
+Lisp_Object remove_char_ccs (Lisp_Object character, Lisp_Object ccs);
+
+Emchar
+to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
+{
+ if (INTP (v))
+ return XINT (v);
+ if (CHARP (v))
+ return XCHAR (v);
+ else if (EQ (v, Qcompat))
+ return -1;
+ else if (EQ (v, Qisolated))
+ return -2;
+ else if (EQ (v, Qinitial))
+ return -3;
+ else if (EQ (v, Qmedial))
+ return -4;
+ else if (EQ (v, Qfinal))
+ return -5;
+ else if (EQ (v, Qvertical))
+ return -6;
+ else if (EQ (v, QnoBreak))
+ return -7;
+ else if (EQ (v, Qfraction))
+ return -8;
+ else if (EQ (v, Qsuper))
+ return -9;
+ else if (EQ (v, Qsub))
+ return -10;
+ else if (EQ (v, Qcircle))
+ return -11;
+ else if (EQ (v, Qsquare))
+ return -12;
+ else if (EQ (v, Qwide))
+ return -13;
+ else if (EQ (v, Qnarrow))
+ return -14;
+ else if (EQ (v, Qsmall))
+ return -15;
+ else if (EQ (v, Qfont))
+ return -16;
+ else
+ signal_simple_error (err_msg, err_arg);
+}
+
+DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
+Return character corresponding with list.
+*/
+ (list))
+{
+ Lisp_Object table = Vcharacter_composition_table;
+ Lisp_Object rest = list;
+
+ while (CONSP (rest))
+ {
+ Lisp_Object v = Fcar (rest);
+ Lisp_Object ret;
+ Emchar c = to_char_id (v, "Invalid value for composition", list);
+
+ ret = get_char_id_table (c, table);
+
+ rest = Fcdr (rest);
+ if (NILP (rest))
+ {
+ if (!CHAR_ID_TABLE_P (ret))
+ return ret;
+ else
+ return Qt;
+ }
+ else if (!CONSP (rest))
+ break;
+ else if (CHAR_ID_TABLE_P (ret))
+ table = ret;
+ else
+ signal_simple_error ("Invalid table is found with", list);
+ }
+ signal_simple_error ("Invalid value for composition", list);
+}
+
+DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
+Return variants of CHARACTER.
+*/
+ (character))
+{
+ CHECK_CHAR (character);
+ return Fcopy_list (get_char_id_table (XCHAR (character),
+ Vcharacter_variant_table));
+}
+
+
+/* We store the char-attributes in hash tables with the names as the
+ key and the actual char-id-table object as the value. Occasionally
+ we need to use them in a list format. These routines provide us
+ with that. */
+struct char_attribute_list_closure
+{
+ Lisp_Object *char_attribute_list;
+};
+
+static int
+add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
+ void *char_attribute_list_closure)
+{
+ /* This function can GC */
+ struct char_attribute_list_closure *calcl
+ = (struct char_attribute_list_closure*) char_attribute_list_closure;
+ Lisp_Object *char_attribute_list = calcl->char_attribute_list;
+
+ *char_attribute_list = Fcons (key, *char_attribute_list);
+ return 0;
+}
+
+DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
+Return the list of all existing character attributes except coded-charsets.
+*/
+ ())
+{
+ Lisp_Object char_attribute_list = Qnil;
+ struct gcpro gcpro1;
+ struct char_attribute_list_closure char_attribute_list_closure;
+
+ GCPRO1 (char_attribute_list);
+ char_attribute_list_closure.char_attribute_list = &char_attribute_list;
+ elisp_maphash (add_char_attribute_to_list_mapper,
+ Vchar_attribute_hash_table,
+ &char_attribute_list_closure);
+ UNGCPRO;
+ return char_attribute_list;