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 df866c2472a62d7d476b0798ce73ff5270bfe05c..00b10f9616904e6e42e14f92e5af62fffefc064f 100644 (file)
--- 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 0bc937f2b3b7559e212dd14950aad9d7baf7b121..fb69922493ff6877c5c0388e8491346cac56d493 100644 (file)
--- 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 d830cb4c57db08c9acf4e32aafbf03b234d4b587..29f4f2a1e0fddabd54aebd9cc6e257d014aafd14 100644 (file)
--- 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 cde829a60788bec5b140942dad26a6fd75168184..1b1aad924ac1efd10e3bb2c19148646572ca70c2 100644 (file)
--- 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 */