#include "sysfile.h"
#include "buffer.h"
#include <errno.h>
-#include <concord.h>
+#include "elconcord.h"
#ifdef HAVE_LIBCHISE
# include <chise.h>
#endif
EXFUN (Fread_from_string, 3);
-EXFUN (Fconcord_decode_object, 4);
-EXFUN (Fconcord_object_put, 3);
-EXFUN (Fconcord_object_get, 2);
-
Lisp_Object Qconcord;
Lisp_Object Qconcord_object;
Lisp_Object Qgenre, Q_id;
Lisp_Object Vconcord_genre_object_hash_table;
-typedef struct Lisp_CONCORD_DS Lisp_CONCORD_DS;
-DECLARE_LRECORD (concord_ds, Lisp_CONCORD_DS);
+/*
+ * data source
+ */
Lisp_Object Qconcord_dsp;
-struct Lisp_CONCORD_DS
-{
- struct lcrecord_header header;
- CONCORD_DS ds;
-};
-
-#define XCONCORD_DS(x) XRECORD (x, concord_ds, Lisp_CONCORD_DS)
-#define XSET_CONCORD_DS(x, p) XSETRECORD (x, p, concord_ds)
-#define CONCORD_DS_P(x) RECORDP (x, concord_ds)
-#define CHECK_CONCORD_DS(x) CHECK_RECORD (x, concord_ds)
-#define CONCHECK_CONCORD_DS(x) CONCHECK_RECORD (x, concord_ds)
-
static Lisp_CONCORD_DS*
allocate_concord_ds (void)
{
CHECK_SYMBOL (genre);
retval = Fgethash (genre, Vconcord_genre_hash_table, Qunbound);
+#ifdef HAVE_LIBCHISE
if ( UNBOUNDP (retval) )
retval = Vchise_system_db_directory;
+#endif
if ( STRINGP (retval) )
{
retval = Fconcord_open_ds (retval, Qnil, Qnil, Qnil);
}
-typedef struct Lisp_CONCORD_Object Lisp_CONCORD_Object;
-DECLARE_LRECORD (concord_object, Lisp_CONCORD_Object);
+/*
+ * Concord-object
+ */
Lisp_Object Qconcord_objectp;
-struct Lisp_CONCORD_Object
-{
- struct lcrecord_header header;
- CONCORD_Genre genre;
- Lisp_Object id;
-};
-
-#define XCONCORD_OBJECT(x) XRECORD (x, concord_object, Lisp_CONCORD_Object)
-#define XSET_CONCORD_OBJECT(x, p) XSETRECORD (x, p, concord_object)
-#define CONCORD_OBJECT_P(x) RECORDP (x, concord_object)
-#define CHECK_CONCORD_OBJECT(x) CHECK_RECORD (x, concord_object)
-#define CONCHECK_CONCORD_OBJECT(x) CONCHECK_RECORD (x, concord_object)
-#define CONCORD_OBJECT_GENRE(x) ((x)->genre)
-#define CONCORD_OBJECT_ID(x) ((x)->id)
-#define XCONCORD_OBJECT_ID(x) CONCORD_OBJECT_ID (XCONCORD_OBJECT(x))
-#define XCONCORD_OBJECT_GENRE(x) CONCORD_OBJECT_GENRE (XCONCORD_OBJECT(x))
-
static Lisp_CONCORD_Object*
allocate_concord_object (void)
{
}
}
+static int
+concord_object_equal (Lisp_Object cobj1, Lisp_Object cobj2, int depth)
+{
+ return internal_equal ( XCONCORD_OBJECT_ID(cobj1),
+ XCONCORD_OBJECT_ID(cobj2), depth);
+}
+
static const struct lrecord_description concord_object_description[] = {
{ XD_LISP_OBJECT, offsetof (Lisp_CONCORD_Object, id) },
{ XD_END }
DEFINE_LRECORD_IMPLEMENTATION ("concord_object", concord_object,
mark_concord_object, print_concord_object,
- finalize_concord_object, 0, 0,
+ finalize_concord_object,
+ concord_object_equal, 0,
concord_object_description,
Lisp_CONCORD_Object);
ffv = Fconcord_object_get (ret, rev_feature);
if (!CONSP (ffv))
concord_object_put (ret, rev_feature, list1 (object));
- else if (NILP (Fmemq (object, ffv)))
+ else if (NILP (Fmember (object, ffv)))
concord_object_put
(ret, rev_feature,
nconc2 (Fcopy_sequence (ffv), list1 (object)));
return Qt;
}
+DEFUN ("concord-object-adjoin", Fconcord_object_adjoin, 3, 3, 0, /*
+Cons ITEM onto the front of FEATURE's value of OBJECT only if it's not already there.
+*/
+ (object, feature, item))
+{
+ Lisp_Object ret = Fconcord_object_get (object, feature);
+
+ if ( NILP (Fmember (item, ret)) )
+ return Fconcord_object_put (object, feature, Fcons (item, ret));
+ return Qnil;
+}
+
+DEFUN ("concord-object-adjoin*", Fconcord_object_adjoinX, 3, 3, 0, /*
+Append ITEM onto the end of FEATURE's value of OBJECT only if it's not already there.
+*/
+ (object, feature, item))
+{
+ Lisp_Object ret = Fconcord_object_get (object, feature);
+
+ if ( NILP (Fmember (item, ret)) )
+ return Fconcord_object_put (object, feature, nconc2 (ret, list1 (item)));
+ return Qnil;
+}
+
struct closure_for_object_spec
{
char* object_id;
DEFSUBR (Fconcord_decode_object);
DEFSUBR (Fconcord_object_get);
DEFSUBR (Fconcord_object_put);
+ DEFSUBR (Fconcord_object_adjoin);
+ DEFSUBR (Fconcord_object_adjoinX);
DEFSUBR (Fconcord_define_object);
DEFSUBR (Fconcord_object_spec);
DEFSUBR (Fconcord_foreach_object_in_feature);