From: David Kastrup <dak@gnu.org>
Date: Sun, 19 Feb 2012 09:24:34 +0000 (+0100)
Subject: Issue 1902: scheme engravers cause "warning: Attempting to remove nonexisting listener."
X-Git-Tag: release/2.15.31-1~55
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=a4b026479ad44908e2c680b95d4ae47fcdedc06f;p=lilypond.git

Issue 1902: scheme engravers cause "warning: Attempting to remove nonexisting listener."

Implements listener equality compatible with instanced Scheme engravers.
Also permits \remove to take Scheme argument.
---

diff --git a/lily/context-def.cc b/lily/context-def.cc
index df866c2472..00b10f9616 100644
--- a/lily/context-def.cc
+++ b/lily/context-def.cc
@@ -292,7 +292,9 @@ Context_def::get_translator_names (SCM user_mod) const
       if (ly_symbol2scm ("consists") == tag)
         l1 = scm_cons (arg, l1);
       else if (ly_symbol2scm ("remove") == tag
-               && get_translator (arg))
+               && (scm_is_pair (arg)
+		   || ly_is_procedure (arg)
+		   || get_translator (arg)))
         l1 = scm_delete_x (arg, l1);
     }
 
diff --git a/lily/include/listener.hh b/lily/include/listener.hh
index 0bc937f2b3..fb69922493 100644
--- a/lily/include/listener.hh
+++ b/lily/include/listener.hh
@@ -67,6 +67,7 @@ typedef struct
 {
   void (*listen_callback) (void *, SCM);
   void (*mark_callback) (void *);
+  bool (*equal_callback) (void *, void *);
 } Listener_function_table;
 
 class Listener
@@ -81,7 +82,9 @@ public:
   void listen (SCM ev) const;
 
   bool operator == (Listener const &other) const
-  { return target_ == other.target_ && type_ == other.type_; }
+  { return type_ == other.type_
+      && (*type_->equal_callback)((void *) target_, (void *) other.target_ );
+  }
 
   DECLARE_SIMPLE_SMOBS (Listener);
 };
@@ -100,12 +103,18 @@ cl :: method ## _mark (void *self)                      \
   cl *s = (cl *)self;                                   \
   scm_gc_mark (s->self_scm ());                         \
 }                                                       \
+bool                                                    \
+cl :: method ## _is_equal (void *a, void *b)            \
+{                                                       \
+  return a == b;                                        \
+}                                                       \
 Listener                                                \
 cl :: method ## _listener () const                      \
 {                                                       \
   static Listener_function_table callbacks;             \
   callbacks.listen_callback = &cl::method ## _callback; \
   callbacks.mark_callback = &cl::method ## _mark;       \
+  callbacks.equal_callback = &cl::method ## _is_equal;  \
   return Listener (this, &callbacks);                   \
 }
 
@@ -115,6 +124,7 @@ cl :: method ## _listener () const                      \
   inline void name (SCM);                               \
   static void name ## _callback (void *self, SCM ev);   \
   static void name ## _mark (void *self);               \
+  static bool name ## _is_equal (void *a, void *b);	\
   Listener name ## _listener () const
 
 #endif /* LISTENER_HH */
diff --git a/lily/parser.yy b/lily/parser.yy
index d830cb4c57..29f4f2a1e0 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -1952,16 +1952,19 @@ context_mod:
 	| context_def_mod STRING {
 		$$ = scm_list_2 ($1, $2);
 	}
-	| context_def_mod embedded_scm {
-	   if (ly_symbol2scm ("consists") != $1)
-	   {
-	     $$ = SCM_EOL;
-             parser->parser_error (@1, _ ("only \\consists takes non-string argument."));
-	   }
-	   else
-	   {
- 	     $$ = scm_list_2 ($1, $2);
-	   }
+	| context_def_mod embedded_scm
+	{
+		if (!scm_is_string ($2)
+		    && ly_symbol2scm ("consists") != $1
+		    && ly_symbol2scm ("remove") != $1)
+		{
+			$$ = SCM_EOL;
+			parser->parser_error (@1, _ ("only \\consists and \\remove take non-string argument."));
+		}
+		else
+		{
+			$$ = scm_list_2 ($1, $2);
+		}
 	}
 	;
 
diff --git a/lily/scheme-engraver.cc b/lily/scheme-engraver.cc
index cde829a607..1b1aad924a 100644
--- a/lily/scheme-engraver.cc
+++ b/lily/scheme-engraver.cc
@@ -186,10 +186,19 @@ void mark_listen_closure (void *target)
   scm_gc_mark ((SCM)target);
 }
 
+static
+bool equal_listen_closure (void *a, void *b)
+{
+  SCM target_a = (SCM) a;
+  SCM target_b = (SCM) b;
+
+  return ly_is_equal (target_a, target_b);
+}
+
 Listener_function_table listen_closure
 =
 {
-  call_listen_closure, mark_listen_closure
+  call_listen_closure, mark_listen_closure, equal_listen_closure
 };
 
 /* static */