/* XEmacs routines to deal with CONCORD.
- Copyright (C) 2005,2006 MORIOKA Tomohiko
+ Copyright (C) 2005,2006,2008 MORIOKA Tomohiko
This file is part of XEmacs.
*/
(object, feature, value))
{
+ Lisp_String* name;
+ Bufbyte *name_str;
+
CHECK_CONCORD_OBJECT (object);
+ CHECK_SYMBOL (feature);
+ name = symbol_name (XSYMBOL (feature));
+ name_str = string_data (name);
if ( NILP (concord_object_put (object, feature, value)) )
return Qnil;
+ if ( EQ (feature, Q_subsumptive) ||
+ EQ (feature, Q_subsumptive_from) ||
+ EQ (feature, Q_denotational) ||
+ EQ (feature, Q_denotational_from) ||
+ ( ( ((name_str[0] == '-') && (name_str[1] == '>')) ||
+ ((name_str[0] == '<') && (name_str[1] == '-')) )
+ && (memchr (name_str, '*', name->size) == NULL) ) )
+ {
+ Lisp_Object rest = value;
+ Lisp_Object ret;
+ Lisp_Object rev_feature = Qnil;
+ struct gcpro gcpro1;
+
+ GCPRO1 (rev_feature);
+ if (EQ (feature, Q_subsumptive))
+ rev_feature = Q_subsumptive_from;
+ else if (EQ (feature, Q_subsumptive_from))
+ rev_feature = Q_subsumptive;
+ else if (EQ (feature, Q_denotational))
+ rev_feature = Q_denotational_from;
+ else if (EQ (feature, Q_denotational_from))
+ rev_feature = Q_denotational;
+ else
+ {
+ 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);
+ }
+
+ while (CONSP (rest))
+ {
+ ret = XCAR (rest);
+
+ if ( CONCORD_OBJECT_P (ret) && !EQ (ret, object) )
+ {
+ Lisp_Object ffv;
+
+ ffv = Fconcord_object_get (ret, rev_feature);
+ if (!CONSP (ffv))
+ concord_object_put (ret, rev_feature, list1 (object));
+ else if (NILP (Fmemq (object, ffv)))
+ concord_object_put
+ (ret, rev_feature,
+ nconc2 (Fcopy_sequence (ffv), list1 (object)));
+ Fsetcar (rest, ret);
+ }
+ rest = XCDR (rest);
+ }
+ UNGCPRO;
+ }
return Qt;
}
CONCORD_Feature feature,
CONCORD_String value)
{
- struct gcpro gcpro1, gcpro2, gcpro3;
+ struct gcpro gcpro1, gcpro2;
Lisp_Object obj, val, ret;
#if 0
obj = Fconcord_make_object (for_each_object_closure->genre,
obj,
for_each_object_closure->ds);
- UNGCPRO;
#if 0
val = read_from_c_string (CONCORD_String_data (value),
CONCORD_String_size (value) );
Qfile_name),
Qnil, Qnil));
#endif
- GCPRO3 (obj, val, ret);
+ UNGCPRO;
+ GCPRO2 (obj, val);
ret = call2 (for_each_object_closure->function, obj, val);
UNGCPRO;
for_each_object_closure->ret = ret;
}
static int
+concord_id_validate (Lisp_Object keyword, Lisp_Object value,
+ Error_behavior errb)
+{
+ if (ERRB_EQ (errb, ERROR_ME))
+ {
+ /* CHECK_SYMBOL (value); */
+ if ( INTP (value) || CHARP (value) || SYMBOLP (value) )
+ ;
+ else
+ dead_wrong_type_argument (Qsymbolp, value);
+ return 1;
+ }
+
+ return INTP (value) || CHARP (value) || SYMBOLP (value);
+}
+
+static int
concord_object_validate (Lisp_Object data, Error_behavior errb)
{
struct gcpro gcpro1, gcpro2, gcpro3;
concord_object_instantiate);
define_structure_type_keyword (st, Qgenre, concord_name_validate);
- define_structure_type_keyword (st, Q_id, concord_name_validate);
+ define_structure_type_keyword (st, Q_id, concord_id_validate);
}
void