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   internal_add_listener (l, ev_class, ++priority_count_);
 210 }
 211
 212 inline void
 213 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
 214 {
 215   SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
 216   // if ev_class is not yet listened to, we go through our list of
 217   // source dispatchers and register ourselves there with the priority
 218   // we have reserved for this dispatcher.  The priority system
 219   // usually distributes events in the order events are registered.
 220   // The reuse of a previous priority when registering another event
 221   // for a dispatcher/dispatcher connection bypasses the normal
 222   // ordering, but it is the mechanism by which duplicate broadcasts
 223   // of the same event from one dispatcher to another are avoided.
 224   if (!scm_is_pair (list))
 225     {
 226       /* Tell all dispatchers that we listen to, that we want to hear ev_class
 227          events */
 228       for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
 229         {
 230           int priority = scm_to_int (scm_cdar (disp));
 231           Dispatcher *d = Dispatcher::unsmob (scm_caar (disp));
 232           d->internal_add_listener (GET_LISTENER (Dispatcher, dispatch), ev_class, priority);
 233         }
 234       listen_classes_ = scm_cons (ev_class, listen_classes_);
 235     }
 236   SCM entry = scm_cons (scm_from_int (priority), l.smobbed_copy ());
 237   list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
 238   scm_hashq_set_x (listeners_, ev_class, list);
 239 }
 240
 241 void
 242 Dispatcher::remove_listener (Listener l, SCM ev_class)
 243 {
 244   SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
 245
 246   if (scm_is_null (list))
 247     {
 248       programming_error ("remove_listener called with incorrect class.");
 249       return;
 250     }
 251
 252   // We just remove the listener once.
 253   bool first = true;
 254
 255   SCM dummy = scm_cons (SCM_EOL, list);
 256   SCM e = dummy;
 257   while (scm_is_pair (scm_cdr (e)))
 258     if (*Listener::unsmob (scm_cdadr (e)) == l && first)
 259       {
 260         scm_set_cdr_x (e, scm_cddr (e));
 261         first = false;
 262         break;
 263       }
 264     else
 265       e = scm_cdr (e);
 266   list = scm_cdr (dummy);
 267   scm_hashq_set_x (listeners_, ev_class, list);
 268
 269   if (first)
 270     warning (_ ("Attempting to remove nonexisting listener."));
 271   else if (!scm_is_pair (list))
 272     {
 273       /* Unregister with all dispatchers. */
 274       for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
 275         {
 276           Dispatcher *d = Dispatcher::unsmob (scm_caar (disp));
 277           d->remove_listener (GET_LISTENER (Dispatcher, dispatch), ev_class);
 278         }
 279       listen_classes_ = scm_delq_x (ev_class, listen_classes_);
 280     }
 281 }
 282
 283 /* Register as a listener to another dispatcher. */
 284 void
 285 Dispatcher::register_as_listener (Dispatcher *disp)
 286 {
 287   // We are creating and remembering the priority _we_ have with the
 288   // foreign dispatcher.  All events are dispatched with the same
 289   // priority.  The result is that, for example, a single event class
 290   // will only trigger an event listener once.
 291   int priority = ++disp->priority_count_;
 292
 293   // Don't register twice to the same dispatcher.
 294   if (scm_is_true (scm_assq (disp->self_scm (), dispatchers_)))
 295     {
 296       warning (_ ("Already listening to dispatcher, ignoring request"));
 297       return;
 298     }
 299
 300   dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
 301
 302   Listener list = GET_LISTENER (Dispatcher, dispatch);
 303   for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
 304     {
 305       disp->internal_add_listener (list, scm_car (cl), priority);
 306     }
 307 }
 308
 309 /* Unregister as a listener to another dispatcher. */
 310 void
 311 Dispatcher::unregister_as_listener (Dispatcher *disp)
 312 {
 313   dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
 314
 315   Listener listener = GET_LISTENER (Dispatcher, dispatch);
 316   for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
 317     {
 318       disp->remove_listener (listener, scm_car (cl));
 319     }
 320 }