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 (SCM sm)
46 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
47 scm_gc_mark (me->dispatchers_);
48 scm_gc_mark (me->listen_classes_);
49 return me->listeners_;
53 Dispatcher::print_smob (SCM s, SCM p, scm_print_state *)
55 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
56 scm_puts ("#<Dispatcher ", p);
57 scm_write (scm_call_1 (ly_lily_module_constant ("hash-table->alist"),
65 - Collect a list of listeners for each relevant class
66 - Send the event to each of these listeners, in increasing priority order.
67 This is done by keeping a priority queue of listener lists,
68 and iteratively send the event to the lowest-priority listener.
69 - An event is never sent twice to listeners with equal priority.
70 The only case where listeners with equal priority may exist is when
71 two dispatchers are connected for more than one event type. In that
72 case, the respective listeners all have the same priority, making
73 sure that any event is only dispatched at most once for that
74 combination of dispatchers, even if it matches more than one event
77 IMPLEMENT_LISTENER (Dispatcher, dispatch);
79 Dispatcher::dispatch (SCM sev)
81 Stream_event *ev = Stream_event::unsmob (sev);
82 SCM class_list = ev->get_property ("class");
83 if (!scm_is_pair (class_list))
85 ev->origin ()->warning (_ ("Event class should be a list"));
92 int num_classes = scm_ilength (class_list);
95 For each event class there is a list of listeners, which is
96 ordered by priority. Our next task is to call these listeners, in
97 priority order. A priority queue stores the next element in each
98 listener list, and the lowest priority element is repeatedly
101 The priority queue is implemented as an insertion-sorted C
102 array. Using the stack instead of native Scheme datastructures
103 avoids overheads for memory allocation. The queue is usually small
104 (around 2 elements), so the quadratic sorting time is not a
105 problem. (if this changes, it's easy to rewrite this routine using
108 The first step is to collect all listener lists and to initially
109 insert them in the priority queue.
111 struct { int prio; SCM list; } lists[num_classes + 1];
113 for (SCM cl = class_list; scm_is_pair (cl); cl = scm_cdr (cl))
115 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
116 if (!scm_is_pair (list))
121 int prio = scm_to_int (scm_caar (list));
123 for (j = i; j > 0 && lists[j - 1].prio > prio; j--)
124 lists[j] = lists[j - 1];
125 lists[j].prio = prio;
126 lists[j].list = list;
130 lists[num_classes].prio = INT_MAX;
132 // Never send an event to two listeners with equal priority.
133 int last_priority = -1;
135 Each iteration extracts the lowest-priority element, which is a
136 list of listeners. The first listener is called, and the tail of
137 the list is pushed back into the priority queue.
141 // Send the event, if we haven't already sent it to this target.
142 if (lists[0].prio != last_priority)
144 // process the listener
145 assert (lists[0].prio > last_priority);
146 last_priority = lists[0].prio;
148 Listener *l = Listener::unsmob (scm_cdar (lists[0].list));
149 l->listen (ev->self_scm ());
154 // go to the next listener; bubble-sort the class list.
155 SCM next = scm_cdr (lists[0].list);
156 if (!scm_is_pair (next))
158 int prio = (scm_is_pair (next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
159 for (i = 0; prio > lists[i + 1].prio; i++)
160 lists[i] = lists[i + 1];
161 lists[i].prio = prio;
162 lists[i].list = next;
166 /* TODO: Uncomment. */
168 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
173 Dispatcher::is_listened_class (SCM cl)
175 for (; scm_is_pair (cl); cl = scm_cdr (cl))
177 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
178 if (scm_is_pair (list))
185 accumulate_types (void * /* closure */,
190 if (scm_is_pair (val))
191 return scm_cons (key, result);
196 Dispatcher::listened_types ()
198 return scm_internal_hash_fold ((scm_t_hash_fold_fn) &accumulate_types,
199 NULL, SCM_EOL, listeners_);
203 Dispatcher::broadcast (Stream_event *ev)
205 dispatch (ev->self_scm ());
208 // add_listener will always assign a new priority for each call
210 Dispatcher::add_listener (Listener l, SCM ev_class)
212 internal_add_listener (l, ev_class, ++priority_count_);
216 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
218 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
219 // if ev_class is not yet listened to, we go through our list of
220 // source dispatchers and register ourselves there with the priority
221 // we have reserved for this dispatcher. The priority system
222 // usually distributes events in the order events are registered.
223 // The reuse of a previous priority when registering another event
224 // for a dispatcher/dispatcher connection bypasses the normal
225 // ordering, but it is the mechanism by which duplicate broadcasts
226 // of the same event from one dispatcher to another are avoided.
227 if (!scm_is_pair (list))
229 /* Tell all dispatchers that we listen to, that we want to hear ev_class
231 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
233 int priority = scm_to_int (scm_cdar (disp));
234 Dispatcher *d = Dispatcher::unsmob (scm_caar (disp));
235 d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
237 listen_classes_ = scm_cons (ev_class, listen_classes_);
239 SCM entry = scm_cons (scm_from_int (priority), l.smobbed_copy ());
240 list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
241 scm_hashq_set_x (listeners_, ev_class, list);
245 Dispatcher::remove_listener (Listener l, SCM ev_class)
247 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
251 programming_error ("remove_listener called with incorrect class.");
255 // We just remove the listener once.
258 SCM dummy = scm_cons (SCM_EOL, list);
260 while (scm_is_pair (scm_cdr (e)))
261 if (*Listener::unsmob (scm_cdadr (e)) == l && first)
263 scm_set_cdr_x (e, scm_cddr (e));
269 list = scm_cdr (dummy);
270 scm_hashq_set_x (listeners_, ev_class, list);
273 warning (_ ("Attempting to remove nonexisting listener."));
274 else if (!scm_is_pair (list))
276 /* Unregister with all dispatchers. */
277 for (SCM disp = dispatchers_; scm_is_pair (disp); disp = scm_cdr (disp))
279 Dispatcher *d = Dispatcher::unsmob (scm_caar (disp));
280 d->remove_listener (GET_LISTENER (dispatch), ev_class);
282 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
286 /* Register as a listener to another dispatcher. */
288 Dispatcher::register_as_listener (Dispatcher *disp)
290 // We are creating and remembering the priority _we_ have with the
291 // foreign dispatcher. All events are dispatched with the same
292 // priority. The result is that, for example, a single event class
293 // will only trigger an event listener once.
294 int priority = ++disp->priority_count_;
296 // Don't register twice to the same dispatcher.
297 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
299 warning (_ ("Already listening to dispatcher, ignoring request"));
303 dispatchers_ = scm_acons (disp->self_scm (), scm_from_int (priority), dispatchers_);
305 Listener list = GET_LISTENER (dispatch);
306 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
308 disp->internal_add_listener (list, scm_car (cl), priority);
312 /* Unregister as a listener to another dispatcher. */
314 Dispatcher::unregister_as_listener (Dispatcher *disp)
316 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
318 Listener listener = GET_LISTENER (dispatch);
319 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
321 disp->remove_listener (listener, scm_car (cl));