From 07854acfba301de129b297ddadceee1a017b89de Mon Sep 17 00:00:00 2001 From: tomo Date: Thu, 9 Dec 2010 04:13:01 +0000 Subject: [PATCH] (Fconcord_object_put): Use `member' instead of `memq'. (Fconcord_object_adjoin): New function. (Fconcord_object_adjoinX): New function. (syms_of_concord): Defsubred `Fconcord_object_adjoin' and `Fconcord_object_adjoinX'. --- src/concord.c | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/src/concord.c b/src/concord.c index 7f06ae3..7ecc153 100644 --- a/src/concord.c +++ b/src/concord.c @@ -771,7 +771,7 @@ Store a VALUE of OBJECT's FEATURE. 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))); @@ -784,6 +784,30 @@ Store a VALUE of OBJECT's FEATURE. 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; @@ -1110,6 +1134,8 @@ syms_of_concord (void) 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); -- 1.7.10.4