+#endif
+
+#ifdef UTF2000
+
+#define BT_UINT8_MIN 0
+#define BT_UINT8_MAX (UCHAR_MAX - 3)
+#define BT_UINT8_t (UCHAR_MAX - 2)
+#define BT_UINT8_nil (UCHAR_MAX - 1)
+#define BT_UINT8_unbound UCHAR_MAX
+
+INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
+INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
+INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
+INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
+INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
+
+INLINE_HEADER int
+INT_UINT8_P (Lisp_Object obj)
+{
+ if (INTP (obj))
+ {
+ int num = XINT (obj);
+
+ return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
+ }
+ else
+ return 0;
+}
+
+INLINE_HEADER int
+UINT8_VALUE_P (Lisp_Object obj)
+{
+ return EQ (obj, Qunbound)
+ || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
+}
+
+INLINE_HEADER unsigned char
+UINT8_ENCODE (Lisp_Object obj)
+{
+ if (EQ (obj, Qunbound))
+ return BT_UINT8_unbound;
+ else if (EQ (obj, Qnil))
+ return BT_UINT8_nil;
+ else if (EQ (obj, Qt))
+ return BT_UINT8_t;
+ else
+ return XINT (obj);
+}
+
+INLINE_HEADER Lisp_Object
+UINT8_DECODE (unsigned char n)
+{
+ if (n == BT_UINT8_unbound)
+ return Qunbound;
+ else if (n == BT_UINT8_nil)
+ return Qnil;
+ else if (n == BT_UINT8_t)
+ return Qt;
+ else
+ return make_int (n);
+}
+
+static Lisp_Object
+mark_uint8_byte_table (Lisp_Object obj)
+{
+ return Qnil;
+}
+
+static void
+print_uint8_byte_table (Lisp_Object obj,
+ Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
+ int i;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (obj, printcharfun);
+
+ write_c_string ("\n#<uint8-byte-table", printcharfun);
+ for (i = 0; i < 256; i++)
+ {
+ unsigned char n = bte->property[i];
+ if ( (i & 15) == 0 )
+ write_c_string ("\n ", printcharfun);
+ write_c_string (" ", printcharfun);
+ if (n == BT_UINT8_unbound)
+ write_c_string ("void", printcharfun);
+ else if (n == BT_UINT8_nil)
+ write_c_string ("nil", printcharfun);
+ else if (n == BT_UINT8_t)
+ write_c_string ("t", printcharfun);
+ else
+ {
+ char buf[4];
+
+ sprintf (buf, "%hd", n);
+ write_c_string (buf, printcharfun);
+ }
+ }
+ UNGCPRO;
+ write_c_string (">", printcharfun);
+}
+
+static int
+uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+ Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
+ Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ if (te1->property[i] != te2->property[i])
+ return 0;
+ return 1;
+}
+
+static unsigned long
+uint8_byte_table_hash (Lisp_Object obj, int depth)
+{
+ Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
+ int i;
+ hashcode_t hash = 0;
+
+ for (i = 0; i < 256; i++)
+ hash = HASH2 (hash, te->property[i]);
+ return hash;
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
+ mark_uint8_byte_table,
+ print_uint8_byte_table,
+ 0, uint8_byte_table_equal,
+ uint8_byte_table_hash,
+ 0 /* uint8_byte_table_description */,
+ Lisp_Uint8_Byte_Table);
+
+static Lisp_Object
+make_uint8_byte_table (unsigned char initval)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint8_Byte_Table *cte;
+
+ cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
+ &lrecord_uint8_byte_table);
+
+ for (i = 0; i < 256; i++)
+ cte->property[i] = initval;
+
+ XSETUINT8_BYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static int
+uint8_byte_table_same_value_p (Lisp_Object obj)
+{
+ Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
+ unsigned char v0 = bte->property[0];
+ int i;
+
+ for (i = 1; i < 256; i++)
+ {
+ if (bte->property[i] != v0)
+ return 0;
+ }
+ return -1;
+}
+
+
+#define BT_UINT16_MIN 0
+#define BT_UINT16_MAX (USHRT_MAX - 3)
+#define BT_UINT16_t (USHRT_MAX - 2)
+#define BT_UINT16_nil (USHRT_MAX - 1)
+#define BT_UINT16_unbound USHRT_MAX
+
+INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
+INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
+INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
+INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
+
+INLINE_HEADER int
+INT_UINT16_P (Lisp_Object obj)
+{
+ if (INTP (obj))
+ {
+ int num = XINT (obj);
+
+ return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
+ }
+ else
+ return 0;
+}
+
+INLINE_HEADER int
+UINT16_VALUE_P (Lisp_Object obj)
+{
+ return EQ (obj, Qunbound)
+ || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
+}
+
+INLINE_HEADER unsigned short
+UINT16_ENCODE (Lisp_Object obj)
+{
+ if (EQ (obj, Qunbound))
+ return BT_UINT16_unbound;
+ else if (EQ (obj, Qnil))
+ return BT_UINT16_nil;
+ else if (EQ (obj, Qt))
+ return BT_UINT16_t;
+ else
+ return XINT (obj);
+}
+
+INLINE_HEADER Lisp_Object
+UINT16_DECODE (unsigned short n)
+{
+ if (n == BT_UINT16_unbound)
+ return Qunbound;
+ else if (n == BT_UINT16_nil)
+ return Qnil;
+ else if (n == BT_UINT16_t)
+ return Qt;
+ else
+ return make_int (n);
+}
+
+INLINE_HEADER unsigned short
+UINT8_TO_UINT16 (unsigned char n)
+{
+ if (n == BT_UINT8_unbound)
+ return BT_UINT16_unbound;
+ else if (n == BT_UINT8_nil)
+ return BT_UINT16_nil;
+ else if (n == BT_UINT8_t)
+ return BT_UINT16_t;
+ else
+ return n;
+}
+
+static Lisp_Object
+mark_uint16_byte_table (Lisp_Object obj)
+{
+ return Qnil;
+}
+
+static void
+print_uint16_byte_table (Lisp_Object obj,
+ Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
+ int i;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (obj, printcharfun);
+
+ write_c_string ("\n#<uint16-byte-table", printcharfun);
+ for (i = 0; i < 256; i++)
+ {
+ unsigned short n = bte->property[i];
+ if ( (i & 15) == 0 )
+ write_c_string ("\n ", printcharfun);
+ write_c_string (" ", printcharfun);
+ if (n == BT_UINT16_unbound)
+ write_c_string ("void", printcharfun);
+ else if (n == BT_UINT16_nil)
+ write_c_string ("nil", printcharfun);
+ else if (n == BT_UINT16_t)
+ write_c_string ("t", printcharfun);
+ else
+ {
+ char buf[7];
+
+ sprintf (buf, "%hd", n);
+ write_c_string (buf, printcharfun);
+ }
+ }
+ UNGCPRO;
+ write_c_string (">", printcharfun);
+}
+
+static int
+uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+ Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
+ Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ if (te1->property[i] != te2->property[i])
+ return 0;
+ return 1;
+}
+
+static unsigned long
+uint16_byte_table_hash (Lisp_Object obj, int depth)
+{
+ Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
+ int i;
+ hashcode_t hash = 0;
+
+ for (i = 0; i < 256; i++)
+ hash = HASH2 (hash, te->property[i]);
+ return hash;
+}
+
+DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
+ mark_uint16_byte_table,
+ print_uint16_byte_table,
+ 0, uint16_byte_table_equal,
+ uint16_byte_table_hash,
+ 0 /* uint16_byte_table_description */,
+ Lisp_Uint16_Byte_Table);
+
+static Lisp_Object
+make_uint16_byte_table (unsigned short initval)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint16_Byte_Table *cte;
+
+ cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
+ &lrecord_uint16_byte_table);
+
+ for (i = 0; i < 256; i++)
+ cte->property[i] = initval;
+
+ XSETUINT16_BYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static Lisp_Object
+expand_uint8_byte_table_to_uint16 (Lisp_Object table)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
+ Lisp_Uint16_Byte_Table* cte;
+
+ cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
+ &lrecord_uint16_byte_table);
+ for (i = 0; i < 256; i++)
+ {
+ cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
+ }
+ XSETUINT16_BYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static int
+uint16_byte_table_same_value_p (Lisp_Object obj)
+{
+ Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
+ unsigned short v0 = bte->property[0];
+ int i;
+
+ for (i = 1; i < 256; i++)
+ {
+ if (bte->property[i] != v0)
+ return 0;
+ }
+ return -1;
+}
+
+
+static Lisp_Object
+mark_byte_table (Lisp_Object obj)
+{
+ Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ mark_object (cte->property[i]);
+ }
+ return Qnil;
+}
+
+static void
+print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
+ int i;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (obj, printcharfun);
+
+ write_c_string ("\n#<byte-table", printcharfun);
+ for (i = 0; i < 256; i++)
+ {
+ Lisp_Object elt = bte->property[i];
+ if ( (i & 15) == 0 )
+ write_c_string ("\n ", printcharfun);
+ write_c_string (" ", printcharfun);
+ if (EQ (elt, Qunbound))
+ write_c_string ("void", printcharfun);
+ else
+ print_internal (elt, printcharfun, escapeflag);
+ }
+ UNGCPRO;
+ write_c_string (">", printcharfun);
+}
+
+static int
+byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+ Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
+ Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ if (BYTE_TABLE_P (cte1->property[i]))
+ {
+ if (BYTE_TABLE_P (cte2->property[i]))
+ {
+ if (!byte_table_equal (cte1->property[i],
+ cte2->property[i], depth + 1))
+ return 0;
+ }
+ else
+ return 0;
+ }
+ else
+ if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
+ return 0;
+ return 1;
+}
+
+static unsigned long
+byte_table_hash (Lisp_Object obj, int depth)
+{
+ Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
+
+ return internal_array_hash (cte->property, 256, depth);
+}
+
+static const struct lrecord_description byte_table_description[] = {
+ { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
+ mark_byte_table,
+ print_byte_table,
+ 0, byte_table_equal,
+ byte_table_hash,
+ byte_table_description,
+ Lisp_Byte_Table);
+
+static Lisp_Object
+make_byte_table (Lisp_Object initval)
+{
+ Lisp_Object obj;
+ int i;
+ Lisp_Byte_Table *cte;
+
+ cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
+
+ for (i = 0; i < 256; i++)
+ cte->property[i] = initval;
+
+ XSETBYTE_TABLE (obj, cte);
+ return obj;
+}
+
+static int
+byte_table_same_value_p (Lisp_Object obj)
+{
+ Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
+ Lisp_Object v0 = bte->property[0];
+ int i;
+
+ for (i = 1; i < 256; i++)
+ {
+ if (!internal_equal (bte->property[i], v0, 0))
+ return 0;
+ }
+ return -1;
+}
+
+
+Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx);
+Lisp_Object put_byte_table (Lisp_Object table, unsigned char idx,
+ Lisp_Object value);
+
+Lisp_Object
+get_byte_table (Lisp_Object table, unsigned char idx)
+{
+ if (UINT8_BYTE_TABLE_P (table))
+ return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
+ else if (UINT16_BYTE_TABLE_P (table))
+ return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
+ else if (BYTE_TABLE_P (table))
+ return XBYTE_TABLE(table)->property[idx];
+ else
+ return table;
+}
+
+Lisp_Object
+put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
+{
+ if (UINT8_BYTE_TABLE_P (table))
+ {
+ if (UINT8_VALUE_P (value))
+ {
+ XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
+ if (!UINT8_BYTE_TABLE_P (value) &&
+ !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
+ && uint8_byte_table_same_value_p (table))
+ {
+ return value;
+ }
+ }
+ else if (UINT16_VALUE_P (value))
+ {
+ Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
+
+ XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
+ return new;
+ }
+ else
+ {
+ Lisp_Object new = make_byte_table (Qnil);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ XBYTE_TABLE(new)->property[i]
+ = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
+ }
+ XBYTE_TABLE(new)->property[idx] = value;
+ return new;
+ }
+ }
+ else if (UINT16_BYTE_TABLE_P (table))
+ {
+ if (UINT16_VALUE_P (value))
+ {
+ XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
+ if (!UINT8_BYTE_TABLE_P (value) &&
+ !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
+ && uint16_byte_table_same_value_p (table))
+ {
+ return value;
+ }
+ }
+ else
+ {
+ Lisp_Object new = make_byte_table (Qnil);
+ int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ XBYTE_TABLE(new)->property[i]
+ = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
+ }
+ XBYTE_TABLE(new)->property[idx] = value;
+ return new;
+ }
+ }
+ else if (BYTE_TABLE_P (table))
+ {
+ XBYTE_TABLE(table)->property[idx] = value;
+ if (!UINT8_BYTE_TABLE_P (value) &&
+ !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
+ && byte_table_same_value_p (table))
+ {
+ return value;
+ }
+ }
+ else if (!internal_equal (table, value, 0))
+ {
+ if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
+ {
+ table = make_uint8_byte_table (UINT8_ENCODE (table));
+ XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
+ }
+ else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
+ {
+ table = make_uint16_byte_table (UINT16_ENCODE (table));
+ XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
+ }
+ else
+ {
+ table = make_byte_table (table);
+ XBYTE_TABLE(table)->property[idx] = value;
+ }
+ }
+ return table;
+}
+
+static Lisp_Object
+mark_char_id_table (Lisp_Object obj)
+{
+ Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj);
+
+ return cte->table;
+}
+
+static void
+print_char_id_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_Object table = XCHAR_ID_TABLE (obj)->table;
+ int i;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (obj, printcharfun);
+
+ write_c_string ("#<char-id-table ", printcharfun);
+ for (i = 0; i < 256; i++)
+ {
+ Lisp_Object elt = get_byte_table (table, i);
+ if (i != 0) write_c_string ("\n ", printcharfun);
+ if (EQ (elt, Qunbound))
+ write_c_string ("void", printcharfun);
+ else
+ print_internal (elt, printcharfun, escapeflag);
+ }
+ UNGCPRO;
+ write_c_string (">", printcharfun);
+}
+
+static int
+char_id_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+ Lisp_Object table1 = XCHAR_ID_TABLE (obj1)->table;
+ Lisp_Object table2 = XCHAR_ID_TABLE (obj2)->table;
+ int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ if (!internal_equal (get_byte_table (table1, i),
+ get_byte_table (table2, i), 0))
+ return 0;
+ }
+ return -1;
+}
+
+static unsigned long
+char_id_table_hash (Lisp_Object obj, int depth)
+{
+ Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj);
+
+ return char_id_table_hash (cte->table, depth + 1);
+}
+
+static const struct lrecord_description char_id_table_description[] = {
+ { XD_LISP_OBJECT, offsetof(Lisp_Char_ID_Table, table) },
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("char-id-table", char_id_table,
+ mark_char_id_table,
+ print_char_id_table,
+ 0, char_id_table_equal,
+ char_id_table_hash,
+ char_id_table_description,
+ Lisp_Char_ID_Table);
+
+static Lisp_Object
+make_char_id_table (Lisp_Object initval)
+{
+ Lisp_Object obj;
+ Lisp_Char_ID_Table *cte;
+
+ 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;
+}
+
+DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
+Return char-id-table corresponding to ATTRIBUTE.
+*/
+ (attribute))
+{
+ return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
+}
+
+
+/* We store the char-id-tables in hash tables with the attributes as
+ the key and the actual char-id-table object as the value. Each
+ char-id-table stores values of an attribute corresponding with
+ characters. Occasionally we need to get attributes of a character
+ in a association-list format. These routines provide us with
+ that. */
+struct char_attribute_alist_closure
+{
+ Emchar char_id;
+ Lisp_Object *char_attribute_alist;
+};
+
+static int
+add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
+ void *char_attribute_alist_closure)
+{
+ /* This function can GC */
+ struct char_attribute_alist_closure *caacl =
+ (struct char_attribute_alist_closure*) char_attribute_alist_closure;
+ Lisp_Object ret = get_char_id_table (caacl->char_id, value);
+ if (!UNBOUNDP (ret))
+ {
+ Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
+ *char_attribute_alist
+ = Fcons (Fcons (key, ret), *char_attribute_alist);
+ }
+ return 0;
+}
+
+DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
+Return the alist of attributes of CHARACTER.
+*/
+ (character))
+{
+ Lisp_Object alist = Qnil;
+ int i;
+
+ CHECK_CHAR (character);
+ {
+ struct gcpro gcpro1;
+ struct char_attribute_alist_closure char_attribute_alist_closure;
+
+ GCPRO1 (alist);
+ char_attribute_alist_closure.char_id = XCHAR (character);
+ char_attribute_alist_closure.char_attribute_alist = &alist;
+ elisp_maphash (add_char_attribute_alist_mapper,
+ Vchar_attribute_hash_table,
+ &char_attribute_alist_closure);
+ UNGCPRO;
+ }
+
+ for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
+ {
+ Lisp_Object ccs = chlook->charset_by_leading_byte[i];
+
+ if (!NILP (ccs))
+ {
+ Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
+ Lisp_Object cpos;
+
+ if ( CHAR_ID_TABLE_P (encoding_table)
+ && INTP (cpos = get_char_id_table (XCHAR (character),
+ encoding_table)) )
+ {
+ alist = Fcons (Fcons (ccs, cpos), alist);
+ }
+ }
+ }
+ return alist;
+}
+
+DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
+Return the value of CHARACTER's ATTRIBUTE.
+Return DEFAULT-VALUE if the value is not exist.
+*/
+ (character, attribute, default_value))
+{
+ Lisp_Object ccs;
+
+ CHECK_CHAR (character);
+ if (!NILP (ccs = Ffind_charset (attribute)))
+ {
+ Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
+
+ if (CHAR_ID_TABLE_P (encoding_table))
+ return get_char_id_table (XCHAR (character), encoding_table);
+ }
+ else
+ {
+ Lisp_Object table = Fgethash (attribute,
+ Vchar_attribute_hash_table,
+ Qunbound);
+ if (!UNBOUNDP (table))
+ {
+ Lisp_Object ret = get_char_id_table (XCHAR (character), table);
+ if (!UNBOUNDP (ret))
+ return ret;
+ }
+ }
+ return default_value;
+}
+
+DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
+Store CHARACTER's ATTRIBUTE with VALUE.
+*/
+ (character, attribute, value))
+{
+ Lisp_Object ccs;
+
+ CHECK_CHAR (character);
+ ccs = Ffind_charset (attribute);
+ if (!NILP (ccs))
+ {
+ return put_char_ccs_code_point (character, ccs, value);
+ }
+ else if (EQ (attribute, Q_decomposition))
+ {
+ Lisp_Object seq;
+
+ if (!CONSP (value))
+ signal_simple_error ("Invalid value for ->decomposition",
+ value);
+
+ if (CONSP (Fcdr (value)))
+ {
+ Lisp_Object rest = value;
+ Lisp_Object table = Vcharacter_composition_table;
+ size_t len;
+ int i = 0;
+
+ GET_EXTERNAL_LIST_LENGTH (rest, len);
+ seq = make_vector (len, Qnil);
+
+ while (CONSP (rest))
+ {
+ Lisp_Object v = Fcar (rest);
+ Lisp_Object ntable;
+ Emchar c
+ = to_char_id (v, "Invalid value for ->decomposition", value);
+
+ if (c < 0)
+ XVECTOR_DATA(seq)[i++] = v;
+ else
+ XVECTOR_DATA(seq)[i++] = make_char (c);
+ rest = Fcdr (rest);
+ if (!CONSP (rest))
+ {
+ put_char_id_table (c, character, table);
+ break;
+ }
+ else
+ {
+ ntable = get_char_id_table (c, table);
+ if (!CHAR_ID_TABLE_P (ntable))
+ {
+ ntable = make_char_id_table (Qnil);
+ put_char_id_table (c, ntable, table);
+ }
+ table = ntable;
+ }
+ }
+ }
+ else
+ {
+ Lisp_Object v = Fcar (value);
+
+ if (INTP (v))
+ {
+ Emchar c = XINT (v);
+ Lisp_Object ret
+ = get_char_id_table (c, Vcharacter_variant_table);
+
+ if (NILP (Fmemq (v, ret)))
+ {
+ put_char_id_table (c, Fcons (character, ret),
+ Vcharacter_variant_table);
+ }
+ }
+ seq = make_vector (1, v);
+ }
+ value = seq;
+ }
+ else if (EQ (attribute, Q_ucs))
+ {
+ Lisp_Object ret;
+ Emchar c;
+
+ if (!INTP (value))
+ signal_simple_error ("Invalid value for ->ucs", value);
+
+ c = XINT (value);
+
+ ret = get_char_id_table (c, Vcharacter_variant_table);
+ if (NILP (Fmemq (character, ret)))
+ {
+ put_char_id_table (c, Fcons (character, ret),
+ Vcharacter_variant_table);
+ }
+ }
+ {
+ Lisp_Object table = Fgethash (attribute,
+ Vchar_attribute_hash_table,
+ Qnil);
+
+ if (NILP (table))
+ {
+ table = make_char_id_table (Qunbound);
+ Fputhash (attribute, table, Vchar_attribute_hash_table);
+ }
+ put_char_id_table (XCHAR (character), value, table);
+ return value;
+ }
+}
+
+DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
+Remove CHARACTER's ATTRIBUTE.
+*/
+ (character, attribute))
+{
+ Lisp_Object ccs;
+
+ CHECK_CHAR (character);
+ ccs = Ffind_charset (attribute);
+ if (!NILP (ccs))
+ {
+ return remove_char_ccs (character, ccs);
+ }
+ else
+ {
+ Lisp_Object table = Fgethash (attribute,
+ Vchar_attribute_hash_table,
+ Qunbound);
+ if (!UNBOUNDP (table))
+ {
+ put_char_id_table (XCHAR (character), Qunbound, table);
+ return Qt;
+ }
+ }
+ return Qnil;
+}
+
+INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs);
+INLINE_HEADER int
+CHARSET_BYTE_SIZE (Lisp_Charset* cs)
+{
+ /* ad-hoc method for `ascii' */
+ if ((CHARSET_CHARS (cs) == 94) &&
+ (CHARSET_BYTE_OFFSET (cs) != 33))
+ return 128 - CHARSET_BYTE_OFFSET (cs);
+ else
+ return CHARSET_CHARS (cs);
+}
+
+#define XCHARSET_BYTE_SIZE(ccs) CHARSET_BYTE_SIZE (XCHARSET (ccs))
+
+int decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len);
+int
+decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len)
+{
+ int i;
+
+ if (XVECTOR_LENGTH (v) > ccs_len)
+ return -1;
+
+ for (i = 0; i < XVECTOR_LENGTH (v); i++)
+ {
+ Lisp_Object c = XVECTOR_DATA(v)[i];
+
+ if (!NILP (c) && !CHARP (c))
+ {
+ if (VECTORP (c))
+ {
+ int ret = decoding_table_check_elements (c, dim - 1, ccs_len);
+ if (ret)
+ return ret;
+ }
+ else
+ return -2;
+ }
+ }
+ return 0;
+}
+
+INLINE_HEADER void
+decoding_table_remove_char (Lisp_Object v, int dim, int byte_offset,
+ int code_point);
+INLINE_HEADER void
+decoding_table_remove_char (Lisp_Object v, int dim, int byte_offset,
+ int code_point)
+{
+ int i = -1;
+
+ while (dim > 0)
+ {
+ Lisp_Object nv;
+
+ dim--;
+ i = ((code_point >> (8 * dim)) & 255) - byte_offset;
+ nv = XVECTOR_DATA(v)[i];
+ if (!VECTORP (nv))
+ break;
+ v = nv;
+ }
+ if (i >= 0)
+ XVECTOR_DATA(v)[i] = Qnil;
+}
+
+INLINE_HEADER void
+decoding_table_put_char (Lisp_Object v, int dim, int byte_offset,
+ int code_point, Lisp_Object character);
+INLINE_HEADER void
+decoding_table_put_char (Lisp_Object v, int dim, int byte_offset,
+ int code_point, Lisp_Object character)
+{
+ int i = -1;
+ Lisp_Object nv;
+ int ccs_len = XVECTOR_LENGTH (v);
+
+ while (dim > 0)
+ {
+ dim--;
+ i = ((code_point >> (8 * dim)) & 255) - byte_offset;
+ nv = XVECTOR_DATA(v)[i];
+ if (dim > 0)
+ {
+ if (!VECTORP (nv))
+ nv = (XVECTOR_DATA(v)[i] = make_older_vector (ccs_len, Qnil));
+ v = nv;
+ }
+ else
+ break;
+ }
+ XVECTOR_DATA(v)[i] = character;
+}
+
+Lisp_Object
+put_char_ccs_code_point (Lisp_Object character,
+ Lisp_Object ccs, Lisp_Object value)
+{
+ Lisp_Object encoding_table;
+
+ if (!EQ (XCHARSET_NAME (ccs), Qucs)
+ || (XCHAR (character) != XINT (value)))
+ {
+ Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
+ int dim = XCHARSET_DIMENSION (ccs);
+ int ccs_len = XCHARSET_BYTE_SIZE (ccs);
+ int byte_offset = XCHARSET_BYTE_OFFSET (ccs);
+ int code_point;
+
+ if (CONSP (value))
+ { /* obsolete representation: value must be a list of bytes */
+ Lisp_Object ret = Fcar (value);
+ Lisp_Object rest;
+
+ 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))
+ {
+ int j;
+
+ 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);
+ j = XINT (ret);
+ if (XCHARSET_GRAPHIC (ccs) == 1)
+ j &= 0x7F;
+ code_point = (code_point << 8) | j;
+ rest = Fcdr (rest);
+ }
+ value = make_int (code_point);
+ }
+ else if (INTP (value))
+ {
+ code_point = XINT (value);
+ if (XCHARSET_GRAPHIC (ccs) == 1)
+ {
+ code_point &= 0x7F7F7F7F;
+ value = make_int (code_point);
+ }
+ }
+ else
+ signal_simple_error ("Invalid value for coded-charset", value);
+
+ if (VECTORP (v))
+ {
+ Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
+ if (!NILP (cpos))
+ {
+ decoding_table_remove_char (v, dim, byte_offset, XINT (cpos));
+ }
+ }
+ else
+ {
+ XCHARSET_DECODING_TABLE (ccs)
+ = v = make_older_vector (ccs_len, Qnil);
+ }
+
+ decoding_table_put_char (v, dim, byte_offset, code_point, character);
+ }
+ if (NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs)))
+ {
+ XCHARSET_ENCODING_TABLE (ccs)
+ = encoding_table = make_char_id_table (Qnil);
+ }
+ put_char_id_table (XCHAR (character), value, encoding_table);
+ return Qt;
+}
+
+Lisp_Object
+remove_char_ccs (Lisp_Object character, Lisp_Object ccs)
+{
+ Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
+ Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
+
+ if (VECTORP (decoding_table))
+ {
+ Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
+
+ if (!NILP (cpos))
+ {
+ decoding_table_remove_char (decoding_table,
+ XCHARSET_DIMENSION (ccs),
+ XCHARSET_BYTE_OFFSET (ccs),
+ XINT (cpos));
+ }
+ }
+ if (CHAR_ID_TABLE_P (encoding_table))
+ {
+ put_char_id_table (XCHAR (character), Qnil, encoding_table);
+ }
+ return Qt;
+}
+
+EXFUN (Fmake_char, 3);
+EXFUN (Fdecode_char, 2);
+
+DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
+Store character's ATTRIBUTES.
+*/
+ (attributes))
+{
+ Lisp_Object rest = attributes;
+ Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
+ Lisp_Object character;
+
+ if (NILP (code))
+ {
+ while (CONSP (rest))
+ {
+ Lisp_Object cell = Fcar (rest);
+ Lisp_Object ccs;
+
+ if (!LISTP (cell))
+ signal_simple_error ("Invalid argument", attributes);
+ if (!NILP (ccs = Ffind_charset (Fcar (cell)))
+ && ((XCHARSET_FINAL (ccs) != 0) ||
+ (XCHARSET_UCS_MAX (ccs) > 0)) )
+ {
+ cell = Fcdr (cell);
+ if (CONSP (cell))
+ character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+ else
+ character = Fdecode_char (ccs, cell);
+ goto setup_attributes;
+ }
+ rest = Fcdr (rest);
+ }
+ if (!NILP (code = Fcdr (Fassq (Q_ucs, attributes))))
+ {
+ if (!INTP (code))
+ signal_simple_error ("Invalid argument", attributes);
+ else
+ character = make_char (XINT (code) + 0x100000);
+ goto setup_attributes;
+ }
+ return Qnil;
+ }
+ else if (!INTP (code))
+ signal_simple_error ("Invalid argument", attributes);
+ else
+ character = make_char (XINT (code));
+
+ setup_attributes:
+ rest = attributes;
+ while (CONSP (rest))
+ {
+ Lisp_Object cell = Fcar (rest);
+
+ if (!LISTP (cell))
+ signal_simple_error ("Invalid argument", attributes);
+
+ Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
+ rest = Fcdr (rest);
+ }
+ return character;
+}
+
+Lisp_Object Vutf_2000_version;
+#endif
+
+#ifndef UTF2000
+int leading_code_private_11;
+#endif
projects / chise / xemacs-chise.git / blobdiff