Make detection of listened events a property of dispatchers instead of global

diff --git a/lily/dispatcher-scheme.cc b/lily/dispatcher-scheme.cc
index 4c6064acb210b4c6486e56e2e4984ba7a9644dfd..6d930b944e2e2d958ee6c6f08bc3380144ba076f 100644 (file)
--- a/lily/dispatcher-scheme.cc
+++ b/lily/dispatcher-scheme.cc
@@ -63,6 +63,36 @@ LY_DEFINE (ly_add_listener, "ly:add-listener",
   return SCM_UNDEFINED;
 }
 
+LY_DEFINE (ly_listened_event_types, "ly:listened-event-types",
+           1, 0, 0, (SCM disp),
+           "Return a list of all event types that @var{disp} listens"
+           " to.")
+{
+  LY_ASSERT_SMOB (Dispatcher, disp, 1);
+
+  SCM result = unsmob_dispatcher (disp)->listened_types ();
+
+  scm_remember_upto_here_1 (disp);
+
+  return result;
+}
+
+LY_DEFINE (ly_listened_event_class_p, "ly:listened-event-class?",
+           2, 0, 0, (SCM disp, SCM cl),
+           "Does @var{disp} listen to any event type in the list"
+           " @var{cl}?")
+{
+  LY_ASSERT_SMOB (Dispatcher, disp, 1);
+  LY_ASSERT_TYPE (scm_is_pair, cl, 2);
+
+  bool result = unsmob_dispatcher (disp)->is_listened_class (cl);
+
+  scm_remember_upto_here_1 (disp);
+
+  return scm_from_bool (result);
+}
+
+
 LY_DEFINE (ly_broadcast, "ly:broadcast",
            2, 0, 0, (SCM disp, SCM ev),
            "Send the stream event @var{ev} to the dispatcher @var{disp}.")

diff --git a/lily/dispatcher.cc b/lily/dispatcher.cc
index f54606436866771482754dd0ef6b04030b575038..c2e777a131de776b42eda946f84d4ac7018da217 100644 (file)
--- a/lily/dispatcher.cc
+++ b/lily/dispatcher.cc
@@ -168,9 +168,9 @@ Dispatcher::dispatch (SCM sev)
 }
 
 bool
-Dispatcher::is_listened (Stream_event *ev)
+Dispatcher::is_listened_class (SCM cl)
 {
-  for (SCM cl = ev->get_property ("class"); scm_is_pair (cl); cl = scm_cdr (cl))
+  for (; scm_is_pair (cl); cl = scm_cdr (cl))
     {
       SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
       if (scm_is_pair (list))
@@ -179,6 +179,23 @@ Dispatcher::is_listened (Stream_event *ev)
   return false;
 }
 
+static SCM
+accumulate_types (void * /* closure */,
+                 SCM key,
+                 SCM val,
+                 SCM result)
+{
+  if (scm_is_pair (val))
+    return scm_cons (key, result);
+  return result;
+}
+
+SCM
+Dispatcher::listened_types ()
+{
+  return scm_internal_hash_fold ((scm_t_hash_fold_fn) &accumulate_types,
+                                 NULL, SCM_EOL, listeners_);
+}
 
 void
 Dispatcher::broadcast (Stream_event *ev)

diff --git a/lily/include/dispatcher.hh b/lily/include/dispatcher.hh
index b11167121bb93ebf2b1a83f8c3ec7f0349bdbccf..31bed90c7eed6030ae55bae2d5bdf6a2530009c2 100644 (file)
--- a/lily/include/dispatcher.hh
+++ b/lily/include/dispatcher.hh
@@ -39,7 +39,8 @@ class Dispatcher
 public:
   Dispatcher ();
   void broadcast (Stream_event *ev);
-  bool is_listened (Stream_event *ev);
+  bool is_listened_class (SCM);
+  SCM listened_types ();
   void add_listener (Listener, SCM event_class);
   void remove_listener (Listener, SCM event_class);
   void register_as_listener (Dispatcher *dist);

diff --git a/lily/include/translator.icc b/lily/include/translator.icc
index 7bab0cfa74e848f13568a43d9b58f955ad7303b5..fec5aaacb121f76d7e5d8774e4d66d640328f9eb 100644 (file)
--- a/lily/include/translator.icc
+++ b/lily/include/translator.icc
@@ -36,8 +36,8 @@
   static void _ ## T ## _adder ()                                       \
   {                                                                     \
     T *t = new T;                                                       \
-    T::static_description_ = t->static_translator_description ();       \
-    scm_permanent_object (T::static_description_);                      \
+    T::static_description_ =                                           \
+      scm_permanent_object (t->static_translator_description ());      \
     add_translator (t);                                                 \
   }                                                                     \
   SCM T::translator_description () const                                \

diff --git a/lily/rhythmic-music-iterator.cc b/lily/rhythmic-music-iterator.cc
index 427436a12f00ba96c0c96ac438056cf36dfa1b49..3a91d9d7cb21ab68d4faff9152de9449be274656 100644 (file)
--- a/lily/rhythmic-music-iterator.cc
+++ b/lily/rhythmic-music-iterator.cc
@@ -61,7 +61,8 @@ Rhythmic_music_iterator::process (Moment m)
             {
              SCM art = scm_car (arts);
 
-              if (c->event_source ()->is_listened (unsmob_stream_event (art)))
+              if (c->event_source ()->is_listened_class
+                 (unsmob_stream_event (art)->get_property ("class")))
                 listened = scm_cons (art, listened);
               else
                 unlistened = scm_cons (art, unlistened);

diff --git a/lily/translator.cc b/lily/translator.cc
index a35a1a1d24ad7ecb1137997fc2e625c8f5d691a8..154ffa4b08cbd20321f906f2f3820a8e18368a24 100644 (file)
--- a/lily/translator.cc
+++ b/lily/translator.cc
@@ -133,38 +133,6 @@ Translator::disconnect_from_context (Context *c)
                                          r->event_class_);
 }
 
-static SCM listened_event_class_table;
-void
-ensure_listened_hash ()
-{
-  if (!listened_event_class_table)
-    listened_event_class_table = scm_permanent_object (scm_c_make_hash_table (61));
-}
-
-LY_DEFINE (ly_get_listened_event_classes, "ly:get-listened-event-classes",
-           0, 0, 0, (),
-           "Return a list of all event classes that some translator listens"
-           " to.")
-{
-  ensure_listened_hash ();
-  return ly_hash_table_keys (listened_event_class_table);
-}
-
-LY_DEFINE (ly_is_listened_event_class, "ly:is-listened-event-class",
-           1, 0, 0, (SCM sym),
-           "Is @var{sym} a listened event class?")
-{
-  ensure_listened_hash ();
-  return scm_hashq_ref (listened_event_class_table, sym, SCM_BOOL_F);
-}
-
-void
-add_listened_event_class (SCM sym)
-{
-  ensure_listened_hash ();
-  scm_hashq_set_x (listened_event_class_table, sym, SCM_BOOL_T);
-}
-
 /*
   internally called once, statically, for each translator
   listener. Connects the name of an event class with a procedure that
@@ -184,9 +152,11 @@ Translator::add_translator_listener (translator_listener_record **listener_list,
   name = replace_all (&name, '_', '-');
   name += "-event";
 
-  SCM class_sym = scm_from_locale_symbol (name.c_str ());
+  // we make the symbol permanent in order not to have to bother about
+  // the static translator_listener_record chains while garbage
+  // collecting.
 
-  add_listened_event_class (class_sym);
+  SCM class_sym = scm_permanent_object (scm_from_locale_symbol (name.c_str ()));
 
   r->event_class_ = class_sym;
   r->get_listener_ = get_listener;

diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm
index f5a6cea5f01603f28080b606eef64c55079ef4cc..51709463db64d6e9c334fd43e1b5769550eee029 100644 (file)
--- a/scm/define-event-classes.scm
+++ b/scm/define-event-classes.scm
@@ -129,14 +129,6 @@
        (cons root (map expand-event-tree (cdr children)))
        root)))
 
-;; All leaf event classes that no translator listens to
-;; directly.  Avoids printing a warning.
-(define unlistened-music-event-classes
-  '(harmonic-event line-break-event page-break-event page-turn-event label-event
-                  solo-one-event solo-two-event skip-event unisono-event
-                  part-combine-force-event break-dynamic-span-event
-                  stroke-finger-event))
-
 ;; produce neater representation of music event tree.
 ;; TODO: switch to this representation for the event-classes list?
 (define music-event-tree (expand-event-tree 'music-event))
@@ -157,22 +149,6 @@
 ;;(use-modules (ice-9 pretty-print))
 ;;(pretty-print (cons (car music-event-tree) (sort-tree (cdr music-event-tree))))
 
-;; check that the music event tree corresponds well with the set of
-;; available translators; print warnings otherwise.
-(map-tree (lambda (sym)
-           (if (and (symbol? sym)
-                    (not (ly:is-listened-event-class sym))
-                    (not (assq sym event-classes))
-                    (not (memq sym unlistened-music-event-classes)))
-               (ly:programming-error (_ "event class ~A seems to be unused") sym)))
-         music-event-tree)
-
-(map (lambda (sym)
-       (if (not (pair? (ly:make-event-class sym)))
-          ;; should be programming-error
-          (ly:error (_ "translator listens to nonexisting event class ~A") sym)))
-     (ly:get-listened-event-classes))
-
 (defmacro-public make-stream-event (expr)
   (Stream_event::undump (primitive-eval (list 'quasiquote expr))))