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>
#endif /* MULE */
\f
+#ifdef HAVE_LIBCHISE
+Lisp_Object Vchise_db_directory;
+Lisp_Object Vchise_system_db_directory;
+
+CHISE_DS *default_chise_data_source = NULL;
+#endif
+
#ifdef UTF2000
EXFUN (Fchar_refs_simplify_char_specs, 1);
extern Lisp_Object Qideographic_structure;
+Lisp_Object Vnext_defined_char_id;
+
EXFUN (Fmap_char_attribute, 3);
-#if defined(HAVE_CHISE_CLIENT)
+#ifdef HAVE_LIBCHISE
+EXFUN (Fmount_char_attribute_table, 1);
+#endif
+
+#ifdef HAVE_CHISE
EXFUN (Fload_char_attribute_table, 1);
Lisp_Object Vchar_db_stingy_mode;
return retval;
}
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
static void
save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
+#ifdef HAVE_LIBCHISE
+ CHISE_Feature feature,
+#else
Lisp_Object db,
+#endif
Emchar ofs, int place,
Lisp_Object (*filter)(Lisp_Object value))
{
c1 = c + unit;
for (; c < c1 && retval == 0; c++)
{
+#ifdef HAVE_LIBCHISE
+ chise_char_set_feature_value
+ (c, feature,
+ XSTRING_DATA
+ (Fprin1_to_string (UINT8_DECODE (ct->property[i]),
+ Qnil)));
+#else
Fput_database (Fprin1_to_string (make_char (c), Qnil),
Fprin1_to_string (UINT8_DECODE (ct->property[i]),
Qnil),
db, Qt);
+#endif
}
}
else
return retval;
}
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
static void
save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
+#ifdef HAVE_LIBCHISE
+ CHISE_Feature feature,
+#else
Lisp_Object db,
+#endif
Emchar ofs, int place,
Lisp_Object (*filter)(Lisp_Object value))
{
c1 = c + unit;
for (; c < c1 && retval == 0; c++)
{
+#ifdef HAVE_LIBCHISE
+ chise_char_set_feature_value
+ (c, feature,
+ XSTRING_DATA
+ (Fprin1_to_string (UINT16_DECODE (ct->property[i]),
+ Qnil)));
+#else
Fput_database (Fprin1_to_string (make_char (c), Qnil),
Fprin1_to_string (UINT16_DECODE (ct->property[i]),
Qnil),
db, Qt);
+#endif
}
}
else
return retval;
}
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
static void
save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
+#ifdef HAVE_LIBCHISE
+ CHISE_Feature feature,
+#else
Lisp_Object db,
+#endif
Emchar ofs, int place,
Lisp_Object (*filter)(Lisp_Object value))
{
v = ct->property[i];
if (UINT8_BYTE_TABLE_P (v))
{
- save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root, db,
+ save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
+#ifdef HAVE_LIBCHISE
+ feature,
+#else
+ db,
+#endif
c, place - 1, filter);
c += unit;
}
else if (UINT16_BYTE_TABLE_P (v))
{
- save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root, db,
+ save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
+#ifdef HAVE_LIBCHISE
+ feature,
+#else
+ db,
+#endif
c, place - 1, filter);
c += unit;
}
else if (BYTE_TABLE_P (v))
{
- save_byte_table (XBYTE_TABLE(v), root, db,
+ save_byte_table (XBYTE_TABLE(v), root,
+#ifdef HAVE_LIBCHISE
+ feature,
+#else
+ db,
+#endif
c, place - 1, filter);
c += unit;
}
for (; c < c1 && retval == 0; c++)
{
+#ifdef HAVE_LIBCHISE
+ chise_char_set_feature_value
+ (c, feature, XSTRING_DATA (Fprin1_to_string (v, Qnil)));
+#else
Fput_database (Fprin1_to_string (make_char (c), Qnil),
Fprin1_to_string (v, Qnil),
db, Qt);
+#endif
}
}
else
}
-Lisp_Object Qsystem_char_id;
-
Lisp_Object Qcomposition;
Lisp_Object Q_decomposition;
+Lisp_Object Q_identical;
+Lisp_Object Q_identical_from;
+Lisp_Object Q_denotational;
+Lisp_Object Q_denotational_from;
+Lisp_Object Q_subsumptive;
+Lisp_Object Q_subsumptive_from;
+Lisp_Object Q_component;
+Lisp_Object Q_component_of;
Lisp_Object Qto_ucs;
-Lisp_Object Q_ucs_variants;
+Lisp_Object Q_ucs_unified;
Lisp_Object Qcompat;
Lisp_Object Qisolated;
Lisp_Object Qinitial;
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;
}
*/
(character))
{
- Lisp_Object ret;
-
CHECK_CHAR (character);
- ret = Fget_char_attribute (character, Q_ucs_variants, Qnil);
- if (CONSP (ret))
- return Fcopy_list (ret);
- else
- return Qnil;
+ return
+ nconc2
+ (Fcopy_list (Fget_char_attribute (character, Q_subsumptive, Qnil)),
+ (nconc2
+ (Fcopy_list (Fget_char_attribute (character, Q_denotational, Qnil)),
+ (nconc2
+ (Fcopy_list (Fget_char_attribute (character, Q_identical, Qnil)),
+ Fcopy_list (Fchar_feature (character, Q_ucs_unified, Qnil,
+ Qnil, Qnil)))))));
}
#endif
mark_object (ct->table);
mark_object (ct->name);
+#ifndef HAVE_LIBCHISE
mark_object (ct->db);
+#endif
#else
int i;
{
switch (type)
{
- default: abort();
+ default: ABORT();
case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
return CHAR_TABLE_TYPE_GENERIC; /* not reached */
}
+#ifndef UTF2000
static void
print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
Lisp_Object printcharfun)
}
print_internal (val, printcharfun, 1);
}
+#endif
#if defined(MULE)&&!defined(UTF2000)
{ XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
{ XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
{ XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
+#ifndef HAVE_LIBCHISE
{ XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
+#endif
#else
{ XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
#ifdef MULE
break;
default:
- abort ();
+ ABORT ();
}
return Qnil;
ct->mirror_table = Qnil;
#else
ct->name = Qnil;
+#ifndef HAVE_LIBCHISE
ct->db = Qnil;
#endif
+#endif
ct->next_table = Qnil;
XSETCHAR_TABLE (obj, ct);
if (ty == CHAR_TABLE_TYPE_SYNTAX)
ctnew->default_value = ct->default_value;
/* [tomo:2002-01-21] Perhaps this code seems wrong */
ctnew->name = ct->name;
+#ifndef HAVE_LIBCHISE
ctnew->db = ct->db;
+#endif
if (UINT8_BYTE_TABLE_P (ct->table))
{
return (0 << 8) | 255;
#endif
default:
- abort ();
+ ABORT ();
return 0;
}
}
}
#endif
else
- abort ();
+ ABORT ();
}
else
{
{
Lisp_Object ret = get_char_id_table (ct, ch);
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
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);
#endif /* not MULE */
default:
- abort ();
+ ABORT ();
}
return Qnil; /* not reached */
break;
default:
- abort ();
+ ABORT ();
}
return 0; /* not reached */
*/
(c, value))
{
- put_char_id_table_0 (char_attribute_table_to_put, c, value_to_put);
+ put_char_id_table_0 (char_attribute_table_to_put,
+ XCHAR (c), value_to_put);
return Qnil;
}
#endif
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);
+
char_attribute_table_to_put = ct;
value_to_put = val;
Fmap_char_attribute (Qput_char_table_map_function,
XCHAR_TABLE_NAME (encoding_table),
Qnil);
+ if ( CHARSETP (mother) )
+ {
+ struct chartab_range r;
+
+ r.type = CHARTAB_RANGE_CHARSET;
+ r.charset = mother;
+ put_char_table (ct, &r, val);
+ }
}
#if 0
else
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)
break;
default:
- abort ();
+ ABORT ();
}
return 0;
struct chartab_range rainj;
struct map_char_table_for_charset_arg mcarg;
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
if (XCHAR_TABLE_UNLOADED(encoding_table))
Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
#endif
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 )
{
}
default:
- abort ();
+ ABORT ();
}
return 0;
ranjarg = make_char (range->ch);
break;
default:
- abort ();
+ ABORT ();
}
closure->retval = call2 (closure->function, ranjarg, val);
return 0;
}
+#ifdef HAVE_LIBCHISE
+static int
+char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
+{
+ Fmount_char_attribute_table (intern (name));
+ return 0;
+}
+
+DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
+Return the list of all existing character attributes except coded-charsets.
+*/
+ (rehash))
+#else
DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
Return the list of all existing character attributes except coded-charsets.
*/
())
+#endif
{
Lisp_Object char_attribute_list = Qnil;
struct gcpro gcpro1;
struct char_attribute_list_closure char_attribute_list_closure;
+#ifdef HAVE_LIBCHISE
+ if (!NILP (rehash))
+ {
+ open_chise_data_source_maybe ();
+ chise_ds_foreach_char_feature_name
+ (default_chise_data_source, &char_attribute_list_reset_map_func);
+ }
+#endif
GCPRO1 (char_attribute_list);
char_attribute_list_closure.char_attribute_list = &char_attribute_list;
elisp_maphash (add_char_attribute_to_list_mapper,
return default_value;
}
+static Lisp_Object
+find_char_feature_in_family (Lisp_Object character,
+ Lisp_Object con_feature,
+ Lisp_Object feature,
+ Lisp_Object feature_rel_max)
+{
+ Lisp_Object ancestors
+ = Fget_char_attribute (character, con_feature, Qnil);
+
+ while (!NILP (ancestors))
+ {
+ Lisp_Object ancestor = XCAR (ancestors);
+ Lisp_Object ret;
+
+ if (EQ (ancestor, character))
+ return Qunbound;
+
+ ret = Fchar_feature (ancestor, feature, 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);
+
+ ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
+ if (!NILP (ret))
+ ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
+ }
+ return Qunbound;
+}
+
+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_identical)) &&
+ !(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] == '>') )
+ {
+ ret = find_char_feature_in_family (character, Q_identical,
+ attribute, feature_rel_max);
+ if (!UNBOUNDP (ret))
+ return ret;
+
+ ret = find_char_feature_in_family (character, Q_subsumptive_from,
+ attribute, feature_rel_max);
+ if (!UNBOUNDP (ret))
+ return ret;
+
+ ret = find_char_feature_in_family (character, Q_denotational_from,
+ attribute, feature_rel_max);
+ if (!UNBOUNDP (ret))
+ return ret;
+ }
+ }
+ 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))
if (INTP (v))
{
- Emchar c = XINT (v);
+ Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
Lisp_Object ret
- = Fget_char_attribute (make_char (c), Q_ucs_variants, Qnil);
+ = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
+ Qnil, Qnil);
if (!CONSP (ret))
{
- Fput_char_attribute (make_char (c), Q_ucs_variants,
+ Fput_char_attribute (make_char (c), Q_ucs_unified,
Fcons (character, Qnil));
}
else if (NILP (Fmemq (character, ret)))
{
- Fput_char_attribute (make_char (c), Q_ucs_variants,
+ Fput_char_attribute (make_char (c), Q_ucs_unified,
Fcons (character, 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.
*/
if (!INTP (value))
signal_simple_error ("Invalid value for =>ucs", value);
- c = XINT (value);
+ c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
- ret = Fget_char_attribute (make_char (c), Q_ucs_variants, Qnil);
+ ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
+ Qnil, Qnil);
if (!CONSP (ret))
+ 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) ||
+ EQ (attribute, Q_identical) ||
+ EQ (attribute, Q_identical_from) ||
+ EQ (attribute, Q_component) ||
+ EQ (attribute, Q_component_of) ||
+ !NILP (Fstring_match
+ (build_string ("^\\(<-\\|->\\)\\("
+ "fullwidth\\|halfwidth"
+ "\\|simplified\\|vulgar\\|wrong"
+ "\\|same\\|original\\|ancient"
+ "\\|Oracle-Bones\\)[^*]*$"),
+ Fsymbol_name (attribute),
+ Qnil, Qnil)) )
+ {
+ Lisp_Object rest = value;
+ Lisp_Object ret;
+ Lisp_Object rev_feature = Qnil;
+ struct gcpro gcpro1;
+ GCPRO1 (rev_feature);
+
+ if (EQ (attribute, Q_identical))
+ rev_feature = Q_identical_from;
+ else if (EQ (attribute, Q_identical_from))
+ rev_feature = Q_identical;
+ else 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;
+ else if (EQ (attribute, Q_component))
+ rev_feature = Q_component_of;
+ else if (EQ (attribute, Q_component_of))
+ rev_feature = Q_component;
+ else
{
- Fput_char_attribute (make_char (c), Q_ucs_variants,
- Fcons (character, Qnil));
+ Lisp_String* name = symbol_name (XSYMBOL (attribute));
+ Bufbyte *name_str = string_data (name);
+
+ if ( (name_str[0] == '<' && name_str[1] == '-') ||
+ (name_str[0] == '-' && name_str[1] == '>') )
+ {
+ Bytecount length = string_length (name);
+ Bufbyte *rev_name_str = alloca (length + 1);
+
+ memcpy (rev_name_str + 2, name_str + 2, length - 2);
+ if (name_str[0] == '<')
+ {
+ rev_name_str[0] = '-';
+ rev_name_str[1] = '>';
+ }
+ else
+ {
+ rev_name_str[0] = '<';
+ rev_name_str[1] = '-';
+ }
+ rev_name_str[length] = 0;
+ rev_feature = intern (rev_name_str);
+ }
}
- else if (NILP (Fmemq (character, ret)))
+
+ while (CONSP (rest))
{
- Fput_char_attribute (make_char (c), Q_ucs_variants,
- Fcons (character, ret));
+ ret = XCAR (rest);
+
+ if (CONSP (ret))
+ ret = Fdefine_char (ret);
+
+ if ( !NILP (ret) && !EQ (ret, character) )
+ {
+ Lisp_Object ffv;
+
+ 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,
+ nconc2 (Fcopy_sequence (ffv), list1 (character)));
+ Fsetcar (rest, ret);
+ }
+ rest = XCDR (rest);
}
+ UNGCPRO;
}
-#if 0
+#if 1
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_CLIENT
- 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, /*
return Qnil;
}
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
+
+int char_table_open_db_maybe (Lisp_Char_Table* cit);
+void char_table_close_db_maybe (Lisp_Char_Table* cit);
+Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
+
+#ifdef HAVE_LIBCHISE
+int
+open_chise_data_source_maybe ()
+{
+ if (default_chise_data_source == NULL)
+ {
+ Lisp_Object db_dir = Vdata_directory;
+ int modemask = 0755; /* rwxr-xr-x */
+
+ if (NILP (db_dir))
+ db_dir = build_string ("../etc");
+ db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
+
+ default_chise_data_source
+ = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
+ 0 /* DB_HASH */, modemask);
+ if (default_chise_data_source == NULL)
+ return -1;
+#if 0
+ chise_ds_set_make_string_function (default_chise_data_source,
+ &make_string);
+#endif
+ }
+ return 0;
+}
+#endif /* HAVE_LIBCHISE */
+
+DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
+Close data-source of CHISE.
+*/
+ ())
+{
+#ifdef HAVE_LIBCHISE
+ int status = CHISE_DS_close (default_chise_data_source);
+
+ default_chise_data_source = NULL;
+ if (status)
+ return Qt;
+#endif /* HAVE_LIBCHISE */
+ return Qnil;
+}
+
+int
+char_table_open_db_maybe (Lisp_Char_Table* cit)
+{
+ Lisp_Object attribute = CHAR_TABLE_NAME (cit);
+
+ if (!NILP (attribute))
+ {
+#ifdef HAVE_LIBCHISE
+ if ( open_chise_data_source_maybe () )
+ return -1;
+#else /* HAVE_LIBCHISE */
+ if (NILP (Fdatabase_live_p (cit->db)))
+ {
+ Lisp_Object db_file
+ = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
+
+ cit->db = Fopen_database (db_file, Qnil, Qnil,
+ build_string ("r"), Qnil);
+ if (NILP (cit->db))
+ return -1;
+ }
+#endif /* not HAVE_LIBCHISE */
+ return 0;
+ }
+ else
+ return -1;
+}
+
+void
+char_table_close_db_maybe (Lisp_Char_Table* cit)
+{
+#ifndef HAVE_LIBCHISE
+ if (!NILP (cit->db))
+ {
+ if (!NILP (Fdatabase_live_p (cit->db)))
+ Fclose_database (cit->db);
+ cit->db = Qnil;
+ }
+#endif /* not HAVE_LIBCHISE */
+}
+
+Lisp_Object
+char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
+{
+ Lisp_Object val;
+#ifdef HAVE_LIBCHISE
+ CHISE_Value value;
+ int status
+ = chise_ds_load_char_feature_value (default_chise_data_source, ch,
+ XSTRING_DATA(Fsymbol_name
+ (cit->name)),
+ &value);
+
+ if (!status)
+ {
+#if 0
+ val = Fread (make_string (chise_value_data (&value),
+ chise_value_size (&value) ));
+#else
+ val = read_from_c_string (chise_value_data (&value),
+ chise_value_size (&value) );
+#endif
+ }
+ else
+ val = Qunbound;
+#else /* HAVE_LIBCHISE */
+ val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
+ cit->db, Qunbound);
+ if (!UNBOUNDP (val))
+ val = Fread (val);
+ else
+ val = Qunbound;
+#endif /* not HAVE_LIBCHISE */
+ return val;
+}
+
+#ifndef HAVE_LIBCHISE
Lisp_Object
char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
int writing_mode)
{
- Lisp_Object db_dir = Vexec_directory;
+ Lisp_Object db_dir = Vdata_directory;
if (NILP (db_dir))
- db_dir = build_string ("../lib-src");
+ db_dir = build_string ("../etc");
- db_dir = Fexpand_file_name (build_string ("char-db"), db_dir);
+ db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
if (writing_mode && NILP (Ffile_exists_p (db_dir)))
Fmake_directory_internal (db_dir);
UNGCPRO;
return Fexpand_file_name (dest, db_dir);
}
-#if 0
- return Fexpand_file_name (Fsymbol_name (attribute), db_dir);
-#endif
}
+#endif /* not HAVE_LIBCHISE */
DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
Save values of ATTRIBUTE into database file.
*/
(attribute))
{
-#ifdef HAVE_CHISE_CLIENT
Lisp_Object table = Fgethash (attribute,
Vchar_attribute_hash_table, Qunbound);
Lisp_Char_Table *ct;
+#ifdef HAVE_LIBCHISE
+ CHISE_Feature feature;
+#else /* HAVE_LIBCHISE */
Lisp_Object db_file;
Lisp_Object db;
+#endif /* not HAVE_LIBCHISE */
if (CHAR_TABLEP (table))
ct = XCHAR_TABLE (table);
else
return Qnil;
+#ifdef HAVE_LIBCHISE
+ if ( open_chise_data_source_maybe () )
+ return -1;
+ feature
+ = chise_ds_get_feature (default_chise_data_source,
+ XSTRING_DATA (Fsymbol_name (attribute)));
+#else /* HAVE_LIBCHISE */
db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
- if (!NILP (db))
+#endif /* not HAVE_LIBCHISE */
+ if (
+#ifdef HAVE_LIBCHISE
+ feature != NULL
+#else /* HAVE_LIBCHISE */
+ !NILP (db)
+#endif /* not HAVE_LIBCHISE */
+ )
{
Lisp_Object (*filter)(Lisp_Object value);
- if (EQ (attribute, Qideographic_structure))
+ if ( !NILP (Ffind_charset (attribute)) )
+ filter = NULL;
+ else if ( EQ (attribute, Qideographic_structure)
+ || EQ (attribute, Q_identical)
+ || EQ (attribute, Q_identical_from)
+ || !NILP (Fstring_match
+ (build_string ("^\\(<-\\|->\\)\\(simplified"
+ "\\|same\\|vulgar\\|wrong"
+ "\\|original\\|ancient"
+ "\\|Oracle-Bones\\)[^*]*$"),
+ Fsymbol_name (attribute),
+ Qnil, Qnil)) )
filter = &Fchar_refs_simplify_char_specs;
else
filter = NULL;
if (UINT8_BYTE_TABLE_P (ct->table))
- save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, db,
+ save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
+#ifdef HAVE_LIBCHISE
+ feature,
+#else /* HAVE_LIBCHISE */
+ db,
+#endif /* not HAVE_LIBCHISE */
0, 3, filter);
else if (UINT16_BYTE_TABLE_P (ct->table))
- save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, db,
+ save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
+#ifdef HAVE_LIBCHISE
+ feature,
+#else /* HAVE_LIBCHISE */
+ db,
+#endif /* not HAVE_LIBCHISE */
0, 3, filter);
else if (BYTE_TABLE_P (ct->table))
- save_byte_table (XBYTE_TABLE(ct->table), ct, db, 0, 3, filter);
+ save_byte_table (XBYTE_TABLE(ct->table), ct,
+#ifdef HAVE_LIBCHISE
+ feature,
+#else /* HAVE_LIBCHISE */
+ db,
+#endif /* not HAVE_LIBCHISE */
+ 0, 3, filter);
+#ifdef HAVE_LIBCHISE
+ chise_feature_sync (feature);
+#else /* HAVE_LIBCHISE */
Fclose_database (db);
+#endif /* not HAVE_LIBCHISE */
return Qt;
}
else
return Qnil;
-#else
- return Qnil;
-#endif
}
DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
*/
(attribute))
{
-#ifdef HAVE_CHISE_CLIENT
Lisp_Object table = Fgethash (attribute,
Vchar_attribute_hash_table, Qunbound);
ct = XCHAR_TABLE (table);
ct->table = Qunloaded;
XCHAR_TABLE_UNLOADED(table) = 1;
+#ifndef HAVE_LIBCHISE
ct->db = Qnil;
+#endif /* not HAVE_LIBCHISE */
return Qt;
}
-#endif
return Qnil;
}
*/
(attribute))
{
-#ifdef HAVE_CHISE_CLIENT
Lisp_Object table = Fgethash (attribute,
Vchar_attribute_hash_table, Qunbound);
Lisp_Char_Table *ct;
ct = XCHAR_TABLE (table);
else
return Qnil;
-
- if (!NILP (ct->db))
- {
- if (!NILP (Fdatabase_live_p (ct->db)))
- Fclose_database (ct->db);
- ct->db = Qnil;
- }
-#endif
+ char_table_close_db_maybe (ct);
return Qnil;
}
*/
(attribute))
{
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_LIBCHISE
+ CHISE_Feature feature
+ = chise_ds_get_feature (default_chise_data_source,
+ XSTRING_DATA (Fsymbol_name
+ (attribute)));
+
+ if (feature == NULL)
+ return Qnil;
+
+ if (chise_feature_setup_db (feature, 0) == 0)
+ {
+ Lisp_Object table = Fgethash (attribute,
+ Vchar_attribute_hash_table, Qunbound);
+ Lisp_Char_Table *ct;
+
+ chise_feature_sync (feature);
+ if (UNBOUNDP (table))
+ {
+ table = make_char_id_table (Qunbound);
+ Fputhash (attribute, table, Vchar_attribute_hash_table);
+ XCHAR_TABLE_NAME(table) = attribute;
+ }
+ ct = XCHAR_TABLE (table);
+ ct->table = Qunloaded;
+ char_table_close_db_maybe (ct);
+ XCHAR_TABLE_UNLOADED(table) = 1;
+ return Qt;
+ }
+#else
Lisp_Object table = Fgethash (attribute,
Vchar_attribute_hash_table, Qunbound);
Lisp_Char_Table *ct;
}
ct = XCHAR_TABLE (table);
ct->table = Qunloaded;
- if (!NILP (Fdatabase_live_p (ct->db)))
- Fclose_database (ct->db);
- ct->db = Qnil;
+ char_table_close_db_maybe (ct);
XCHAR_TABLE_UNLOADED(table) = 1;
return Qt;
}
if (!NILP (attribute))
{
- if (NILP (Fdatabase_live_p (cit->db)))
- {
- Lisp_Object db_file
- = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
+ Lisp_Object val;
- cit->db = Fopen_database (db_file, Qnil, Qnil,
- build_string ("r"), Qnil);
- }
- if (!NILP (cit->db))
- {
- Lisp_Object val
- = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
- cit->db, Qunbound);
- if (!UNBOUNDP (val))
- val = Fread (val);
- else
- val = Qunbound;
- if (!NILP (Vchar_db_stingy_mode))
- {
- Fclose_database (cit->db);
- cit->db = Qnil;
- }
- return val;
- }
+ if (char_table_open_db_maybe (cit))
+ return Qunbound;
+
+ val = char_table_get_db (cit, ch);
+
+ if (!NILP (Vchar_db_stingy_mode))
+ char_table_close_db_maybe (cit);
+
+ return val;
}
return Qunbound;
}
Lisp_Char_Table* char_attribute_table_to_load;
+#ifdef HAVE_LIBCHISE
+int
+load_char_attribute_table_map_func (CHISE_Char_ID cid,
+ CHISE_Feature feature,
+ CHISE_Value *value);
+int
+load_char_attribute_table_map_func (CHISE_Char_ID cid,
+ CHISE_Feature feature,
+ CHISE_Value *value)
+{
+ Emchar code = cid;
+ Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
+
+ if (EQ (ret, Qunloaded))
+ put_char_id_table_0 (char_attribute_table_to_load, code,
+ Fread (make_string ((Bufbyte *) value->data,
+ value->size)));
+ return 0;
+}
+#else /* HAVE_LIBCHISE */
Lisp_Object Qload_char_attribute_table_map_function;
DEFUN ("load-char-attribute-table-map-function",
put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
return Qnil;
}
+#endif /* not HAVE_LIBCHISE */
DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
Load values of ATTRIBUTE into database file.
Qunbound);
if (CHAR_TABLEP (table))
{
- Lisp_Char_Table *ct = XCHAR_TABLE (table);
+ Lisp_Char_Table *cit = XCHAR_TABLE (table);
- if (NILP (Fdatabase_live_p (ct->db)))
- {
- Lisp_Object db_file
- = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
+ if (char_table_open_db_maybe (cit))
+ return Qnil;
- ct->db = Fopen_database (db_file, Qnil, Qnil,
- build_string ("r"), Qnil);
- }
- if (!NILP (ct->db))
- {
- struct gcpro gcpro1;
-
- char_attribute_table_to_load = XCHAR_TABLE (table);
- GCPRO1 (table);
- Fmap_database (Qload_char_attribute_table_map_function, ct->db);
- UNGCPRO;
- Fclose_database (ct->db);
- ct->db = Qnil;
- XCHAR_TABLE_UNLOADED(table) = 0;
- return Qt;
- }
+ char_attribute_table_to_load = XCHAR_TABLE (table);
+ {
+ struct gcpro gcpro1;
+
+ GCPRO1 (table);
+#ifdef HAVE_LIBCHISE
+ chise_feature_foreach_char_with_value
+ (chise_ds_get_feature (default_chise_data_source,
+ XSTRING_DATA (Fsymbol_name (cit->name))),
+ &load_char_attribute_table_map_func);
+#else /* HAVE_LIBCHISE */
+ Fmap_database (Qload_char_attribute_table_map_function, cit->db);
+#endif /* not HAVE_LIBCHISE */
+ UNGCPRO;
+ }
+ char_table_close_db_maybe (cit);
+ XCHAR_TABLE_UNLOADED(table) = 0;
+ return Qt;
}
return Qnil;
}
-#endif
+#endif /* HAVE_CHISE */
DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
if (NILP (range))
range = Qt;
decode_char_table_range (range, &rainj);
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
if (CHAR_TABLE_UNLOADED(ct))
Fload_char_attribute_table (attribute);
#endif
*/
(attributes))
{
- Lisp_Object rest = attributes;
+ Lisp_Object rest;
Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
Lisp_Object character;
if (NILP (code))
code = Fcdr (Fassq (Qucs, attributes));
+
if (NILP (code))
{
+ rest = attributes;
while (CONSP (rest))
{
Lisp_Object cell = Fcar (rest);
Lisp_Object ccs;
- if (!LISTP (cell))
+ if ( !LISTP (cell) )
signal_simple_error ("Invalid argument", attributes);
- if (!NILP (ccs = Ffind_charset (Fcar (cell)))
- && ((XCHARSET_FINAL (ccs) != 0) ||
- (XCHARSET_MAX_CODE (ccs) > 0) ||
- (EQ (ccs, Vcharset_chinese_big5))) )
+
+ ccs = Ffind_charset (Fcar (cell));
+ if (!NILP (ccs))
{
cell = Fcdr (cell);
- if (CONSP (cell))
- character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
- else
- character = Fdecode_char (ccs, cell, Qnil);
- if (!NILP (character))
- goto setup_attributes;
+ if (INTP (cell))
+ {
+ character = Fdecode_char (ccs, cell, Qt, Qt);
+ if (!NILP (character))
+ goto setup_attributes;
+ }
+ if ( (XCHARSET_FINAL (ccs) != 0) ||
+ (XCHARSET_MAX_CODE (ccs) > 0) ||
+ (EQ (ccs, Vcharset_chinese_big5)) )
+ {
+ if (CONSP (cell))
+ character
+ = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+ else
+ 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);
}
Fput_char_table (make_char (i), val, chartab);
}
else
- abort ();
+ ABORT ();
}
else
Fput_char_table (range, val, chartab);
c2 = cmpchar_component (c2, 0, 1);
#endif
+#ifndef UTF2000
if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
+#endif
{
tail = Vword_separating_categories;
default_result = 0;
}
+#ifndef UTF2000
else
{
tail = Vword_combining_categories;
default_result = 1;
}
+#endif
category_set1 = CATEGORY_SET (c1);
if (NILP (category_set1))
INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
INIT_LRECORD_IMPLEMENTATION (byte_table);
- defsymbol (&Qsystem_char_id, "system-char-id");
-
defsymbol (&Qto_ucs, "=>ucs");
- defsymbol (&Q_ucs_variants, "->ucs-variants");
+ 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 (&Q_identical, "->identical");
+ defsymbol (&Q_identical_from, "<-identical");
+ defsymbol (&Q_component, "->ideographic-component-forms");
+ defsymbol (&Q_component_of, "<-ideographic-component-forms");
defsymbol (&Qcomposition, "composition");
defsymbol (&Q_decomposition, "->decomposition");
defsymbol (&Qcompat, "compat");
DEFSUBR (Ffind_char_attribute_table);
defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
DEFSUBR (Fput_char_table_map_function);
-#ifdef HAVE_CHISE_CLIENT
+#ifdef HAVE_CHISE
DEFSUBR (Fsave_char_attribute_table);
DEFSUBR (Fmount_char_attribute_table);
DEFSUBR (Freset_char_attribute_table);
DEFSUBR (Fclose_char_attribute_table);
+ DEFSUBR (Fclose_char_data_source);
+#ifndef HAVE_LIBCHISE
defsymbol (&Qload_char_attribute_table_map_function,
"load-char-attribute-table-map-function");
DEFSUBR (Fload_char_attribute_table_map_function);
+#endif
DEFSUBR (Fload_char_attribute_table);
#endif
+ DEFSUBR (Fchar_feature);
DEFSUBR (Fchar_attribute_alist);
DEFSUBR (Fget_char_attribute);
DEFSUBR (Fput_char_attribute);
vars_of_chartab (void)
{
#ifdef UTF2000
-#ifdef HAVE_CHISE_CLIENT
+ 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 /*
*/ );
Vchar_db_stingy_mode = Qt;
-#endif /* HAVE_CHISE_CLIENT */
+
+#ifdef HAVE_LIBCHISE
+ Vchise_db_directory = build_string(chise_db_dir);
+ DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
+Directory of CHISE character databases.
+*/ );
+
+ Vchise_system_db_directory = build_string(chise_system_db_dir);
+ DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
+Directory of system character database of CHISE.
+*/ );
#endif
+
+#endif /* HAVE_CHISE */
/* DO NOT staticpro this. It works just like Vweak_hash_tables. */
Vall_syntax_tables = Qnil;
dump_add_weak_object_chain (&Vall_syntax_tables);
projects / chise / xemacs-chise.git.1 / blobdiff