update.

[chise/xemacs-chise.git.1] / src / concord.c

diff --git a/src/concord.c b/src/concord.c
index 06dc3b5..f860af7 100644 (file)
--- 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 <errno.h>
 #include <concord.h>
+#ifdef HAVE_LIBCHISE
+#  include <chise.h>
+#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;
@@ -257,6 +264,8 @@ Return concord-ds of GENRE.
   CHECK_SYMBOL (genre);
 
   retval = Fgethash (genre, Vconcord_genre_hash_table, Qunbound);
+  if ( UNBOUNDP (retval) )
+    retval = Vchise_system_db_directory;
   if ( STRINGP (retval) )
     {
       retval = Fconcord_open_ds (retval, Qnil, Qnil, Qnil);
@@ -380,10 +389,6 @@ print_concord_object (Lisp_Object obj,
   else
     {
       write_c_string ("#<concord-object \"", printcharfun);
-      write_c_string (concord_ds_location
-                     (concord_genre_get_data_source (lcobj->genre)),
-                     printcharfun);
-      write_c_string (":", printcharfun);
       write_c_string (concord_genre_get_name (lcobj->genre), printcharfun);
       write_c_string (";", printcharfun);
       GCPRO2 (obj, printcharfun);
@@ -519,6 +524,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.
@@ -718,6 +732,7 @@ Store a VALUE of OBJECT's FEATURE.
   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)) )
@@ -894,7 +909,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
@@ -911,7 +926,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) );
@@ -922,7 +936,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;
@@ -1000,6 +1015,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;
@@ -1075,6 +1107,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);
@@ -1089,6 +1125,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);
@@ -1107,7 +1144,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
@@ -1127,3 +1164,12 @@ 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
+  Fconcord_assign_genre (Qcharacter, Vchise_system_db_directory);
+  Fconcord_assign_genre (Qfeature, Vchise_system_db_directory);
+#endif
+}