X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fdispatcher.cc;h=0d899f94ba7ea27cfcc0b610ee4bd14d0eecb52f;hb=d4047469357aa91fc32ef9915995cc3a9bc31d2d;hp=ad1a624b121917b67fe03bc0944cce96a0325de4;hpb=9d1520b21710bd22872010ae9aa4c4899014e9d4;p=lilypond.git diff --git a/lily/dispatcher.cc b/lily/dispatcher.cc index ad1a624b12..0d899f94ba 100644 --- a/lily/dispatcher.cc +++ b/lily/dispatcher.cc @@ -59,7 +59,7 @@ Dispatcher::print_smob (SCM s, SCM p, scm_print_state *) Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s); scm_puts ("#alist"), - me->listeners_), p); + me->listeners_), p); scm_puts (">", p); return 1; } @@ -77,19 +77,13 @@ void Dispatcher::dispatch (SCM sev) { Stream_event *ev = unsmob_stream_event (sev); - SCM class_symbol = ev->get_property ("class"); - if (!scm_is_symbol (class_symbol)) - { - warning (_ ("Event class should be a symbol")); - return; - } - - SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol); + SCM class_list = ev->get_property ("class"); if (!scm_is_pair (class_list)) { - ev->origin ()->warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ())); + ev->origin ()->warning (_ ("Event class should be a list")); return; } + #if 0 bool sent = false; #endif @@ -173,6 +167,36 @@ Dispatcher::dispatch (SCM sev) #endif } +bool +Dispatcher::is_listened_class (SCM 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)) + return true; + } + 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) { @@ -235,7 +259,7 @@ Dispatcher::remove_listener (Listener l, SCM ev_class) scm_hashq_set_x (listeners_, ev_class, list); if (first) - warning ("Attempting to remove nonexisting listener."); + warning (_ ("Attempting to remove nonexisting listener.")); else if (!scm_is_pair (list)) { /* Unregister with all dispatchers. */ @@ -257,7 +281,7 @@ Dispatcher::register_as_listener (Dispatcher *disp) // Don't register twice to the same dispatcher. if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F) { - warning ("Already listening to dispatcher, ignoring request"); + warning (_ ("Already listening to dispatcher, ignoring request")); return; }