Copyright (C) 1995, 1996 Ben Wing.
Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
Licensed to the Free Software Foundation.
- Copyright (C) 1999,2000,2001,2002,2003 MORIOKA Tomohiko
+ Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko
This file is part of XEmacs.
loosely based on the original Mule.
Jareth Hein: fixed a couple of bugs in the implementation, and
added regex support for categories with check_category_at
- MORIOKA Tomohiko: Rewritten for XEmacs UTF-2000
+ MORIOKA Tomohiko: Rewritten for XEmacs CHISE
*/
#include <config.h>
EXFUN (Fchar_refs_simplify_char_specs, 1);
extern Lisp_Object Qideographic_structure;
+Lisp_Object Vnext_defined_char_id;
+EXFUN (Fdefine_char, 1);
+
EXFUN (Fmap_char_attribute, 3);
#ifdef HAVE_LIBCHISE
Lisp_Object Qcomposition;
Lisp_Object Q_decomposition;
+Lisp_Object Q_denotational;
+Lisp_Object Q_denotational_from;
+Lisp_Object Q_subsumptive;
+Lisp_Object Q_subsumptive_from;
Lisp_Object Qto_ucs;
Lisp_Object Q_ucs_unified;
Lisp_Object Qcompat;
modifier = Fcar (rest);
rest = Fcdr (rest);
base = Fcdr (Fassq (modifier,
- Fget_char_attribute (base, Qcomposition, Qnil)));
+ Fchar_feature (base, Qcomposition, Qnil,
+ Qnil, Qnil)));
}
return base;
}
Lisp_Object ret;
CHECK_CHAR (character);
- ret = Fget_char_attribute (character, Q_ucs_unified, Qnil);
+ ret = Fchar_feature (character, Q_ucs_unified, Qnil,
+ Qnil, Qnil);
if (CONSP (ret))
return Fcopy_list (ret);
else
if (NILP (ret))
{
if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
- ret = Fget_char_attribute (make_char (ch), Q_lowercase, Qnil);
+ ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
+ Qnil, Qnil);
else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
- ret = Fget_char_attribute (make_char (ch), Q_uppercase, Qnil);
+ ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
+ Qnil, Qnil);
if (CONSP (ret))
{
ret = XCAR (ret);
switch (range->type)
{
case CHARTAB_RANGE_ALL:
- /* printf ("put-char-table: range = all\n"); */
fill_char_table (ct, val);
return; /* avoid the duplicate call to update_syntax_table() below,
since fill_char_table() also did that. */
{
Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
- /* printf ("put-char-table: range = charset: %d\n",
- XCHARSET_LEADING_BYTE (range->charset));
- */
if ( CHAR_TABLEP (encoding_table) )
{
Lisp_Object mother = XCHARSET_MOTHER (range->charset);
cell_max = i & 0xFF;
for (i = cell_min; i <= cell_max; i++)
{
- Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
+ Emchar ch
+ = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
if ( charset_code_point (range->charset, ch, 0) >= 0 )
put_char_id_table_0 (ct, ch, val);
case CHARTAB_RANGE_CHAR:
#ifdef UTF2000
- /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
put_char_id_table_0 (ct, range->ch, val);
break;
#elif defined(MULE)
rainj.type = CHARTAB_RANGE_CHAR;
for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
{
- Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
+ Emchar ch
+ = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
if ( charset_code_point (range->charset, ch, 0) >= 0 )
{
return default_value;
}
+DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
+Return the value of CHARACTER's FEATURE.
+Return DEFAULT-VALUE if the value is not exist.
+*/
+ (character, attribute, default_value,
+ feature_rel_max, char_rel_max))
+{
+ Lisp_Object ret
+ = Fget_char_attribute (character, attribute, Qunbound);
+
+ if (!UNBOUNDP (ret))
+ return ret;
+
+ if (NILP (feature_rel_max)
+ || (INTP (feature_rel_max) &&
+ XINT (feature_rel_max) > 0))
+ {
+ Lisp_String* name = symbol_name (XSYMBOL (attribute));
+ Bufbyte *name_str = string_data (name);
+
+ if (name_str[0] == '=' && name_str[1] == '>')
+ {
+ Bytecount length = string_length (name) - 1;
+ Lisp_Object map_to = make_uninit_string (length);
+
+ memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
+ XSTRING_DATA(map_to)[0] = '=';
+ ret = Fchar_feature (character, Fintern (map_to, Qnil),
+ Qunbound,
+ NILP (feature_rel_max)
+ ? feature_rel_max
+ : make_int (XINT (feature_rel_max) - 1),
+ char_rel_max);
+ if (!UNBOUNDP (ret))
+ return ret;
+ }
+ }
+
+ if ( !(EQ (attribute, Q_subsumptive_from)) &&
+ !(EQ (attribute, Q_denotational_from)) &&
+ ( (NILP (char_rel_max)
+ || (INTP (char_rel_max) &&
+ XINT (char_rel_max) > 0)) ) )
+ {
+ Lisp_String* name = symbol_name (XSYMBOL (attribute));
+ Bufbyte *name_str = string_data (name);
+
+ if ( (name_str[0] != '=') || (name_str[1] == '>') )
+ {
+ Lisp_Object ancestors
+ = Fget_char_attribute (character, Q_subsumptive_from, Qnil);
+
+ if (NILP (ancestors))
+ ancestors
+ = Fget_char_attribute (character, Q_denotational_from, Qnil);
+
+ while (!NILP (ancestors))
+ {
+ Lisp_Object ancestor = XCAR (ancestors);
+
+ if (!EQ (ancestor, character))
+ {
+ ret = Fchar_feature (ancestor, attribute, Qunbound,
+ Qnil, make_int (0));
+ if (!UNBOUNDP (ret))
+ return ret;
+
+ ancestors = XCDR (ancestors);
+ ret = Fget_char_attribute (ancestor,
+ Q_subsumptive_from, Qnil);
+ if (!NILP (ret))
+ ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
+ }
+ else
+ return default_value;
+ /* ancestors = XCDR (ancestors); */
+ }
+ }
+ }
+ return default_value;
+}
+
void put_char_composition (Lisp_Object character, Lisp_Object value);
void
put_char_composition (Lisp_Object character, Lisp_Object value)
if (CHARP (base))
{
Lisp_Object alist
- = Fget_char_attribute (base, Qcomposition, Qnil);
+ = Fchar_feature (base, Qcomposition, Qnil,
+ Qnil, Qnil);
Lisp_Object ret = Fassq (modifier, alist);
if (NILP (ret))
{
Emchar c = XINT (v);
Lisp_Object ret
- = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil);
+ = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
+ Qnil, Qnil);
if (!CONSP (ret))
{
}
}
+static Lisp_Object
+put_char_attribute (Lisp_Object character, Lisp_Object attribute,
+ Lisp_Object value)
+{
+ 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);
+#ifdef HAVE_CHISE
+ XCHAR_TABLE_NAME (table) = attribute;
+#endif
+ }
+ put_char_id_table (XCHAR_TABLE(table), character, value);
+ return value;
+}
+
DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
Store CHARACTER's ATTRIBUTE with VALUE.
*/
c = XINT (value);
- ret = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil);
+ ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
+ Qnil, Qnil);
if (!CONSP (ret))
- {
- Fput_char_attribute (make_char (c), Q_ucs_unified,
- Fcons (character, Qnil));
- }
+ put_char_attribute (make_char (c), Q_ucs_unified,
+ list1 (character));
else if (NILP (Fmemq (character, ret)))
+ Fput_char_attribute (make_char (c), Q_ucs_unified,
+ Fcons (character, ret));
+ }
+ else if ( EQ (attribute, Q_subsumptive) ||
+ EQ (attribute, Q_subsumptive_from) ||
+ EQ (attribute, Q_denotational) ||
+ EQ (attribute, Q_denotational_from) )
+ {
+ Lisp_Object rest = value;
+ Lisp_Object ret;
+
+ while (CONSP (rest))
{
- Fput_char_attribute (make_char (c), Q_ucs_unified,
- Fcons (character, ret));
+ ret = XCAR (rest);
+
+ if (CONSP (ret))
+ ret = Fdefine_char (ret);
+
+ if ( !NILP (ret) && !EQ (ret, character) )
+ {
+ Lisp_Object rev_feature;
+ Lisp_Object ffv;
+
+ if (EQ (attribute, Q_subsumptive))
+ rev_feature = Q_subsumptive_from;
+ else if (EQ (attribute, Q_subsumptive_from))
+ rev_feature = Q_subsumptive;
+ else if (EQ (attribute, Q_denotational))
+ rev_feature = Q_denotational_from;
+ else /* if (EQ (attribute, Q_denotational_from)) */
+ rev_feature = Q_denotational;
+
+ ffv = Fget_char_attribute (ret, rev_feature, Qnil);
+ if (!CONSP (ffv))
+ put_char_attribute (ret, rev_feature, list1 (character));
+ else if (NILP (Fmemq (character, ffv)))
+ put_char_attribute (ret, rev_feature,
+ Fcons (character, ffv));
+ Fsetcar (rest, ret);
+ }
+ rest = XCDR (rest);
}
}
#if 0
else if (EQ (attribute, Qideographic_structure))
value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
#endif
- {
- 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);
-#ifdef HAVE_CHISE
- XCHAR_TABLE_NAME (table) = attribute;
-#endif
- }
- put_char_id_table (XCHAR_TABLE(table), character, value);
- return value;
- }
+ return put_char_attribute (character, attribute, value);
}
DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
if (CONSP (cell))
character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
else
- character = Fdecode_char (ccs, cell, Qnil);
+ character = Fdecode_char (ccs, cell, Qnil, Qt);
if (!NILP (character))
goto setup_attributes;
}
rest = Fcdr (rest);
}
+#if 1
+ {
+ int cid = XINT (Vnext_defined_char_id);
+
+ if (cid <= 0xE00000)
+ {
+ character = make_char (cid);
+ Vnext_defined_char_id = make_int (cid + 1);
+ goto setup_attributes;
+ }
+ }
+#else
if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
{
if (!INTP (code))
character = make_char (XINT (code) + 0x100000);
goto setup_attributes;
}
+#endif
return Qnil;
}
else if (!INTP (code))
if (CONSP (cell))
return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
else
- return Fdecode_char (ccs, cell, Qnil);
+ return Fdecode_char (ccs, cell, Qnil, Qnil);
}
rest = Fcdr (rest);
}
defsymbol (&Qto_ucs, "=>ucs");
defsymbol (&Q_ucs_unified, "->ucs-unified");
+ defsymbol (&Q_subsumptive, "->subsumptive");
+ defsymbol (&Q_subsumptive_from, "<-subsumptive");
+ defsymbol (&Q_denotational, "->denotational");
+ defsymbol (&Q_denotational_from, "<-denotational");
defsymbol (&Qcomposition, "composition");
defsymbol (&Q_decomposition, "->decomposition");
defsymbol (&Qcompat, "compat");
#endif
DEFSUBR (Fload_char_attribute_table);
#endif
+ DEFSUBR (Fchar_feature);
DEFSUBR (Fchar_attribute_alist);
DEFSUBR (Fget_char_attribute);
DEFSUBR (Fput_char_attribute);
void
vars_of_chartab (void)
{
+#ifdef UTF2000
+ DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
+*/ );
+ Vnext_defined_char_id = make_int (0x0F0000);
+#endif
+
#ifdef HAVE_CHISE
DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
*/ );
projects / chise / xemacs-chise.git.1 / blobdiff