From: David Kastrup Date: Wed, 25 Apr 2012 15:33:09 +0000 (+0200) Subject: Make detection of listened events a property of dispatchers instead of global X-Git-Tag: release/2.15.38-1~6 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c8e0c11cd618db0ad8af087da74a704b284add35;p=lilypond.git 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 4c6064acb2..6d930b944e 100644 --- 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 f546064368..c2e777a131 100644 --- 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 b11167121b..31bed90c7e 100644 --- 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 7bab0cfa74..fec5aaacb1 100644 --- 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 427436a12f..3a91d9d7cb 100644 --- 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 a35a1a1d24..154ffa4b08 100644 --- 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 f5a6cea5f0..51709463db 100644 --- 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))))