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
  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 p, scm_print_state *)
  53 {
  54   scm_puts ("#<Dispatcher ", p);
  55   scm_write (scm_call_1 (ly_lily_module_constant ("hash-table->alist"),
  56                          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 = Stream_event::unsmob (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 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 (Dispatcher, dispatch).smobbed_copy (),
 239                                     ev_class, priority);
 240         }
 241       listen_classes_ = scm_cons (ev_class, listen_classes_);
 242     }
 243   SCM entry = scm_cons (scm_from_int (priority), callback);
 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 (scm_is_null (list))
 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 (*Listener::unsmob (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 = Dispatcher::unsmob (scm_caar (disp));
 284           d->remove_listener (GET_LISTENER (Dispatcher, 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_is_true (scm_assq (disp->self_scm (), dispatchers_)))
 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   SCM list = GET_LISTENER (Dispatcher, dispatch).smobbed_copy ();
 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 (Dispatcher, 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 }