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