From ed67ccedc3bf21eba9ae4fa615fb178736cd8d7b Mon Sep 17 00:00:00 2001 From: tomo Date: Wed, 31 May 2000 04:06:50 +0000 Subject: [PATCH] (Vcharacter_name_table): New variable. (Qname): New variable. (Fget_char_attribute): Use `Vcharacter_name_table' for `name' attribute. (Fput_char_attribute): Use function `put_char_ccs_code_point'; use `Vcharacter_name_table' for `name' attribute. (Fremove_char_attribute): Use function `remove_char_ccs'. (put_char_ccs_code_point): New function. (remove_char_ccs): New function. (syms_of_mule_charset): Add new symbol `name'. (vars_of_mule_charset): Setup `Vcharacter_name_table'. --- src/mule-charset.c | 395 ++++++++++++++++++++++++++++------------------------ 1 file changed, 213 insertions(+), 182 deletions(-) diff --git a/src/mule-charset.c b/src/mule-charset.c index 3badc13..95d8641 100644 --- a/src/mule-charset.c +++ b/src/mule-charset.c @@ -422,10 +422,13 @@ put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table) Lisp_Object Vcharacter_attribute_table; +Lisp_Object Vcharacter_name_table; Lisp_Object Vcharacter_composition_table; Lisp_Object Vcharacter_variant_table; +Lisp_Object Qname; Lisp_Object Q_decomposition; +Lisp_Object Qucs; Lisp_Object Q_ucs; Lisp_Object Qcompat; Lisp_Object Qisolated; @@ -445,6 +448,17 @@ 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) { @@ -559,6 +573,10 @@ Return the value of CHARACTER's ATTRIBUTE. else return Qnil; } + else if (EQ (attribute, Qname)) + { + return get_char_id_table (XCHAR (character), Vcharacter_name_table); + } else { Lisp_Object ret @@ -571,64 +589,6 @@ Return the value of CHARACTER's ATTRIBUTE. } } -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) -{ - Emchar char_id = XCHAR (character); - Lisp_Object ret = get_char_id_table (char_id, Vcharacter_attribute_table); - Lisp_Object cell; - - cell = Fassq (attribute, ret); - - if (NILP (cell)) - { - ret = Fcons (Fcons (attribute, value), ret); - } - else if (!EQ (Fcdr (cell), value)) - { - Fsetcdr (cell, value); - } - put_char_id_table (char_id, ret, Vcharacter_attribute_table); - return ret; -} - -Lisp_Object remove_char_attribute (Lisp_Object character, - Lisp_Object attribute); -Lisp_Object -remove_char_attribute (Lisp_Object character, Lisp_Object attribute) -{ - Emchar char_id = XCHAR (character); - Lisp_Object alist = get_char_id_table (char_id, Vcharacter_attribute_table); - - if (EQ (attribute, Fcar (Fcar (alist)))) - { - alist = Fcdr (alist); - } - else - { - Lisp_Object pr = alist; - Lisp_Object r = Fcdr (alist); - - while (!NILP (r)) - { - if (EQ (attribute, Fcar (Fcar (r)))) - { - XCDR (pr) = Fcdr (r); - break; - } - pr = r; - r = Fcdr (r); - } - } - put_char_id_table (char_id, alist, Vcharacter_attribute_table); - return alist; -} - -Lisp_Object Qucs; - DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /* Store CHARACTER's ATTRIBUTE with VALUE. */ @@ -640,122 +600,13 @@ Store CHARACTER's ATTRIBUTE with VALUE. ccs = Ffind_charset (attribute); if (!NILP (ccs)) { - Lisp_Object encoding_table; - - if (!EQ (XCHARSET_NAME (ccs), Qucs) - || (XCHAR (character) != XINT (value))) - { - Lisp_Object cpos, rest; - Lisp_Object v = XCHARSET_DECODING_TABLE (ccs); - Lisp_Object nv; - int i = -1; - int ccs_len; - int dim; - int code_point; - - /* ad-hoc method for `ascii' */ - if ((XCHARSET_CHARS (ccs) == 94) && - (XCHARSET_BYTE_OFFSET (ccs) != 33)) - ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs); - else - ccs_len = XCHARSET_CHARS (ccs); - - if (CONSP (value)) - { - Lisp_Object ret = Fcar (value); - - 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)) - { - if (XCHARSET_GRAPHIC (ccs) == 1) - value = make_int (XINT (value) & 0x7F7F7F7F); - } - else - signal_simple_error ("Invalid value for coded-charset", value); - - attribute = ccs; - cpos = Fget_char_attribute (character, attribute); - if (VECTORP (v)) - { - if (!NILP (cpos)) - { - dim = XCHARSET_DIMENSION (ccs); - code_point = XINT (cpos); - while (dim > 0) - { - dim--; - i = ((code_point >> (8 * dim)) & 255) - - XCHARSET_BYTE_OFFSET (ccs); - nv = XVECTOR_DATA(v)[i]; - if (!VECTORP (nv)) - break; - v = nv; - } - if (i >= 0) - XVECTOR_DATA(v)[i] = Qnil; - v = XCHARSET_DECODING_TABLE (ccs); - } - } - else - { - XCHARSET_DECODING_TABLE (ccs) = v - = make_older_vector (ccs_len, Qnil); - } - - dim = XCHARSET_DIMENSION (ccs); - code_point = XINT (value); - i = -1; - while (dim > 0) - { - dim--; - i = ((code_point >> (8 * dim)) & 255) - - XCHARSET_BYTE_OFFSET (ccs); - 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; - } - else - attribute = ccs; - if (NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs))) - { - XCHARSET_ENCODING_TABLE (ccs) = encoding_table - = make_char_id_table (Qnil, -1); - } - put_char_id_table (XCHAR (character), value, encoding_table); - return Qt; + 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, Q_decomposition)) { @@ -843,14 +694,27 @@ Remove CHARACTER's ATTRIBUTE. ccs = Ffind_charset (attribute); if (!NILP (ccs)) { - Lisp_Object cpos; + return remove_char_ccs (character, ccs); + } + return remove_char_attribute (character, attribute); +} + +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 cpos, rest; Lisp_Object v = XCHARSET_DECODING_TABLE (ccs); Lisp_Object nv; int i = -1; int ccs_len; int dim; int code_point; - Lisp_Object encoding_table; /* ad-hoc method for `ascii' */ if ((XCHARSET_CHARS (ccs) == 94) && @@ -859,8 +723,44 @@ Remove CHARACTER's ATTRIBUTE. else ccs_len = XCHARSET_CHARS (ccs); - attribute = ccs; - cpos = Fget_char_attribute (character, attribute); + if (CONSP (value)) + { + Lisp_Object ret = Fcar (value); + + 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)) + { + if (XCHARSET_GRAPHIC (ccs) == 1) + value = make_int (XINT (value) & 0x7F7F7F7F); + } + else + signal_simple_error ("Invalid value for coded-charset", value); + + cpos = Fget_char_attribute (character, ccs); if (VECTORP (v)) { if (!NILP (cpos)) @@ -882,13 +782,140 @@ Remove CHARACTER's ATTRIBUTE. v = XCHARSET_DECODING_TABLE (ccs); } } - if (!NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs))) + else + { + XCHARSET_DECODING_TABLE (ccs) = v + = make_older_vector (ccs_len, Qnil); + } + + dim = XCHARSET_DIMENSION (ccs); + code_point = XINT (value); + i = -1; + while (dim > 0) { - put_char_id_table (XCHAR (character), Qnil, encoding_table); + dim--; + i = ((code_point >> (8 * dim)) & 255) + - XCHARSET_BYTE_OFFSET (ccs); + 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; } - return Qt; + XVECTOR_DATA(v)[i] = character; } - return remove_char_attribute (character, attribute); + if (NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs))) + { + XCHARSET_ENCODING_TABLE (ccs) = encoding_table + = make_char_id_table (Qnil, -1); + } + put_char_id_table (XCHAR (character), value, encoding_table); + return Qt; +} + +Lisp_Object +remove_char_ccs (Lisp_Object character, Lisp_Object ccs) +{ + Lisp_Object cpos; + Lisp_Object v = XCHARSET_DECODING_TABLE (ccs); + Lisp_Object nv; + int i = -1; + int ccs_len; + int dim; + int code_point; + Lisp_Object encoding_table; + + /* ad-hoc method for `ascii' */ + if ((XCHARSET_CHARS (ccs) == 94) && + (XCHARSET_BYTE_OFFSET (ccs) != 33)) + ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs); + else + ccs_len = XCHARSET_CHARS (ccs); + + cpos = Fget_char_attribute (character, ccs); + if (VECTORP (v)) + { + if (!NILP (cpos)) + { + dim = XCHARSET_DIMENSION (ccs); + code_point = XINT (cpos); + while (dim > 0) + { + dim--; + i = ((code_point >> (8 * dim)) & 255) + - XCHARSET_BYTE_OFFSET (ccs); + nv = XVECTOR_DATA(v)[i]; + if (!VECTORP (nv)) + break; + v = nv; + } + if (i >= 0) + XVECTOR_DATA(v)[i] = Qnil; + v = XCHARSET_DECODING_TABLE (ccs); + } + } + if (!NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs))) + { + put_char_id_table (XCHAR (character), Qnil, encoding_table); + } + return Qt; +} + +Lisp_Object +put_char_attribute (Lisp_Object character, Lisp_Object attribute, + Lisp_Object value) +{ + Emchar char_id = XCHAR (character); + Lisp_Object ret = get_char_id_table (char_id, Vcharacter_attribute_table); + Lisp_Object cell; + + cell = Fassq (attribute, ret); + + if (NILP (cell)) + { + ret = Fcons (Fcons (attribute, value), ret); + } + else if (!EQ (Fcdr (cell), value)) + { + Fsetcdr (cell, value); + } + put_char_id_table (char_id, ret, Vcharacter_attribute_table); + return ret; +} + +Lisp_Object +remove_char_attribute (Lisp_Object character, Lisp_Object attribute) +{ + Emchar char_id = XCHAR (character); + Lisp_Object alist = get_char_id_table (char_id, Vcharacter_attribute_table); + + if (EQ (attribute, Fcar (Fcar (alist)))) + { + alist = Fcdr (alist); + } + else + { + Lisp_Object pr = alist; + Lisp_Object r = Fcdr (alist); + + while (!NILP (r)) + { + if (EQ (attribute, Fcar (Fcar (r)))) + { + XCDR (pr) = Fcdr (r); + break; + } + pr = r; + r = Fcdr (r); + } + } + put_char_id_table (char_id, alist, Vcharacter_attribute_table); + return alist; } EXFUN (Fmake_char, 3); @@ -2880,6 +2907,7 @@ syms_of_mule_charset (void) defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1"); defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2"); #ifdef UTF2000 + defsymbol (&Qname, "name"); defsymbol (&Q_ucs, "->ucs"); defsymbol (&Q_decomposition, "->decomposition"); defsymbol (&Qcompat, "compat"); @@ -2989,6 +3017,9 @@ Version number of UTF-2000. staticpro (&Vcharacter_attribute_table); Vcharacter_attribute_table = make_char_id_table (Qnil, 0); + staticpro (&Vcharacter_name_table); + Vcharacter_name_table = make_char_id_table (Qnil, 0); + /* staticpro (&Vcharacter_composition_table); */ Vcharacter_composition_table = make_char_id_table (Qnil, -1); -- 1.7.10.4