Lisp_Object Vcharset_latin_viscii;
Lisp_Object Vcharset_latin_viscii_lower;
Lisp_Object Vcharset_latin_viscii_upper;
+Lisp_Object Vcharset_ethiopic_ucs;
Lisp_Object Vcharset_hiragana_jisx0208;
Lisp_Object Vcharset_katakana_jisx0208;
#endif
Lisp_Object
get_char_code_table (Emchar ch, Lisp_Object table)
{
+ unsigned int code = ch;
struct Lisp_Char_Byte_Table* cpt
= XCHAR_BYTE_TABLE (XCHAR_CODE_TABLE (table)->table);
- Lisp_Object ret = cpt->property [ch >> 24];
+ Lisp_Object ret = cpt->property [(unsigned char)(code >> 24)];
if (CHAR_BYTE_TABLE_P (ret))
cpt = XCHAR_BYTE_TABLE (ret);
else
return ret;
- ret = cpt->property [(unsigned char) (ch >> 16)];
+ ret = cpt->property [(unsigned char) (code >> 16)];
if (CHAR_BYTE_TABLE_P (ret))
cpt = XCHAR_BYTE_TABLE (ret);
else
return ret;
- ret = cpt->property [(unsigned char) (ch >> 8)];
+ ret = cpt->property [(unsigned char) (code >> 8)];
if (CHAR_BYTE_TABLE_P (ret))
cpt = XCHAR_BYTE_TABLE (ret);
else
return ret;
- return cpt->property [(unsigned char) ch];
+ return cpt->property [(unsigned char) code];
}
void
put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table)
{
+ unsigned int code = ch;
struct Lisp_Char_Byte_Table* cpt1
= XCHAR_BYTE_TABLE (XCHAR_CODE_TABLE (table)->table);
- Lisp_Object ret = cpt1->property[ch >> 24];
+ Lisp_Object ret = cpt1->property[(unsigned char)(code >> 24)];
if (CHAR_BYTE_TABLE_P (ret))
{
struct Lisp_Char_Byte_Table* cpt2 = XCHAR_BYTE_TABLE (ret);
- ret = cpt2->property[(unsigned char)(ch >> 16)];
+ ret = cpt2->property[(unsigned char)(code >> 16)];
if (CHAR_BYTE_TABLE_P (ret))
{
struct Lisp_Char_Byte_Table* cpt3 = XCHAR_BYTE_TABLE (ret);
- ret = cpt3->property[(unsigned char)(ch >> 8)];
+ ret = cpt3->property[(unsigned char)(code >> 8)];
if (CHAR_BYTE_TABLE_P (ret))
{
struct Lisp_Char_Byte_Table* cpt4
= XCHAR_BYTE_TABLE (ret);
- cpt4->property[(unsigned char)ch] = value;
+ cpt4->property[(unsigned char)code] = value;
}
else if (!EQ (ret, value))
{
Lisp_Object cpt4 = make_char_byte_table (ret);
- XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value;
- cpt3->property[(unsigned char)(ch >> 8)] = cpt4;
+ XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
+ cpt3->property[(unsigned char)(code >> 8)] = cpt4;
}
}
else if (!EQ (ret, value))
Lisp_Object cpt3 = make_char_byte_table (ret);
Lisp_Object cpt4 = make_char_byte_table (ret);
- XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value;
- XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(ch >> 8)]
+ XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
+ XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)]
= cpt4;
- cpt2->property[(unsigned char)(ch >> 16)] = cpt3;
+ cpt2->property[(unsigned char)(code >> 16)] = cpt3;
}
}
else if (!EQ (ret, value))
Lisp_Object cpt3 = make_char_byte_table (ret);
Lisp_Object cpt4 = make_char_byte_table (ret);
- XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value;
- XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(ch >> 8)] = cpt4;
- XCHAR_BYTE_TABLE(cpt2)->property[(unsigned char)(ch >> 16)] = cpt3;
- cpt1->property[(unsigned char)(ch >> 24)] = cpt2;
+ XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
+ XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)] = cpt4;
+ XCHAR_BYTE_TABLE(cpt2)->property[(unsigned char)(code >> 16)] = cpt3;
+ cpt1->property[(unsigned char)(code >> 24)] = cpt2;
}
}
Lisp_Object Vcharacter_attribute_table;
+Lisp_Object Vcharacter_composition_table;
+Lisp_Object Vcharacter_variant_table;
+
+Lisp_Object Q_decomposition;
+Lisp_Object Q_ucs;
+Lisp_Object Qwide;
+Lisp_Object Qnarrow;
+Lisp_Object Qcompat;
+Lisp_Object QnoBreak;
+Lisp_Object Qsuper;
+Lisp_Object Qfraction;
+
+Emchar
+to_char_code (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, Qwide))
+ return -1;
+ else if (EQ (v, Qnarrow))
+ return -2;
+ else if (EQ (v, Qcompat))
+ return -3;
+ else if (EQ (v, QnoBreak))
+ return -4;
+ else if (EQ (v, Qsuper))
+ return -5;
+ else if (EQ (v, Qfraction))
+ return -6;
+ 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_code (v, "Invalid value for composition", list);
+
+ ret = get_char_code_table (c, table);
+
+ rest = Fcdr (rest);
+ if (NILP (rest))
+ {
+ if (!CHAR_CODE_TABLE_P (ret))
+ return ret;
+ else
+ return Qt;
+ }
+ else if (!CONSP (rest))
+ break;
+ else if (CHAR_CODE_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_code_table (XCHAR (character),
+ Vcharacter_variant_table));
+}
DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
Return the alist of attributes of CHARACTER.
*/
(character))
{
- return get_char_code_table (XCHAR (character), Vcharacter_attribute_table);
+ CHECK_CHAR (character);
+ return Fcopy_alist (get_char_code_table (XCHAR (character),
+ Vcharacter_attribute_table));
}
DEFUN ("get-char-attribute", Fget_char_attribute, 2, 2, 0, /*
Lisp_Object ei = Fcar (rest);
if (!INTP (ei))
- signal_simple_error ("Invalid value for coded-charset",
- value);
- i = XINT (ei) - XCHARSET_BYTE_OFFSET (ccs);
+ signal_simple_error ("Invalid value for coded-charset", value);
+ i = XINT (ei);
+ if ((i < 0) || (255 < i))
+ signal_simple_error ("Invalid value for coded-charset", value);
+ i -= XCHARSET_BYTE_OFFSET (ccs);
nv = XVECTOR_DATA(v)[i];
rest = Fcdr (rest);
if (CONSP (rest))
}
XVECTOR_DATA(v)[i] = character;
}
+ else if (EQ (attribute, Q_decomposition))
+ {
+ Lisp_Object rest = value;
+ Lisp_Object table = Vcharacter_composition_table;
+
+ if (!CONSP (value))
+ signal_simple_error ("Invalid value for ->decomposition",
+ value);
+
+ while (CONSP (rest))
+ {
+ Lisp_Object v = Fcar (rest);
+ Lisp_Object ntable;
+ Emchar c
+ = to_char_code (v, "Invalid value for ->decomposition", value);
+
+ rest = Fcdr (rest);
+ if (!CONSP (rest))
+ {
+ put_char_code_table (c, character, table);
+ break;
+ }
+ else
+ {
+ ntable = get_char_code_table (c, table);
+ if (!CHAR_CODE_TABLE_P (ntable))
+ {
+ ntable = make_char_code_table (Qnil);
+ put_char_code_table (c, ntable, table);
+ }
+ table = ntable;
+ }
+ }
+ }
+ 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_code_table (c, Vcharacter_variant_table);
+ if (NILP (Fmemq (character, ret)))
+ {
+ put_char_code_table (c, Fcons (character, ret),
+ Vcharacter_variant_table);
+ }
+ }
return put_char_attribute (character, attribute, value);
}
Qlatin_viscii_upper,
Qvietnamese_viscii_lower,
Qvietnamese_viscii_upper,
+ Qethiopic_ucs,
Qhiragana_jisx0208,
Qkatakana_jisx0208,
#endif
}
else if (VECTORP (table))
{
- if (XVECTOR_LENGTH (table) > CHARSET_CHARS (cs))
+ int ccs_len;
+
+ /* ad-hoc method for `ascii' */
+ if ((CHARSET_CHARS (cs) == 94) &&
+ (CHARSET_BYTE_OFFSET (cs) != 33))
+ ccs_len = 128 - CHARSET_BYTE_OFFSET (cs);
+ else
+ ccs_len = CHARSET_CHARS (cs);
+
+ if (XVECTOR_LENGTH (table) > ccs_len)
args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
old_table = CHARSET_DECODING_TABLE(cs);
CHARSET_DECODING_TABLE(cs) = table;
DEFSUBR (Fget_char_attribute);
DEFSUBR (Fput_char_attribute);
DEFSUBR (Fdefine_char);
+ DEFSUBR (Fchar_variants);
+ DEFSUBR (Fget_composite_char);
DEFSUBR (Fcharset_mapping_table);
DEFSUBR (Fset_charset_mapping_table);
#endif
defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1");
defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2");
#ifdef UTF2000
+ defsymbol (&Q_ucs, "->ucs");
+ defsymbol (&Q_decomposition, "->decomposition");
+ defsymbol (&Qwide, "wide");
+ defsymbol (&Qnarrow, "narrow");
+ defsymbol (&Qcompat, "compat");
+ defsymbol (&QnoBreak, "noBreak");
+ defsymbol (&Qsuper, "super");
+ defsymbol (&Qfraction, "fraction");
defsymbol (&Qucs, "ucs");
defsymbol (&Qucs_bmp, "ucs-bmp");
defsymbol (&Qlatin_viscii, "latin-viscii");
defsymbol (&Qlatin_viscii_upper, "latin-viscii-upper");
defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
+ defsymbol (&Qethiopic_ucs, "ethiopic-ucs");
defsymbol (&Qhiragana_jisx0208, "hiragana-jisx0208");
defsymbol (&Qkatakana_jisx0208, "katakana-jisx0208");
#endif
staticpro (&Vcharacter_attribute_table);
Vcharacter_attribute_table = make_char_code_table (Qnil);
+ staticpro (&Vcharacter_composition_table);
+ Vcharacter_composition_table = make_char_code_table (Qnil);
+
+ staticpro (&Vcharacter_variant_table);
+ Vcharacter_variant_table = make_char_code_table (Qnil);
+
Vdefault_coded_charset_priority_list = Qnil;
DEFVAR_LISP ("default-coded-charset-priority-list",
&Vdefault_coded_charset_priority_list /*
build_string ("VISCII 1.1 (Vietnamese)"),
build_string ("VISCII1\\.1"),
Qnil, 0, 0, 0, 0);
+ Vcharset_ethiopic_ucs =
+ make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs,
+ CHARSET_TYPE_256X256, 2, 2, 0,
+ CHARSET_LEFT_TO_RIGHT,
+ build_string ("Ethiopic (UCS)"),
+ build_string ("Ethiopic (UCS)"),
+ build_string ("Ethiopic of UCS"),
+ build_string ("Ethiopic-Unicode"),
+ Qnil, 0x1200, 0x137F, 0x1200, 0);
Vcharset_hiragana_jisx0208 =
make_charset (LEADING_BYTE_HIRAGANA_JISX0208, Qhiragana_jisx0208,
CHARSET_TYPE_94X94, 2, 0, 'B',