2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2005--2015 Erik Sandberg <mandolaerik@gmail.com>
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.
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.
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/>.
20 #include "dispatcher.hh"
22 #include "international.hh"
24 #include "lily-imports.hh"
26 const char * const Dispatcher::type_p_name_ = "ly:dispatcher?";
28 Dispatcher::~Dispatcher ()
32 Dispatcher::Dispatcher ()
35 dispatchers_ = SCM_EOL;
36 listen_classes_ = SCM_EOL;
38 // TODO: use resizable hash (guile 1.8)
39 // listeners_ = scm_c_make_hash_table (0);
40 listeners_ = scm_c_make_hash_table (17);
45 Dispatcher::mark_smob () const
47 scm_gc_mark (dispatchers_);
48 scm_gc_mark (listen_classes_);
53 Dispatcher::print_smob (SCM p, scm_print_state *) const
55 scm_puts ("#<Dispatcher ", p);
56 scm_write (Lily::hash_table_to_alist (listeners_), p);
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
76 Dispatcher::dispatch (SCM sev)
78 Stream_event *ev = unsmob<Stream_event> (sev);
79 SCM class_list = ev->get_property ("class");
80 if (!scm_is_pair (class_list))
82 ev->origin ()->warning (_ ("Event class should be a list"));
89 int num_classes = scm_ilength (class_list);
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
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
105 The first step is to collect all listener lists and to initially
106 insert them in the priority queue.
108 struct { int prio; SCM list; } lists[num_classes + 1];
110 for (SCM cl = class_list; scm_is_pair (cl); cl = scm_cdr (cl))
112 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
113 if (!scm_is_pair (list))
118 int prio = scm_to_int (scm_caar (list));
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;
127 lists[num_classes].prio = INT_MAX;
129 // Never send an event to two listeners with equal priority.
130 int last_priority = -1;
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.
138 // Send the event, if we haven't already sent it to this target.
139 if (lists[0].prio != last_priority)
141 // process the listener
142 assert (lists[0].prio > last_priority);
143 last_priority = lists[0].prio;
145 SCM l = scm_cdar (lists[0].list);
146 scm_call_1 (l, ev->self_scm ());
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))
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;
163 /* TODO: Uncomment. */
165 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
170 Dispatcher::is_listened_class (SCM cl)
172 for (; scm_is_pair (cl); cl = scm_cdr (cl))
174 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
175 if (scm_is_pair (list))
182 accumulate_types (void * /* closure */,
187 if (scm_is_pair (val))
188 return scm_cons (key, result);
193 Dispatcher::listened_types ()
195 return scm_internal_hash_fold ((scm_t_hash_fold_fn) &accumulate_types,
196 NULL, SCM_EOL, listeners_);
200 Dispatcher::broadcast (Stream_event *ev)
202 dispatch (ev->self_scm ());
205 // add_listener will always assign a new priority for each call
207 Dispatcher::add_listener (Listener l, SCM ev_class)
209 add_listener (l.smobbed_copy (), ev_class);
213 Dispatcher::add_listener (SCM callback, SCM ev_class)
215 internal_add_listener (callback, ev_class, ++priority_count_);
219 Dispatcher::internal_add_listener (SCM callback, SCM ev_class, int priority)
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))
233 /* Tell all dispatchers that we listen to, that we want to hear ev_class
235 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
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 (),
242 listen_classes_ = scm_cons (ev_class, listen_classes_);
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);
250 Dispatcher::remove_listener (Listener l, SCM ev_class)
252 SCM handle = scm_hashq_get_handle (listeners_, ev_class);
254 if (scm_is_false (handle))
256 programming_error ("remove_listener called with incorrect class.");
260 SCM list = scm_cdr (handle);
261 // We just remove the listener once.
264 SCM dummy = scm_cons (SCM_EOL, list);
266 while (scm_is_pair (scm_cdr (e)))
267 if (*unsmob<Listener> (scm_cdadr (e)) == l && first)
269 scm_set_cdr_x (e, scm_cddr (e));
275 list = scm_cdr (dummy);
276 scm_set_cdr_x (handle, list);
279 warning (_ ("Attempting to remove nonexisting listener."));
280 else if (!scm_is_pair (list))
282 /* Unregister with all dispatchers. */
283 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
285 Dispatcher *d = unsmob<Dispatcher> (scm_caar (disp));
286 d->remove_listener (GET_LISTENER (Dispatcher, dispatch), ev_class);
288 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
292 /* Register as a listener to another dispatcher. */
294 Dispatcher::register_as_listener (Dispatcher *disp)
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_;
302 // Don't register twice to the same dispatcher.
303 if (scm_is_true (scm_assq (disp->self_scm (), dispatchers_)))
305 warning (_ ("Already listening to dispatcher, ignoring request"));
309 dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
311 SCM list = GET_LISTENER (Dispatcher, dispatch).smobbed_copy ();
312 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
314 disp->internal_add_listener (list, scm_car (cl), priority);
318 /* Unregister as a listener to another dispatcher. */
320 Dispatcher::unregister_as_listener (Dispatcher *disp)
322 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
324 Listener listener = GET_LISTENER (Dispatcher, dispatch);
325 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
327 disp->remove_listener (listener, scm_car (cl));