lily/dispatcher.cc

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