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