2 dispatcher.cc -- implement Dispatcher
4 source file of the GNU LilyPond music typesetter
6 (c) 2005-2006 Erik Sandberg <mandolaerik@gmail.com>
9 #include "dispatcher.hh"
11 #include "international.hh"
12 #include "ly-smobs.icc"
13 #include "stream-event.hh"
16 // ES todo: move to lily-guile.hh
17 SCM appendable_list ();
18 void appendable_list_append (SCM l, SCM elt);
20 IMPLEMENT_SMOBS (Dispatcher);
21 IMPLEMENT_TYPE_P (Dispatcher, "dispatcher");
22 IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
24 Dispatcher::~Dispatcher ()
28 Dispatcher::Dispatcher ()
32 dispatchers_ = SCM_EOL;
33 listen_classes_ = SCM_EOL;
35 // TODO: use resizable hash (guile 1.8)
36 // listeners_ = scm_c_make_hash_table (0);
37 listeners_ = scm_c_make_hash_table (17);
42 Dispatcher::mark_smob (SCM sm)
44 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
45 scm_gc_mark (me->dispatchers_);
46 scm_gc_mark (me->listen_classes_);
47 return me->listeners_;
51 Dispatcher::print_smob (SCM s, SCM p, scm_print_state*)
53 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
54 scm_puts ("#<Dispatcher ", p);
55 scm_write (scm_vector_to_list (me->listeners_), p);
62 - Collect a list of listeners for each relevant class
63 - Send the event to each of these listeners, in increasing priority order.
64 This is done by keeping a priority queue of listener lists,
65 and iteratively send the event to the lowest-priority listener.
66 - An event is never sent twice to listeners with equal priority.
68 IMPLEMENT_LISTENER (Dispatcher, dispatch);
70 Dispatcher::dispatch (SCM sev)
72 Stream_event *ev = unsmob_stream_event (sev);
73 SCM class_symbol = ev->get_property ("class");
74 if (!scm_symbol_p (class_symbol))
76 warning (_f ("Event class should be a symbol"));
80 SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
81 if (!scm_is_pair (class_list))
83 ev->origin ()->warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
87 int num_classes = scm_ilength (class_list);
90 For each event class there is a list of listeners, which is
91 ordered by priority. Our next task is to call these listeners, in
92 priority order. A priority queue stores the next element in each
93 listener list, and the lowest priority element is repeatedly
96 The priority queue is implemented as a bubble-sorted C
97 array. Using the stack instead of native Scheme datastructures
98 avoids overheads for memory allocation. The queue is usually small
99 (around 2 elements), so the quadratic sorting time is not a
100 problem. (if this changes, it's easy to rewrite this routine using
103 The first step is to collect all listener lists and to initially
104 insert them in the priority queue.
106 struct { int prio; SCM list; } lists[num_classes+1];
108 for (SCM cl = class_list; scm_is_pair(cl); cl = scm_cdr (cl))
110 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
111 if (!scm_is_pair(list))
116 int prio = scm_to_int (scm_caar (list));
118 for (j = i; j > 0 && lists[j-1].prio > prio; j--)
119 lists[j] = lists[j-1];
120 lists[j].prio = prio;
121 lists[j].list = list;
125 lists[num_classes].prio = INT_MAX;
127 // Never send an event to two listeners with equal priority.
128 int last_priority = -1;
130 Each iteration extracts the lowest-priority element, which is a
131 list of listeners. The first listener is called, and the tail of
132 the list is pushed back into the priority queue.
136 // Send the event, if we haven't already sent it to this target.
137 if (lists[0].prio != last_priority)
139 // process the listener
140 assert (lists[0].prio > last_priority);
141 last_priority = lists[0].prio;
143 Listener *l = unsmob_listener (scm_cdar (lists[0].list));
144 l->listen (ev->self_scm ());
147 // go to the next listener; bubble-sort the class list.
148 SCM next = scm_cdr (lists[0].list);
149 if (!scm_is_pair(next))
151 int prio = (scm_is_pair(next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
152 for (i = 0; prio > lists[i+1].prio; i++)
153 lists[i] = lists[i+1];
154 lists[i].prio = prio;
155 lists[i].list = next;
160 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
165 Dispatcher::broadcast (Stream_event *ev)
167 dispatch (ev->self_scm ());
171 Dispatcher::add_listener (Listener l, SCM ev_class)
173 internal_add_listener (l, ev_class, ++priority_count_);
177 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
179 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
180 if (!scm_is_pair (list))
182 /* Tell all dispatchers that we listen to, that we want to hear ev_class
184 for (SCM disp = dispatchers_; scm_is_pair(disp); disp = scm_cdr (disp))
186 int priority = scm_to_int (scm_cdar (disp));
187 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
188 d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
190 listen_classes_ = scm_cons (ev_class, listen_classes_);
192 SCM entry = scm_cons (scm_int2num (priority), l.smobbed_copy ());
193 list = scm_merge (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
194 scm_hashq_set_x (listeners_, ev_class, list);
198 Dispatcher::remove_listener (Listener l, SCM ev_class)
200 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
204 programming_error ("remove_listener called with incorrect class.");
208 // We just remove the listener once.
211 SCM dummy = scm_cons (SCM_EOL, list);
213 while (scm_is_pair(scm_cdr (e)))
214 if (*unsmob_listener (scm_cdadr (e)) == l && first)
216 scm_set_cdr_x (e, scm_cddr(e));
222 list = scm_cdr (dummy);
223 scm_hashq_set_x (listeners_, ev_class, list);
226 warning ("Attempting to remove nonexisting listener.");
227 else if (!scm_is_pair (list))
229 /* Unregister with all dispatchers. */
230 for (SCM disp = dispatchers_; disp != SCM_EOL; disp = scm_cdr (disp))
232 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
233 d->remove_listener (GET_LISTENER (dispatch), ev_class);
235 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
239 /* Register as a listener to another dispatcher. */
241 Dispatcher::register_as_listener (Dispatcher *disp)
243 int priority = ++disp->priority_count_;
245 // Don't register twice to the same dispatcher.
246 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
248 warning ("Already listening to dispatcher, ignoring request");
252 dispatchers_ = scm_acons (disp->self_scm (), scm_int2num (priority), dispatchers_);
254 Listener list = GET_LISTENER (dispatch);
255 for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
257 disp->internal_add_listener (list, scm_car (cl), priority);
261 /* Unregister as a listener to another dispatcher. */
263 Dispatcher::unregister_as_listener (Dispatcher *disp)
265 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
267 Listener listener = GET_LISTENER (dispatch);
268 for (SCM cl = listen_classes_; scm_is_pair (cl); cl = scm_cdr (cl))
270 disp->remove_listener (listener, scm_car (cl));