X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fconcord.c;h=e3680066f42139d195a10762c384fe5640db8ca4;hb=99bd17fe9aa39bc09ad0724006f10b9ea214cd7b;hp=f8b37c8b32e199d09dfa3512688e787eb7c5efd2;hpb=aa149bc9e46f79e626a2e3dd36e83fa706bf79bb;p=chise%2Fxemacs-chise.git.1 diff --git a/src/concord.c b/src/concord.c index f8b37c8..e368006 100644 --- a/src/concord.c +++ b/src/concord.c @@ -1,5 +1,5 @@ /* XEmacs routines to deal with CONCORD. - Copyright (C) 2005,2006 MORIOKA Tomohiko + Copyright (C) 2005,2006,2008,2010 MORIOKA Tomohiko This file is part of XEmacs. @@ -28,6 +28,9 @@ Boston, MA 02111-1307, USA. */ #include "buffer.h" #include #include +#ifdef HAVE_LIBCHISE +# include +#endif EXFUN (Fread_from_string, 3); @@ -40,6 +43,10 @@ EXFUN (Fconcord_object_get, 2); Lisp_Object Qconcord; Lisp_Object Qconcord_object; Lisp_Object Qgenre, Q_id; +#ifdef HAVE_LIBCHISE +Lisp_Object Qcharacter; +Lisp_Object Qfeature; +#endif Lisp_Object Vconcord_ds_hash_table; Lisp_Object Vconcord_genre_hash_table; @@ -519,6 +526,15 @@ Return an id of Concord-object OBJECT. return XCONCORD_OBJECT_ID (object); } +DEFUN ("concord-object-genre", Fconcord_object_genre, 1, 1, 0, /* +Return genre of Concord-object OBJECT. +*/ + (object)) +{ + CHECK_CONCORD_OBJECT (object); + return intern (concord_genre_get_name (XCONCORD_OBJECT_GENRE (object))); +} + DEFUN ("concord-decode-object", Fconcord_decode_object, 2, 4, 0, /* Make and return a Concord-object from FEATURE and VALUE. Optional argument GENRE specifies the GENRE of the object. @@ -648,10 +664,9 @@ Return the value of OBJECT's FEATURE. return Qnil; } -DEFUN ("concord-object-put", Fconcord_object_put, 3, 3, 0, /* -Store a VALUE of OBJECT's FEATURE. -*/ - (object, feature, value)) +static Lisp_Object +concord_object_put (Lisp_Object object, Lisp_Object feature, + Lisp_Object value) { struct gcpro gcpro1, gcpro2, gcpro3; int previous_print_readably; @@ -664,7 +679,6 @@ Store a VALUE of OBJECT's FEATURE. Lisp_Object value_string; char* c_value; - CHECK_CONCORD_OBJECT (object); if ( !STRINGP(feature) ) feature = Fsymbol_name (feature); previous_print_readably = print_readably; @@ -700,7 +714,7 @@ Store a VALUE of OBJECT's FEATURE. status = chise_feature_sync (c_feature); if (status) return Qnil; - if (feature_name[0] == '=') + if (XSTRING_DATA(feature)[0] == '=') { CONCORD_INDEX c_index = concord_genre_get_index (c_genre, feature_name); @@ -711,6 +725,86 @@ Store a VALUE of OBJECT's FEATURE. return Qt; } +DEFUN ("concord-object-put", Fconcord_object_put, 3, 3, 0, /* +Store a VALUE of OBJECT's FEATURE. +*/ + (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; +} + struct closure_for_object_spec { char* object_id; @@ -817,7 +911,7 @@ func_for_each_object (CONCORD_String object_id, CONCORD_Feature feature, CONCORD_String value) { - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2; Lisp_Object obj, val, ret; #if 0 @@ -834,7 +928,6 @@ func_for_each_object (CONCORD_String object_id, 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) ); @@ -845,7 +938,8 @@ func_for_each_object (CONCORD_String object_id, 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; @@ -923,6 +1017,23 @@ concord_name_validate (Lisp_Object keyword, Lisp_Object value, } 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; @@ -998,6 +1109,10 @@ syms_of_concord (void) defsymbol (&Qconcord_object, "concord-object"); defsymbol (&Qgenre, "genre"); defsymbol (&Q_id, "=id"); +#ifdef HAVE_LIBCHISE + defsymbol (&Qcharacter, "character"); + defsymbol (&Qfeature, "feature"); +#endif DEFSUBR (Fconcord_open_ds); DEFSUBR (Fconcord_ds_p); @@ -1012,6 +1127,7 @@ syms_of_concord (void) DEFSUBR (Fconcord_make_object); DEFSUBR (Fconcord_object_p); DEFSUBR (Fconcord_object_id); + DEFSUBR (Fconcord_object_genre); DEFSUBR (Fconcord_decode_object); DEFSUBR (Fconcord_object_get); DEFSUBR (Fconcord_object_put); @@ -1030,7 +1146,7 @@ structure_type_create_concord (void) 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 @@ -1050,3 +1166,14 @@ vars_of_concord (void) Vconcord_genre_object_hash_table = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); } + +void +complex_vars_of_concord (void) +{ +#ifdef HAVE_LIBCHISE + Lisp_Object dir = build_string(chise_system_db_dir); + + Fconcord_assign_genre (Qcharacter, dir); + Fconcord_assign_genre (Qfeature, dir); +#endif +}