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,2004 MORIOKA Tomohiko
+ Copyright (C) 1999,2000,2001,2002,2003,2004,2005 MORIOKA Tomohiko
This file is part of XEmacs.
extern Lisp_Object Qideographic_structure;
Lisp_Object Vnext_defined_char_id;
-EXFUN (Fdefine_char, 1);
EXFUN (Fmap_char_attribute, 3);
}
-#if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
-Lisp_Object Qsystem_char_id;
-#endif
-
Lisp_Object Qcomposition;
+Lisp_Object Qmap_decomposition;
+Lisp_Object Qto_decomposition_at_compat;
+Lisp_Object Q_canonical;
+Lisp_Object Q_compat_of;
Lisp_Object Q_decomposition;
Lisp_Object Q_identical;
Lisp_Object Q_identical_from;
Lisp_Object Q_subsumptive_from;
Lisp_Object Q_component;
Lisp_Object Q_component_of;
-Lisp_Object Q_same;
-Lisp_Object Q_same_of;
-Lisp_Object Q_vulgar;
-Lisp_Object Q_vulgar_of;
Lisp_Object Qto_ucs;
Lisp_Object Q_ucs_unified;
Lisp_Object Qcompat;
*/
(character))
{
- Lisp_Object ret;
-
CHECK_CHAR (character);
- ret = Fchar_feature (character, Q_ucs_unified, Qnil,
- Qnil, 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
{
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;
break;
default:
- abort ();
+ ABORT ();
}
return Qnil;
return (0 << 8) | 255;
#endif
default:
- abort ();
+ ABORT ();
return 0;
}
}
}
#endif
else
- abort ();
+ ABORT ();
}
else
{
#endif /* not UTF2000 */
#endif /* not MULE */
+#ifdef UTF2000
+ case CHARTAB_RANGE_DEFAULT:
+ return ct->default_value;
+#endif /* not UTF2000 */
+
default:
- abort ();
+ ABORT ();
}
return Qnil; /* not reached */
break;
default:
- abort ();
+ ABORT ();
}
return 0; /* not reached */
break;
default:
- abort ();
+ ABORT ();
}
return 0;
}
default:
- abort ();
+ ABORT ();
}
return 0;
ranjarg = make_char (range->ch);
break;
default:
- abort ();
+ ABORT ();
}
closure->retval = call2 (closure->function, ranjarg, val);
return default_value;
}
-void put_char_composition (Lisp_Object character, Lisp_Object value);
-void
+Lisp_Object
+put_char_composition (Lisp_Object character, Lisp_Object value);
+Lisp_Object
put_char_composition (Lisp_Object character, Lisp_Object value)
{
if (!CONSP (value))
- signal_simple_error ("Invalid value for ->decomposition",
+ signal_simple_error ("Invalid value for =decomposition",
value);
- if (CONSP (Fcdr (value)))
+ if (CONSP (XCDR (value)))
{
- if (NILP (Fcdr (Fcdr (value))))
+ if (NILP (Fcdr (XCDR (value))))
{
- Lisp_Object base = Fcar (value);
- Lisp_Object modifier = Fcar (Fcdr (value));
+ Lisp_Object base = XCAR (value);
+ Lisp_Object modifier = XCAR (XCDR (value));
if (INTP (base))
{
if (INTP (modifier))
{
modifier = make_char (XINT (modifier));
- Fsetcar (Fcdr (value), modifier);
+ Fsetcar (XCDR (value), modifier);
}
if (CHARP (base))
{
else
Fsetcdr (ret, character);
}
+ else if (EQ (base, Qcompat))
+ return Q_compat_of;
}
+ else if (EQ (XCAR (value), Qcompat))
+ return Qto_decomposition_at_compat;
}
else
{
+ return Q_canonical;
+#if 0
Lisp_Object v = Fcar (value);
if (INTP (v))
{
- Emchar c = XINT (v);
+ Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
Lisp_Object ret
= Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
Qnil, Qnil);
Fcons (character, ret));
}
}
+#endif
}
+ return Qmap_decomposition;
}
static Lisp_Object
value = put_char_ccs_code_point (character, ccs, value);
attribute = XCHARSET_NAME (ccs);
}
- else if (EQ (attribute, Q_decomposition))
- put_char_composition (character, value);
+ else if ( EQ (attribute, Qmap_decomposition) ||
+ EQ (attribute, Q_decomposition) )
+ {
+ attribute = put_char_composition (character, value);
+ if ( EQ (attribute, Q_compat_of) ||
+ EQ (attribute, Qto_decomposition_at_compat) )
+ value = XCDR (value);
+ }
else if (EQ (attribute, Qto_ucs))
{
Lisp_Object ret;
if (!INTP (value))
signal_simple_error ("Invalid value for =>ucs", value);
- c = XINT (value);
+ c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
Qnil, Qnil);
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) ||
- EQ (attribute, Q_same) ||
- EQ (attribute, Q_same_of) ||
- EQ (attribute, Q_vulgar) ||
- EQ (attribute, Q_vulgar_of) ||
- !NILP (Fstring_match
- (build_string ("^<-\\(simplified"
- "\\|wrong\\)[^*]*$"),
- Fsymbol_name (attribute),
- Qnil, Qnil)) )
+ 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_canonical) ||
+ EQ (attribute, Q_compat_of) ||
+ EQ (attribute, Q_component) ||
+ EQ (attribute, Q_component_of) ||
+ !NILP (Fstring_match
+ (build_string ("^\\(<-\\|->\\)\\("
+ "canonical"
+ "\\|compat"
+ "\\|fullwidth\\|halfwidth"
+ "\\|simplified\\|vulgar\\|wrong"
+ "\\|same\\|original\\|ancient"
+ "\\|Oracle-Bones\\)[^*]*$"),
+ Fsymbol_name (attribute),
+ Qnil, Qnil)) )
{
Lisp_Object rest = value;
Lisp_Object ret;
rev_feature = Q_component_of;
else if (EQ (attribute, Q_component_of))
rev_feature = Q_component;
- else if (EQ (attribute, Q_same))
- rev_feature = Q_same_of;
- else if (EQ (attribute, Q_same_of))
- rev_feature = Q_same;
- else if (EQ (attribute, Q_vulgar))
- rev_feature = Q_vulgar_of;
- else if (EQ (attribute, Q_vulgar_of))
- rev_feature = Q_vulgar;
else
{
Lisp_String* name = symbol_name (XSYMBOL (attribute));
Bufbyte *name_str = string_data (name);
- if (name_str[0] == '<' && name_str[1] == '-')
+ 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);
- rev_name_str[0] = '-';
- rev_name_str[1] = '>';
+ 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);
}
if (CONSP (ret))
ret = Fdefine_char (ret);
-
+ else if (INTP (ret))
+ {
+ int code_point = XINT (ret);
+ Emchar cid = DECODE_CHAR (Vcharset_ucs, code_point, 0);
+
+ if (cid >= 0)
+ ret = make_char (cid);
+ else
+ ret = make_char (code_point);
+ }
+
if ( !NILP (ret) && !EQ (ret, character) )
{
Lisp_Object ffv;
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));
+ put_char_attribute
+ (ret, rev_feature,
+ nconc2 (Fcopy_sequence (ffv), list1 (character)));
Fsetcar (rest, ret);
}
rest = XCDR (rest);
UNGCPRO;
}
#if 1
- else if (EQ (attribute, Qideographic_structure))
+ else if ( EQ (attribute, Qideographic_structure) ||
+ !NILP (Fstring_match
+ (build_string ("^=>decomposition\\(\\|@[^*]+\\)$"),
+ Fsymbol_name (attribute),
+ Qnil, Qnil)) )
value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
#endif
return put_char_attribute (character, attribute, value);
{
if (default_chise_data_source == NULL)
{
- Lisp_Object db_dir = Vexec_directory;
+ Lisp_Object db_dir = Vdata_directory;
int modemask = 0755; /* rwxr-xr-x */
if (NILP (db_dir))
- db_dir = build_string ("../lib-src");
+ db_dir = build_string ("../etc");
db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
default_chise_data_source
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;
}
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;
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 ("chise-db"), db_dir);
if (writing_mode && NILP (Ffile_exists_p (db_dir)))
{
Lisp_Object (*filter)(Lisp_Object value);
- if ( EQ (attribute, Qideographic_structure)
- || EQ (attribute, Q_identical)
- || EQ (attribute, Q_identical_from)
- || EQ (attribute, Q_same)
- || EQ (attribute, Q_same_of)
- || !NILP (Fstring_match
- (build_string ("^\\(<-\\|->\\)\\("
- "simplified\\|wrong\\)[^*]*$"),
- Fsymbol_name (attribute),
- Qnil, Qnil)) )
+ if ( !NILP (Ffind_charset (attribute)) )
+ filter = NULL;
+ else if ( EQ (attribute, Qideographic_structure) ||
+ EQ (attribute, Q_identical) ||
+ EQ (attribute, Q_identical_from) ||
+ EQ (attribute, Q_canonical) ||
+ EQ (attribute, Q_compat_of) ||
+ !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;
Fput_char_table (make_char (i), val, chartab);
}
else
- abort ();
+ ABORT ();
}
else
Fput_char_table (range, val, chartab);
defsymbol (&Q_identical_from, "<-identical");
defsymbol (&Q_component, "->ideographic-component-forms");
defsymbol (&Q_component_of, "<-ideographic-component-forms");
- defsymbol (&Q_same, "->same");
- defsymbol (&Q_same_of, "<-same");
- defsymbol (&Q_vulgar, "->vulgar");
- defsymbol (&Q_vulgar_of, "<-vulgar");
defsymbol (&Qcomposition, "composition");
+ defsymbol (&Qmap_decomposition, "=decomposition");
+ defsymbol (&Qto_decomposition_at_compat, "=>decomposition@compat");
+ defsymbol (&Q_canonical, "->canonical");
+ defsymbol (&Q_compat_of, "<-compat");
defsymbol (&Q_decomposition, "->decomposition");
defsymbol (&Qcompat, "compat");
defsymbol (&Qisolated, "isolated");
projects / chise / xemacs-chise.git.1 / blobdiff