Lisp_Object Vcharset_ucs;
Lisp_Object Vcharset_ucs_bmp;
Lisp_Object Vcharset_ucs_cns;
+Lisp_Object Vcharset_ucs_jis;
Lisp_Object Vcharset_ucs_big5;
Lisp_Object Vcharset_latin_viscii;
Lisp_Object Vcharset_latin_tcvn5712;
return -1;
}
+static int
+map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct,
+ int (*fn) (Emchar c, Lisp_Object val, void *arg),
+ void *arg, Emchar ofs, int place)
+{
+ int i, retval;
+ int unit = 1 << (8 * place);
+ Emchar c = ofs;
+ Emchar c1;
+
+ for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+ {
+ if (ct->property[i] != BT_UINT8_unbound)
+ {
+ c1 = c + unit;
+ for (; c < c1 && retval == 0; c++)
+ retval = (fn) (c, UINT8_DECODE (ct->property[i]), arg);
+ }
+ else
+ c += unit;
+ }
+ return retval;
+}
#define BT_UINT16_MIN 0
#define BT_UINT16_MAX (USHRT_MAX - 3)
return -1;
}
+static int
+map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct,
+ int (*fn) (Emchar c, Lisp_Object val, void *arg),
+ void *arg, Emchar ofs, int place)
+{
+ int i, retval;
+ int unit = 1 << (8 * place);
+ Emchar c = ofs;
+ Emchar c1;
+
+ for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+ {
+ if (ct->property[i] != BT_UINT16_unbound)
+ {
+ c1 = c + unit;
+ for (; c < c1 && retval == 0; c++)
+ retval = (fn) (c, UINT16_DECODE (ct->property[i]), arg);
+ }
+ else
+ c += unit;
+ }
+ return retval;
+}
+
static Lisp_Object
mark_byte_table (Lisp_Object obj)
return -1;
}
+static int
+map_over_byte_table (Lisp_Byte_Table *ct,
+ int (*fn) (Emchar c, Lisp_Object val, void *arg),
+ void *arg, Emchar ofs, int place)
+{
+ int i, retval;
+ Lisp_Object v;
+ int unit = 1 << (8 * place);
+ Emchar c = ofs;
+
+ for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+ {
+ v = ct->property[i];
+ if (UINT8_BYTE_TABLE_P (v))
+ {
+ retval
+ = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v),
+ fn, arg, c, place - 1);
+ c += unit;
+ }
+ else if (UINT16_BYTE_TABLE_P (v))
+ {
+ retval
+ = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v),
+ fn, arg, c, place - 1);
+ c += unit;
+ }
+ else if (BYTE_TABLE_P (v))
+ {
+ retval = map_over_byte_table (XBYTE_TABLE(v),
+ fn, arg, c, place - 1);
+ c += unit;
+ }
+ else if (!UNBOUNDP (v))
+ {
+ Emchar c1 = c + unit;
+
+ for (; c < c1 && retval == 0; c++)
+ retval = (fn) (c, v, arg);
+ }
+ else
+ c += unit;
+ }
+ return retval;
+}
+
Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx);
Lisp_Object put_byte_table (Lisp_Object table, unsigned char idx,
= put_byte_table (table1, (unsigned char)(code >> 24), table2);
}
+/* Map FN (with client data ARG) in char table CT.
+ Mapping stops the first time FN returns non-zero, and that value
+ becomes the return value of map_char_id_table(). */
+int
+map_char_id_table (Lisp_Char_ID_Table *ct,
+ int (*fn) (Emchar c, Lisp_Object val, void *arg),
+ void *arg);
+int
+map_char_id_table (Lisp_Char_ID_Table *ct,
+ int (*fn) (Emchar c, Lisp_Object val, void *arg),
+ void *arg)
+{
+ Lisp_Object v = ct->table;
+
+ if (UINT8_BYTE_TABLE_P (v))
+ return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), fn, arg, 0, 3);
+ else if (UINT16_BYTE_TABLE_P (v))
+ return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), fn, arg, 0, 3);
+ else if (BYTE_TABLE_P (v))
+ return map_over_byte_table (XBYTE_TABLE(v), fn, arg, 0, 3);
+ else if (!UNBOUNDP (v))
+ {
+ int unit = 1 << 24;
+ Emchar c = 0;
+ Emchar c1 = c + unit;
+ int retval;
+
+ for (retval = 0; c < c1 && retval == 0; c++)
+ retval = (fn) (c, v, arg);
+ }
+ return 0;
+}
+
+struct slow_map_char_id_table_arg
+{
+ Lisp_Object function;
+ Lisp_Object retval;
+};
+
+static int
+slow_map_char_id_table_fun (Emchar c, Lisp_Object val, void *arg)
+{
+ struct slow_map_char_id_table_arg *closure =
+ (struct slow_map_char_id_table_arg *) arg;
+
+ closure->retval = call2 (closure->function, make_char (c), val);
+ return !NILP (closure->retval);
+}
+
Lisp_Object Vchar_attribute_hash_table;
Lisp_Object Vcharacter_composition_table;
return Qnil;
}
+DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 2, 0, /*
+Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
+each key and value in the table.
+*/
+ (function, attribute))
+{
+ Lisp_Object ccs;
+ Lisp_Char_ID_Table *ct;
+ struct slow_map_char_id_table_arg slarg;
+ struct gcpro gcpro1, gcpro2;
+
+ if (!NILP (ccs = Ffind_charset (attribute)))
+ {
+ Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
+
+ if (CHAR_ID_TABLE_P (encoding_table))
+ ct = XCHAR_ID_TABLE (encoding_table);
+ else
+ return Qnil;
+ }
+ else
+ {
+ Lisp_Object table = Fgethash (attribute,
+ Vchar_attribute_hash_table,
+ Qunbound);
+ if (CHAR_ID_TABLE_P (table))
+ ct = XCHAR_ID_TABLE (table);
+ else
+ return Qnil;
+ }
+ slarg.function = function;
+ slarg.retval = Qnil;
+ GCPRO2 (slarg.function, slarg.retval);
+ map_char_id_table (ct, slow_map_char_id_table_fun, &slarg);
+ UNGCPRO;
+
+ return slarg.retval;
+}
+
INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs);
INLINE_HEADER int
CHARSET_BYTE_SIZE (Lisp_Charset* cs)
return character;
}
+DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
+Retrieve the character of the given ATTRIBUTES.
+*/
+ (attributes))
+{
+ Lisp_Object rest = attributes;
+ Lisp_Object 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))))
+ {
+ cell = Fcdr (cell);
+ if (CONSP (cell))
+ return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+ else
+ return Fdecode_char (ccs, cell);
+ }
+ rest = Fcdr (rest);
+ }
+ if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
+ (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
+ {
+ if (!INTP (code))
+ signal_simple_error ("Invalid argument", attributes);
+ else
+ return make_char (XINT (code) + 0x100000);
+ }
+ return Qnil;
+}
+
Lisp_Object Vutf_2000_version;
#endif
#ifdef UTF2000
Qucs_bmp,
Qucs_cns,
+ Qucs_jis,
Qucs_big5,
Qlatin_viscii,
Qlatin_tcvn5712,
DEFSUBR (Fget_char_attribute);
DEFSUBR (Fput_char_attribute);
DEFSUBR (Fremove_char_attribute);
+ DEFSUBR (Fmap_char_attribute);
DEFSUBR (Fdefine_char);
+ DEFSUBR (Ffind_char);
DEFSUBR (Fchar_variants);
DEFSUBR (Fget_composite_char);
DEFSUBR (Fcharset_mapping_table);
defsymbol (&Qucs, "ucs");
defsymbol (&Qucs_bmp, "ucs-bmp");
defsymbol (&Qucs_cns, "ucs-cns");
+ defsymbol (&Qucs_jis, "ucs-jis");
defsymbol (&Qucs_big5, "ucs-big5");
defsymbol (&Qlatin_viscii, "latin-viscii");
defsymbol (&Qlatin_tcvn5712, "latin-tcvn5712");
int k;
#endif
- chlook = xnew (struct charset_lookup);
- dumpstruct (&chlook, &charset_lookup_description);
+ chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
+ dump_add_root_struct_ptr (&chlook, &charset_lookup_description);
/* Table of charsets indexed by leading byte. */
for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
build_string ("ISO/IEC 10646 for CNS 11643"),
build_string (""),
Qnil, 0, 0, 0, 0);
+ staticpro (&Vcharset_ucs_jis);
+ Vcharset_ucs_jis =
+ make_charset (LEADING_BYTE_UCS_JIS, Qucs_jis, 256, 3,
+ 1, 2, 0, CHARSET_LEFT_TO_RIGHT,
+ build_string ("UCS for JIS"),
+ build_string ("UCS for JIS X 0208, 0212 and 0213"),
+ build_string ("ISO/IEC 10646 for JIS X 0208, 0212 and 0213"),
+ build_string (""),
+ Qnil, 0, 0, 0, 0);
staticpro (&Vcharset_ucs_big5);
Vcharset_ucs_big5 =
make_charset (LEADING_BYTE_UCS_BIG5, Qucs_big5, 256, 3,