From c74f324be26cc077bc24a20b67a8f0ca4b6ed3cc Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Wed, 29 Apr 2015 11:25:28 +0200
Subject: [PATCH] Issue 4357/6: Extend Callback_wrapper class to extend for
 translator listening needs

---
 lily/include/listener.hh    | 20 +++++++++++++++++---
 lily/include/translator.hh  |  4 ++--
 lily/include/translator.icc | 22 +++++++---------------
 3 files changed, 26 insertions(+), 20 deletions(-)

diff --git a/lily/include/listener.hh b/lily/include/listener.hh
index a5c0c98bdd..881b980e40 100644
--- a/lily/include/listener.hh
+++ b/lily/include/listener.hh
@@ -75,6 +75,7 @@
 */
 
 #include "smobs.hh"
+#include "stream-event.hh"
 
 // A listener is essentially any procedure accepting a single argument
 // (namely an event).  The class Listener (or rather a smobbed_copy of
@@ -133,7 +134,7 @@ public:
 //
 // If you have a class member function
 // void T::my_listen (SCM ev)
-// then Callback_wrapper::make_smob<&T::my_listen> ()
+// then Callback_wrapper::make_smob<T, SCM, &T::my_listen> ()
 // will return an SCM function roughly defined as
 // (lambda (target ev) (target->my_listen ev))
 //
@@ -162,6 +163,19 @@ class Callback_wrapper : public Simple_smob<Callback_wrapper>
 
     (t->*callback) (ev);
   }
+  template <class T, void (T::*callback)(Stream_event *)>
+  static void trampoline (SCM target, SCM event)
+  {
+    // The same, but for callbacks for translator listeners which get
+    // the unpacked event which, in turn, gets protected previously
+
+    T *t = derived_unsmob<T> (target);
+    LY_ASSERT_DERIVED_SMOB (T, target, 1);
+    LY_ASSERT_SMOB (Stream_event, event, 2);
+
+    t->protect_event (event);
+    (t->*callback) (Stream_event::unsmob (event));
+  }
 
   Callback_wrapper (void (*trampoline) (SCM, SCM)) : trampoline_ (trampoline)
   { } // Private constructor, use only in make_smob
@@ -175,7 +189,7 @@ public:
   // creation just once on the first call of make_smob.  So we only
   // get a single Callback_wrapper instance for each differently
   // templated make_smob call.
-  template <class T, void (T::*callback)(SCM)>
+  template <class T, class Arg, void (T::*callback)(Arg)>
   static SCM make_smob ()
   {
     static SCM res = scm_permanent_object
@@ -184,6 +198,6 @@ public:
   }
 };
 
-#define GET_LISTENER(cl, proc) get_listener (Callback_wrapper::make_smob<cl, &cl::proc> ())
+#define GET_LISTENER(cl, proc) get_listener (Callback_wrapper::make_smob<cl, SCM, &cl::proc> ())
 
 #endif /* LISTENER_HH */
diff --git a/lily/include/translator.hh b/lily/include/translator.hh
index 54a7f318f7..9abea3b64c 100644
--- a/lily/include/translator.hh
+++ b/lily/include/translator.hh
@@ -86,8 +86,7 @@ inline void listen_ ## m (Stream_event *);              \
 /* Should be private */                                 \
 static void _internal_declare_ ## m ();                 \
 private:                                                \
- static Listener _get_ ## m ## _listener (void *, SCM); \
-void _listen_scm_ ## m (SCM);
+ static Listener _get_ ## m ## _listener (void *, SCM);
 
 #define DECLARE_ACKNOWLEDGER(x) public : void acknowledge_ ## x (Grob_info); protected:
 #define DECLARE_END_ACKNOWLEDGER(x) public : void acknowledge_end_ ## x (Grob_info); protected:
@@ -150,6 +149,7 @@ public:
 protected:                      // should be private.
   Context *daddy_context_;
   void protect_event (SCM ev);
+  friend class Callback_wrapper;
   virtual void derived_mark () const;
   static void add_translator_listener (translator_listener_record **listener_list,
                                        translator_listener_record *r,
diff --git a/lily/include/translator.icc b/lily/include/translator.icc
index 087fb4da19..f583d32aad 100644
--- a/lily/include/translator.icc
+++ b/lily/include/translator.icc
@@ -141,20 +141,12 @@ cl :: _internal_declare_ ## m ()                        \
                                                         \
 ADD_SCM_INIT_FUNC (cl ## _declare_event_ ## m, cl::_internal_declare_ ## m);    \
                                                         \
-Listener                                                \
- cl :: _get_ ## m ## _listener (void *me, SCM unused)   \
-{                                                       \
-  cl *obj = (cl *) me;                                  \
-  (void) unused; \
-  return obj->GET_LISTENER (cl, _listen_scm_ ## m);         \
-}                                                       \
-                                                        \
-void                                                    \
-cl::_listen_scm_ ## m (SCM sev)                         \
-{                                                       \
-  Stream_event *ev = Stream_event::unsmob (sev);         \
-  protect_event (sev);                                  \
-  listen_ ## m (ev);                                    \
-}
+ Listener                                                               \
+ cl :: _get_ ## m ## _listener (void *me, SCM)                          \
+ {                                                                      \
+   cl *obj = (cl *) me;                                                 \
+   return obj->get_listener                                             \
+     (Callback_wrapper::make_smob<cl, Stream_event *, &cl::listen_ ## m> ());      \
+ }
 
 #endif /* TRANSLATOR_ICC */
-- 
2.39.5