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