lily/dispatcher.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2005--2012 Erik Sandberg  <mandolaerik@gmail.com>
   5
   6   LilyPond is free software: you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation, either version 3 of the License, or
   9   (at your option) any later version.
  10
  11   LilyPond is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 */
  19
  20 #include "dispatcher.hh"
  21 #include "input.hh"
  22 #include "international.hh"
  23 #include "ly-smobs.icc"
  24 #include "warn.hh"
  25
  26 IMPLEMENT_SMOBS (Dispatcher);
  27 IMPLEMENT_TYPE_P (Dispatcher, "ly:dispatcher?");
  28 IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
  29
  30 Dispatcher::~Dispatcher ()
  31 {
  32 }
  33
  34 Dispatcher::Dispatcher ()
  35 {
  36   self_scm_ = SCM_EOL;
  37   listeners_ = SCM_EOL;
  38   dispatchers_ = SCM_EOL;
  39   listen_classes_ = SCM_EOL;
  40   smobify_self ();
  41 // TODO: use resizable hash (guile 1.8)
  42 //  listeners_ = scm_c_make_hash_table (0);
  43   listeners_ = scm_c_make_hash_table (17);
  44   priority_count_ = 0;
  45 }
  46
  47 SCM
  48 Dispatcher::mark_smob (SCM sm)
  49 {
  50   Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
  51   scm_gc_mark (me->dispatchers_);
  52   scm_gc_mark (me->listen_classes_);
  53   return me->listeners_;
  54 }
  55
  56 int
  57 Dispatcher::print_smob (SCM s, SCM p, scm_print_state *)
  58 {
  59   Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
  60   scm_puts ("#<Dispatcher ", p);
  61   scm_write (scm_call_1 (ly_lily_module_constant ("hash-table->alist"),
  62                          me->listeners_), p);
  63   scm_puts (">", p);
  64   return 1;
  65 }
  66
  67 /*
  68 Event dispatching:
  69 - Collect a list of listeners for each relevant class
  70 - Send the event to each of these listeners, in increasing priority order.
  71   This is done by keeping a priority queue of listener lists,
  72   and iteratively send the event to the lowest-priority listener.
  73 - An event is never sent twice to listeners with equal priority.
  74   The only case where listeners with equal priority may exist is when
  75   two dispatchers are connected for more than one event type.  In that
  76   case, the respective listeners all have the same priority, making
  77   sure that any event is only dispatched at most once for that
  78   combination of dispatchers, even if it matches more than one event
  79   type.
  80 */
  81 IMPLEMENT_LISTENER (Dispatcher, dispatch);
  82 void
  83 Dispatcher::dispatch (SCM sev)
  84 {
  85   Stream_event *ev = unsmob_stream_event (sev);
  86   SCM class_list = ev->get_property ("class");
  87   if (!scm_is_pair (class_list))
  88     {
  89       ev->origin ()->warning (_ ("Event class should be a list"));
  90       return;
  91     }
  92
  93 #if 0
  94   bool sent = false;
  95 #endif
  96   int num_classes = scm_ilength (class_list);
  97
  98   /*
  99     For each event class there is a list of listeners, which is
 100     ordered by priority. Our next task is to call these listeners, in
 101     priority order.  A priority queue stores the next element in each
 102     listener list, and the lowest priority element is repeatedly
 103     extracted and called.
 104
 105     The priority queue is implemented as an insertion-sorted C
 106     array. Using the stack instead of native Scheme datastructures
 107     avoids overheads for memory allocation. The queue is usually small
 108     (around 2 elements), so the quadratic sorting time is not a
 109     problem. (if this changes, it's easy to rewrite this routine using
 110     a heap)
 111
 112     The first step is to collect all listener lists and to initially
 113     insert them in the priority queue.
 114   */
 115   struct { int prio; SCM list; } lists[num_classes + 1];
 116   int i = 0;
 117   for (SCM cl = class_list; scm_is_pair (cl); cl = scm_cdr (cl))
 118     {
 119       SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
 120       if (!scm_is_pair (list))
 121         num_classes--;
 122       else
 123         {
 124           // insertion sort.
 125           int prio = scm_to_int (scm_caar (list));
 126           int j;
 127           for (j = i; j > 0 && lists[j - 1].prio > prio; j--)
 128             lists[j] = lists[j - 1];
 129           lists[j].prio = prio;
 130           lists[j].list = list;
 131           i++;
 132         }
 133     }
 134   lists[num_classes].prio = INT_MAX;
 135
 136   // Never send an event to two listeners with equal priority.
 137   int last_priority = -1;
 138   /*
 139     Each iteration extracts the lowest-priority element, which is a
 140     list of listeners. The first listener is called, and the tail of
 141     the list is pushed back into the priority queue.
 142   */
 143   while (num_classes)
 144     {
 145       // Send the event, if we haven't already sent it to this target.
 146       if (lists[0].prio != last_priority)
 147         {
 148           // process the listener
 149           assert (lists[0].prio > last_priority);
 150           last_priority = lists[0].prio;
 151
 152           Listener *l = unsmob_listener (scm_cdar (lists[0].list));
 153           l->listen (ev->self_scm ());
 154 #if 0
 155           sent = true;
 156 #endif
 157         }
 158       // go to the next listener; bubble-sort the class list.
 159       SCM next = scm_cdr (lists[0].list);
 160       if (!scm_is_pair (next))
 161         num_classes--;
 162       int prio = (scm_is_pair (next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
 163       for (i = 0; prio > lists[i + 1].prio; i++)
 164         lists[i] = lists[i + 1];
 165       lists[i].prio = prio;
 166       lists[i].list = next;
 167     }
 168
 169 #if 0
 170   /* TODO: Uncomment. */
 171   if (!sent)
 172     warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
 173 #endif
 174 }
 175
 176 bool
 177 Dispatcher::is_listened_class (SCM cl)
 178 {
 179   for (; scm_is_pair (cl); cl = scm_cdr (cl))
 180     {
 181       SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
 182       if (scm_is_pair (list))
 183         return true;
 184     }
 185   return false;
 186 }
 187
 188 static SCM
 189 accumulate_types (void * /* closure */,
 190                   SCM key,
 191                   SCM val,
 192                   SCM result)
 193 {
 194   if (scm_is_pair (val))
 195     return scm_cons (key, result);
 196   return result;
 197 }
 198
 199 SCM
 200 Dispatcher::listened_types ()
 201 {
 202   return scm_internal_hash_fold ((scm_t_hash_fold_fn) &accumulate_types,
 203                                  NULL, SCM_EOL, listeners_);
 204 }
 205
 206 void
 207 Dispatcher::broadcast (Stream_event *ev)
 208 {
 209   dispatch (ev->self_scm ());
 210 }
 211
 212 // add_listener will always assign a new priority for each call
 213 void
 214 Dispatcher::add_listener (Listener l, SCM ev_class)
 215 {
 216   internal_add_listener (l, ev_class, ++priority_count_);
 217 }
 218
 219 inline void
 220 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
 221 {
 222   SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
 223   // if ev_class is not yet listened to, we go through our list of
 224   // source dispatchers and register ourselves there with the priority
 225   // we have reserved for this dispatcher.  The priority system
 226   // usually distributes events in the order events are registered.
 227   // The reuse of a previous priority when registering another event
 228   // for a dispatcher/dispatcher connection bypasses the normal
 229   // ordering, but it is the mechanism by which duplicate broadcasts
 230   // of the same event from one dispatcher to another are avoided.
 231   if (!scm_is_pair (list))
 232     {
 233       /* Tell all dispatchers that we listen to, that we want to hear ev_class
 234          events */
 235       for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
 236         {
 237           int priority = scm_to_int (scm_cdar (disp));
 238           Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
 239           d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
 240         }
 241       listen_classes_ = scm_cons (ev_class, listen_classes_);
 242     }
 243   SCM entry = scm_cons (scm_from_int (priority), l.smobbed_copy ());
 244   list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
 245   scm_hashq_set_x (listeners_, ev_class, list);
 246 }
 247
 248 void
 249 Dispatcher::remove_listener (Listener l, SCM ev_class)
 250 {
 251   SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
 252
 253   if (list == SCM_EOL)
 254     {
 255       programming_error ("remove_listener called with incorrect class.");
 256       return;
 257     }
 258
 259   // We just remove the listener once.
 260   bool first = true;
 261
 262   SCM dummy = scm_cons (SCM_EOL, list);
 263   SCM e = dummy;
 264   while (scm_is_pair (scm_cdr (e)))
 265     if (*unsmob_listener (scm_cdadr (e)) == l && first)
 266       {
 267         scm_set_cdr_x (e, scm_cddr (e));
 268         first = false;
 269         break;
 270       }
 271     else
 272       e = scm_cdr (e);
 273   list = scm_cdr (dummy);
 274   scm_hashq_set_x (listeners_, ev_class, list);
 275
 276   if (first)
 277     warning (_ ("Attempting to remove nonexisting listener."));
 278   else if (!scm_is_pair (list))
 279     {
 280       /* Unregister with all dispatchers. */
 281       for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
 282         {
 283           Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
 284           d->remove_listener (GET_LISTENER (dispatch), ev_class);
 285         }
 286       listen_classes_ = scm_delq_x (ev_class, listen_classes_);
 287     }
 288 }
 289
 290 /* Register as a listener to another dispatcher. */
 291 void
 292 Dispatcher::register_as_listener (Dispatcher *disp)
 293 {
 294   // We are creating and remembering the priority _we_ have with the
 295   // foreign dispatcher.  All events are dispatched with the same
 296   // priority.  The result is that, for example, a single event class
 297   // will only trigger an event listener once.
 298   int priority = ++disp->priority_count_;
 299
 300   // Don't register twice to the same dispatcher.
 301   if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
 302     {
 303       warning (_ ("Already listening to dispatcher, ignoring request"));
 304       return;
 305     }
 306
 307   dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
 308
 309   Listener list = GET_LISTENER (dispatch);
 310   for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
 311     {
 312       disp->internal_add_listener (list, scm_car (cl), priority);
 313     }
 314 }
 315
 316 /* Unregister as a listener to another dispatcher. */
 317 void
 318 Dispatcher::unregister_as_listener (Dispatcher *disp)
 319 {
 320   dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
 321
 322   Listener listener = GET_LISTENER (dispatch);
 323   for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
 324     {
 325       disp->remove_listener (listener, scm_car (cl));
 326     }
 327 }