lily/dispatcher.cc

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