/* XEmacs routines to deal with CONCORD.
- Copyright (C) 2005 MORIOKA Tomohiko
+ Copyright (C) 2005,2006 MORIOKA Tomohiko
This file is part of XEmacs.
Lisp_Object Qconcord;
+Lisp_Object Qconcord_object;
+Lisp_Object Qgenre, Q_id;
+
+Lisp_Object Vconcord_ds_hash_table;
+Lisp_Object Vconcord_genre_hash_table;
typedef struct Lisp_CONCORD_DS Lisp_CONCORD_DS;
}
DEFUN ("concord-open-ds", Fconcord_open_ds, 1, 4, 0, /*
-Return a new concord_ds object opened on PATH.
+Return a new concord-ds object opened on DIRECTORY.
Optional arguments TYPE and SUBTYPE specify the concord_ds type.
-Optional argument MODE gives the permissions to use when opening PATH,
+Optional argument MODE gives the permissions to use when opening DIRECTORY,
and defaults to 0755.
*/
- (path, type, subtype, mode))
+ (directory, type, subtype, mode))
{
Lisp_Object retval;
Lisp_CONCORD_DS* lds = NULL;
char *pathname;
struct gcpro gcpro1;
- CHECK_STRING (path);
- GCPRO1 (path);
- path = Fexpand_file_name (path, Qnil);
+ CHECK_STRING (directory);
+ GCPRO1 (directory);
+ directory = Ffile_name_as_directory (Fexpand_file_name (directory, Qnil));
UNGCPRO;
- TO_EXTERNAL_FORMAT (LISP_STRING, path,
+ retval = Fgethash (directory, Vconcord_ds_hash_table, Qunbound);
+ if (!UNBOUNDP (retval))
+ {
+ return retval;
+ }
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, directory,
C_STRING_ALLOCA, pathname,
Qfile_name);
lds = allocate_concord_ds ();
lds->ds = ds;
XSET_CONCORD_DS (retval, lds);
+ Fputhash (directory, retval, Vconcord_ds_hash_table);
return retval;
}
+DEFUN ("concord-ds-directory", Fconcord_ds_directory, 1, 1, 0, /*
+Return directory of concord-ds DS.
+*/
+ (ds))
+{
+ Lisp_CONCORD_DS* lds;
+ char* directory;
+
+ CHECK_CONCORD_DS (ds);
+ lds = XCONCORD_DS (ds);
+ if (lds->ds == NULL)
+ return Qnil;
+
+ directory = concord_ds_location (lds->ds);
+ if (directory == NULL)
+ return Qnil;
+
+ return build_ext_string (directory, Qfile_name);
+}
+
+
+DEFUN ("concord-assign-genre", Fconcord_assign_genre, 2, 2, 0, /*
+Assign data-source DIRECTORY to GENRE.
+*/
+ (genre, directory))
+{
+ struct gcpro gcpro1;
+
+ CHECK_SYMBOL (genre);
+ if ( CONCORD_DS_P (directory) )
+ {
+ }
+ else
+ {
+ CHECK_STRING (directory);
+ GCPRO1 (directory);
+ directory
+ = Ffile_name_as_directory (Fexpand_file_name (directory, Qnil));
+ UNGCPRO;
+ }
+ Fputhash (genre, directory, Vconcord_genre_hash_table);
+ return directory;
+}
+
+DEFUN ("concord-genre-directory", Fconcord_genre_directory, 1, 1, 0, /*
+Return pathname of GENRE.
+*/
+ (genre))
+{
+ Lisp_Object retval;
+ CHECK_SYMBOL (genre);
+
+ retval = Fgethash (genre, Vconcord_genre_hash_table, Qunbound);
+ if ( STRINGP (retval) )
+ return retval;
+ else if ( CONCORD_DS_P (retval) )
+ return Fconcord_ds_directory (retval);
+ return Qnil;
+}
+
+DEFUN ("concord-genre-ds", Fconcord_genre_ds, 1, 1, 0, /*
+Return concord-ds of GENRE.
+*/
+ (genre))
+{
+ Lisp_Object retval;
+
+ CHECK_SYMBOL (genre);
+
+ retval = Fgethash (genre, Vconcord_genre_hash_table, Qunbound);
+ if ( STRINGP (retval) )
+ {
+ retval = Fconcord_open_ds (retval, Qnil, Qnil, Qnil);
+ if ( !NILP (retval) )
+ Fputhash (genre, retval, Vconcord_genre_hash_table);
+ return retval;
+ }
+ else if ( CONCORD_DS_P (retval) )
+ return retval;
+ return Qnil;
+}
+
struct closure_to_list_feature
{
} *concord_feature_list_closure;
static int
-add_feature_to_list_mapper (CONCORD_Genre genre, unsigned char* name)
+add_feature_to_list_mapper (CONCORD_Genre genre, char* name)
{
/* This function can GC */
concord_feature_list_closure->feature_list
(genre, ds))
{
Lisp_CONCORD_DS* lds;
- unsigned char* genre_name;
+ char* genre_name;
CONCORD_Genre c_genre;
struct gcpro gcpro1;
- if ( !STRINGP(genre) )
- genre = Fsymbol_name (genre);
+ CHECK_SYMBOL (genre);
+ if (NILP (ds))
+ ds = Fconcord_genre_ds (genre);
CHECK_CONCORD_DS (ds);
lds = XCONCORD_DS (ds);
if (lds->ds == NULL)
return Qnil;
+ genre = Fsymbol_name (genre);
TO_EXTERNAL_FORMAT (LISP_STRING, genre,
C_STRING_ALLOCA, genre_name,
Qfile_name);
(id, genre, ds))
{
Lisp_CONCORD_DS* lds;
- unsigned char* genre_name;
+ char* genre_name;
CONCORD_Genre c_genre;
Lisp_CONCORD_Object* lcobj;
Lisp_Object retval;
- if ( !STRINGP(genre) )
- genre = Fsymbol_name (genre);
+ if (NILP (ds))
+ ds = Fconcord_genre_ds (genre);
CHECK_CONCORD_DS (ds);
lds = XCONCORD_DS (ds);
if (lds->ds == NULL)
return Qnil;
+ if ( !STRINGP(genre) )
+ genre = Fsymbol_name (genre);
TO_EXTERNAL_FORMAT (LISP_STRING, genre,
C_STRING_ALLOCA, genre_name,
Qfile_name);
(feature, value, genre, ds))
{
Lisp_CONCORD_DS* lds;
- unsigned char* genre_name;
+ char* genre_name;
CONCORD_Genre c_genre;
- unsigned char* feature_name;
+ char* feature_name;
CONCORD_INDEX c_index;
Lisp_Object value_string;
- unsigned char* strid;
+ char* strid;
CONCORD_String_Tank st_id;
int status;
Lisp_Object obj;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- if ( !STRINGP(feature) )
- feature = Fsymbol_name (feature);
- if ( !STRINGP(genre) )
- genre = Fsymbol_name (genre);
+ if (NILP (ds))
+ ds = Fconcord_genre_ds (genre);
CHECK_CONCORD_DS (ds);
lds = XCONCORD_DS (ds);
if (lds->ds == NULL)
return Qnil;
-
+ if ( !STRINGP(feature) )
+ feature = Fsymbol_name (feature);
+ if ( !STRINGP(genre) )
+ genre = Fsymbol_name (genre);
TO_EXTERNAL_FORMAT (LISP_STRING, genre,
C_STRING_ALLOCA, genre_name,
Qfile_name);
CONCORD_String_size (&st_id) );
#else
obj = Fcar (Fread_from_string (make_ext_string
- (CONCORD_String_data (&st_id),
+ ((char*)CONCORD_String_data (&st_id),
CONCORD_String_size (&st_id),
Qfile_name),
Qnil, Qnil));
{
struct gcpro gcpro1, gcpro2;
Lisp_Object obj_string;
- unsigned char* c_obj;
+ char* c_obj;
CONCORD_Genre c_genre;
- unsigned char* feature_name;
+ char* feature_name;
CONCORD_Feature c_feature;
int status;
CONCORD_String_Tank st_value;
{
return
Fcar (Fread_from_string (make_ext_string
- (CONCORD_String_data (&st_value),
+ ((char*)CONCORD_String_data (&st_value),
CONCORD_String_size (&st_value),
Qfile_name),
Qnil, Qnil));
{
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object obj_string;
- unsigned char* c_obj;
+ char* c_obj;
CONCORD_Genre c_genre;
- unsigned char* feature_name;
+ char* feature_name;
CONCORD_Feature c_feature;
int status;
Lisp_Object value_string;
- unsigned char* c_value;
+ char* c_value;
CHECK_CONCORD_OBJECT (object);
if ( !STRINGP(feature) )
TO_EXTERNAL_FORMAT (LISP_STRING, value_string,
C_STRING_ALLOCA, c_value,
Qfile_name);
- status = concord_obj_put_feature_value_str (c_obj, c_feature, c_value);
+ status = concord_obj_put_feature_value_str (c_obj, c_feature,
+ (unsigned char*)c_value);
if (status)
return Qnil;
status = chise_feature_sync (c_feature);
struct closure_for_object_spec
{
- unsigned char* object_id;
+ char* object_id;
Lisp_Object spec;
} *concord_object_spec_closure;
static int
-add_feature_to_spec_mapper (CONCORD_Genre genre, unsigned char* name)
+add_feature_to_spec_mapper (CONCORD_Genre genre, char* name)
{
/* This function can GC */
CONCORD_String_Tank st_value;
= Fcons (Fcons (intern (name),
Fcar (Fread_from_string
(make_ext_string
- (CONCORD_String_data (&st_value),
+ ((char*)CONCORD_String_data (&st_value),
CONCORD_String_size (&st_value),
Qfile_name),
Qnil, Qnil))),
(object))
{
Lisp_Object obj_string;
- unsigned char* c_obj;
+ char* c_obj;
CONCORD_Genre c_genre;
struct gcpro gcpro1, gcpro2;
CONCORD_String_size (object_id) );
#else
obj = Fcar (Fread_from_string (make_ext_string
- (CONCORD_String_data (object_id),
+ ((char*)CONCORD_String_data (object_id),
CONCORD_String_size (object_id),
Qfile_name),
Qnil, Qnil));
CONCORD_String_size (value) );
#else
val = Fcar (Fread_from_string (make_ext_string
- (CONCORD_String_data (value),
+ ((char*)CONCORD_String_data (value),
CONCORD_String_size (value),
Qfile_name),
Qnil, Qnil));
(function, feature, genre, ds))
{
Lisp_CONCORD_DS* lds;
- unsigned char* genre_name;
+ char* genre_name;
CONCORD_Genre c_genre;
- unsigned char* feature_name;
+ char* feature_name;
CONCORD_Feature c_feature;
- if ( !STRINGP(feature) )
- feature = Fsymbol_name (feature);
- if ( !STRINGP(genre) )
- genre = Fsymbol_name (genre);
+ if (NILP (ds))
+ ds = Fconcord_genre_ds (genre);
CHECK_CONCORD_DS (ds);
lds = XCONCORD_DS (ds);
if (lds->ds == NULL)
return Qnil;
+ if ( !STRINGP(feature) )
+ feature = Fsymbol_name (feature);
+ if ( !STRINGP(genre) )
+ genre = Fsymbol_name (genre);
TO_EXTERNAL_FORMAT (LISP_STRING, genre,
C_STRING_ALLOCA, genre_name,
Qfile_name);
return for_each_object_closure->ret;
}
+
+static int
+concord_name_validate (Lisp_Object keyword, Lisp_Object value,
+ Error_behavior errb)
+{
+ if (ERRB_EQ (errb, ERROR_ME))
+ {
+ CHECK_SYMBOL (value);
+ return 1;
+ }
+
+ return SYMBOLP (value);
+}
+
+static int
+concord_object_validate (Lisp_Object data, Error_behavior errb)
+{
+ Lisp_Object valw = Qnil;
+ Lisp_Object genre = Qnil;
+ Lisp_Object oid = Qnil;
+
+ data = Fcdr (data); /* skip over Qconcord_object */
+ while (!NILP (data))
+ {
+ Lisp_Object keyw = Fcar (data);
+
+ data = Fcdr (data);
+ valw = Fcar (data);
+ data = Fcdr (data);
+ if (EQ (keyw, Qgenre))
+ genre = valw;
+ else if (EQ (keyw, Q_id))
+ oid = valw;
+ else
+ ABORT ();
+ }
+
+ if (NILP (genre))
+ {
+ maybe_error (Qconcord_object, errb, "No genre given");
+ return 0;
+ }
+ if (NILP (oid))
+ {
+ maybe_error (Qconcord_object, errb, "No object-id given");
+ return 0;
+ }
+
+ if (NILP (Fconcord_make_object (oid, genre, Qnil)))
+ {
+ maybe_signal_simple_error_2 ("No such Concord-object",
+ oid, genre, Qconcord_object, errb);
+ return 0;
+ }
+
+ return 1;
+}
+
+static Lisp_Object
+concord_object_instantiate (Lisp_Object data)
+{
+ return Fconcord_make_object (Fplist_get (data, Q_id, Qnil),
+ Fplist_get (data, Qgenre, Qnil),
+ Qnil);
+}
+
+
void
syms_of_concord (void)
{
defsymbol (&Qconcord, "concord");
defsymbol (&Qconcord_dsp, "concord-dsp");
defsymbol (&Qconcord_objectp, "concord-objectp");
+ defsymbol (&Qconcord_object, "concord-object");
+ defsymbol (&Qgenre, "genre");
+ defsymbol (&Q_id, "=id");
DEFSUBR (Fconcord_open_ds);
DEFSUBR (Fconcord_ds_p);
DEFSUBR (Fconcord_close_ds);
+ DEFSUBR (Fconcord_ds_directory);
+
+ DEFSUBR (Fconcord_assign_genre);
+ DEFSUBR (Fconcord_genre_directory);
+ DEFSUBR (Fconcord_genre_ds);
DEFSUBR (Fconcord_feature_list);
+
DEFSUBR (Fconcord_make_object);
DEFSUBR (Fconcord_object_p);
DEFSUBR (Fconcord_object_id);
}
void
+structure_type_create_concord (void)
+{
+ struct structure_type *st;
+
+ st = define_structure_type (Qconcord_object,
+ concord_object_validate,
+ concord_object_instantiate);
+
+ define_structure_type_keyword (st, Qgenre, concord_name_validate);
+ define_structure_type_keyword (st, Q_id, concord_name_validate);
+}
+
+void
vars_of_concord (void)
{
Fprovide (Qconcord);
+
+ staticpro (&Vconcord_ds_hash_table);
+ Vconcord_ds_hash_table
+ = make_lisp_hash_table (8, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
+
+ staticpro (&Vconcord_genre_hash_table);
+ Vconcord_genre_hash_table
+ = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
}
projects / chise / xemacs-chise.git.1 / blobdiff