2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2005--2014 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"
25 const char Dispatcher::type_p_name_[] = "ly:dispatcher?";
27 Dispatcher::~Dispatcher ()
31 Dispatcher::Dispatcher ()
34 dispatchers_ = SCM_EOL;
35 listen_classes_ = SCM_EOL;
37 // TODO: use resizable hash (guile 1.8)
38 // listeners_ = scm_c_make_hash_table (0);
39 listeners_ = scm_c_make_hash_table (17);
44 Dispatcher::mark_smob ()
46 scm_gc_mark (dispatchers_);
47 scm_gc_mark (listen_classes_);
52 Dispatcher::print_smob (SCM p, scm_print_state *)
54 scm_puts ("#<Dispatcher ", p);
55 scm_write (scm_call_1 (ly_lily_module_constant ("hash-table->alist"),
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
75 IMPLEMENT_LISTENER (Dispatcher, dispatch);
77 Dispatcher::dispatch (SCM sev)
79 Stream_event *ev = Stream_event::unsmob (sev);
80 SCM class_list = ev->get_property ("class");
81 if (!scm_is_pair (class_list))
83 ev->origin ()->warning (_ ("Event class should be a list"));
90 int num_classes = scm_ilength (class_list);
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
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
106 The first step is to collect all listener lists and to initially
107 insert them in the priority queue.
109 struct { int prio; SCM list; } lists[num_classes + 1];
111 for (SCM cl = class_list; scm_is_pair (cl); cl = scm_cdr (cl))
113 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
114 if (!scm_is_pair (list))
119 int prio = scm_to_int (scm_caar (list));
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;
128 lists[num_classes].prio = INT_MAX;
130 // Never send an event to two listeners with equal priority.
131 int last_priority = -1;
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.
139 // Send the event, if we haven't already sent it to this target.
140 if (lists[0].prio != last_priority)
142 // process the listener
143 assert (lists[0].prio > last_priority);
144 last_priority = lists[0].prio;
146 Listener *l = Listener::unsmob (scm_cdar (lists[0].list));
147 l->listen (ev->self_scm ());
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))
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;
164 /* TODO: Uncomment. */
166 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
171 Dispatcher::is_listened_class (SCM cl)
173 for (; scm_is_pair (cl); cl = scm_cdr (cl))
175 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
176 if (scm_is_pair (list))
183 accumulate_types (void * /* closure */,
188 if (scm_is_pair (val))
189 return scm_cons (key, result);
194 Dispatcher::listened_types ()
196 return scm_internal_hash_fold ((scm_t_hash_fold_fn) &accumulate_types,
197 NULL, SCM_EOL, listeners_);
201 Dispatcher::broadcast (Stream_event *ev)
203 dispatch (ev->self_scm ());
206 // add_listener will always assign a new priority for each call
208 Dispatcher::add_listener (Listener l, SCM ev_class)
210 internal_add_listener (l, ev_class, ++priority_count_);
214 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
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))
227 /* Tell all dispatchers that we listen to, that we want to hear ev_class
229 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
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);
235 listen_classes_ = scm_cons (ev_class, listen_classes_);
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);
243 Dispatcher::remove_listener (Listener l, SCM ev_class)
245 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
249 programming_error ("remove_listener called with incorrect class.");
253 // We just remove the listener once.
256 SCM dummy = scm_cons (SCM_EOL, list);
258 while (scm_is_pair (scm_cdr (e)))
259 if (*Listener::unsmob (scm_cdadr (e)) == l && first)
261 scm_set_cdr_x (e, scm_cddr (e));
267 list = scm_cdr (dummy);
268 scm_hashq_set_x (listeners_, ev_class, list);
271 warning (_ ("Attempting to remove nonexisting listener."));
272 else if (!scm_is_pair (list))
274 /* Unregister with all dispatchers. */
275 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
277 Dispatcher *d = Dispatcher::unsmob (scm_caar (disp));
278 d->remove_listener (GET_LISTENER (dispatch), ev_class);
280 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
284 /* Register as a listener to another dispatcher. */
286 Dispatcher::register_as_listener (Dispatcher *disp)
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_;
294 // Don't register twice to the same dispatcher.
295 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
297 warning (_ ("Already listening to dispatcher, ignoring request"));
301 dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
303 Listener list = GET_LISTENER (dispatch);
304 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
306 disp->internal_add_listener (list, scm_car (cl), priority);
310 /* Unregister as a listener to another dispatcher. */
312 Dispatcher::unregister_as_listener (Dispatcher *disp)
314 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
316 Listener listener = GET_LISTENER (dispatch);
317 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
319 disp->remove_listener (listener, scm_car (cl));