-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 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,
- internal_object_printer,
- 0, byte_table_equal,
- byte_table_hash,
- byte_table_description,
- Lisp_Byte_Table);
-
-static Lisp_Object
-make_byte_table (Lisp_Object initval, int older)
-{
- Lisp_Object obj;
- int i;
- Lisp_Byte_Table *cte;
-
- if (older)
- cte = alloc_older_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
- else
- 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 Lisp_Object
-copy_byte_table (Lisp_Object entry)
-{
- Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
- Lisp_Object obj;
- int i;
- Lisp_Byte_Table *ctenew
- = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
-
- for (i = 0; i < 256; i++)
- {
- Lisp_Object new = cte->property[i];
- if (BYTE_TABLE_P (new))
- ctenew->property[i] = copy_byte_table (new);
- else
- ctenew->property[i] = new;
- }
-
- XSETBYTE_TABLE (obj, ctenew);
- return obj;
-}
-
-
-static Lisp_Object
-mark_char_id_table (Lisp_Object obj)
-{
- Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj);
-
- return cte->table;
-}
-
-static int
-char_id_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
- Lisp_Char_ID_Table *cte1 = XCHAR_ID_TABLE (obj1);
- Lisp_Char_ID_Table *cte2 = XCHAR_ID_TABLE (obj2);
-
- return byte_table_equal (cte1->table, cte2->table, depth + 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,
- internal_object_printer,
- 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, int older)
-{
- Lisp_Object obj;
- Lisp_Char_ID_Table *cte;
-
- if (older)
- cte = alloc_older_lcrecord_type (Lisp_Char_ID_Table,
- &lrecord_char_id_table);
- else
- cte = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table);
-
- cte->table = make_byte_table (initval, older);
-
- XSETCHAR_ID_TABLE (obj, cte);
- return obj;
-}
-
-/* not used */
-#if 0
-static Lisp_Object
-copy_char_id_table (Lisp_Object entry)
-{
- Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (entry);
- Lisp_Object obj;
- Lisp_Char_ID_Table *ctenew
- = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table);
-
- ctenew->table = copy_byte_table (cte->table);
- XSETCHAR_ID_TABLE (obj, ctenew);
- return obj;
-}
-#endif
-
-
-Lisp_Object
-get_char_id_table (Emchar ch, Lisp_Object table)
-{
- unsigned int code = ch;
- Lisp_Byte_Table* cpt
- = XBYTE_TABLE (XCHAR_ID_TABLE (table)->table);
- Lisp_Object ret = cpt->property [(unsigned char)(code >> 24)];
-
- if (BYTE_TABLE_P (ret))
- cpt = XBYTE_TABLE (ret);
- else
- return ret;
-
- ret = cpt->property [(unsigned char) (code >> 16)];
- if (BYTE_TABLE_P (ret))
- cpt = XBYTE_TABLE (ret);
- else
- return ret;
-
- ret = cpt->property [(unsigned char) (code >> 8)];
- if (BYTE_TABLE_P (ret))
- cpt = XBYTE_TABLE (ret);
- else
- return ret;
-
- return cpt->property [(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_Byte_Table* cpt1 = XBYTE_TABLE (XCHAR_ID_TABLE (table)->table);
- Lisp_Object ret = cpt1->property[(unsigned char)(code >> 24)];
-
- if (BYTE_TABLE_P (ret))
- {
- Lisp_Byte_Table* cpt2 = XBYTE_TABLE (ret);
-
- ret = cpt2->property[(unsigned char)(code >> 16)];
- if (BYTE_TABLE_P (ret))
- {
- Lisp_Byte_Table* cpt3 = XBYTE_TABLE (ret);
-
- ret = cpt3->property[(unsigned char)(code >> 8)];
- if (BYTE_TABLE_P (ret))
- {
- Lisp_Byte_Table* cpt4 = XBYTE_TABLE (ret);
-
- cpt4->property[(unsigned char)code] = value;
- }
- else if (!EQ (ret, value))
- {
- Lisp_Object cpt4
- = make_byte_table (ret, OLDER_RECORD_P (table));
-
- XBYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
- cpt3->property[(unsigned char)(code >> 8)] = cpt4;
- }
- }
- else if (!EQ (ret, value))
- {
- int older = OLDER_RECORD_P (table);
- Lisp_Object cpt3 = make_byte_table (ret, older);
- Lisp_Object cpt4 = make_byte_table (ret, older);
-
- XBYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
- XBYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)]
- = cpt4;
- cpt2->property[(unsigned char)(code >> 16)] = cpt3;
- }
- }
- else if (!EQ (ret, value))
- {
- int older = OLDER_RECORD_P (table);
- Lisp_Object cpt2 = make_byte_table (ret, older);
- Lisp_Object cpt3 = make_byte_table (ret, older);
- Lisp_Object cpt4 = make_byte_table (ret, older);
-
- XBYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
- XBYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)] = cpt4;
- XBYTE_TABLE(cpt2)->property[(unsigned char)(code >> 16)] = cpt3;
- cpt1->property[(unsigned char)(code >> 24)] = cpt2;
- }
-}
-
-
-Lisp_Object Vcharacter_attribute_table;
-Lisp_Object Vcharacter_name_table;
-Lisp_Object Vcharacter_ideographic_radical_table;
-Lisp_Object Vcharacter_ideographic_strokes_table;
-Lisp_Object Vcharacter_total_strokes_table;
-Lisp_Object Vcharacter_decomposition_table;
-Lisp_Object Vcharacter_composition_table;
-Lisp_Object Vcharacter_variant_table;
-
-Lisp_Object Qname;
-Lisp_Object Qideographic_radical, Qideographic_strokes;
-Lisp_Object Qtotal_strokes;
-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);
-
-Lisp_Object put_char_attribute (Lisp_Object character,
- Lisp_Object attribute, Lisp_Object value);
-Lisp_Object remove_char_attribute (Lisp_Object character,
- Lisp_Object attribute);
-
-
-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));
-}
-
-DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
-Return the alist of attributes of CHARACTER.
-*/
- (character))
-{
- Lisp_Object alist, ret;
- int i;
-
- CHECK_CHAR (character);
- alist = Fcopy_alist (get_char_id_table (XCHAR (character),
- Vcharacter_attribute_table));
-
- ret = get_char_id_table (XCHAR (character), Vcharacter_name_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qname, ret), alist);
-
- ret = get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_radical_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qideographic_radical, ret), alist);
-
- ret = get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_strokes_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qideographic_strokes, ret), alist);
-
- ret = get_char_id_table (XCHAR (character), Vcharacter_total_strokes_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Qtotal_strokes, ret), alist);
-
- ret = get_char_id_table (XCHAR (character),
- Vcharacter_decomposition_table);
- if (!NILP (ret))
- alist = Fcons (Fcons (Q_decomposition, ret), alist);
-
- for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
- {
- Lisp_Object ccs = chlook->charset_by_leading_byte[i];
-
- if (!NILP (ccs))
- {
-#if 0
- int code_point = charset_code_point (ccs, XCHAR (character));
-
- if (code_point >= 0)
- {
- alist = Fcons (Fcons (ccs, make_int (code_point)), alist);
- }
-#else
- 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);
- }
-#endif
- }
- }
- return alist;
-}
-
-DEFUN ("get-char-attribute", Fget_char_attribute, 2, 2, 0, /*
-Return the value of CHARACTER's ATTRIBUTE.
-*/
- (character, attribute))
-{
- 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
- return Qnil;
- }
- else if (EQ (attribute, Qname))
- {
- return get_char_id_table (XCHAR (character), Vcharacter_name_table);
- }
- else if (EQ (attribute, Qideographic_radical))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_radical_table);
- }
- else if (EQ (attribute, Qideographic_strokes))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_ideographic_strokes_table);
- }
- else if (EQ (attribute, Qtotal_strokes))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_total_strokes_table);
- }
- else if (EQ (attribute, Q_decomposition))
- {
- return get_char_id_table (XCHAR (character),
- Vcharacter_decomposition_table);
- }
- else
- {
- Lisp_Object ret
- = get_char_id_table (XCHAR (character), Vcharacter_attribute_table);
-
- if (EQ (ret, Qnil))
- return Qnil;
- else
- return Fcdr (Fassq (attribute, ret));
- }
-}
-
-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, Qname))
- {
- CHECK_STRING (value);
- put_char_id_table (XCHAR (character), value, Vcharacter_name_table);
- return value;
- }
- else if (EQ (attribute, Qideographic_radical))
- {
- CHECK_INT (value);
- put_char_id_table (XCHAR (character), value,
- Vcharacter_ideographic_radical_table);
- return value;
- }
- else if (EQ (attribute, Qideographic_strokes))
- {
- CHECK_INT (value);
- put_char_id_table (XCHAR (character), value,
- Vcharacter_ideographic_strokes_table);
- return value;
- }
- else if (EQ (attribute, Qtotal_strokes))
- {
- CHECK_INT (value);
- put_char_id_table (XCHAR (character), value,
- Vcharacter_total_strokes_table);
- return 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_older_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, OLDER_RECORD_P (table));
- 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_older_vector (1, v);
- }
- put_char_id_table (XCHAR (character), seq,
- Vcharacter_decomposition_table);
- return value;
- }
- 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);
- }
- }
- return put_char_attribute (character, attribute, 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);
- }
- return remove_char_attribute (character, attribute);
-}
-
-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))
-