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"
10 #include "international.hh"
11 #include "ly-smobs.icc"
12 #include "stream-event.hh"
15 // ES todo: move to lily-guile.hh
16 SCM appendable_list ();
17 void appendable_list_append (SCM l, SCM elt);
19 IMPLEMENT_SMOBS (Dispatcher);
20 IMPLEMENT_TYPE_P (Dispatcher, "dispatcher");
21 IMPLEMENT_DEFAULT_EQUAL_P (Dispatcher);
23 Dispatcher::~Dispatcher ()
27 Dispatcher::Dispatcher ()
31 dispatchers_ = SCM_EOL;
32 listen_classes_ = SCM_EOL;
34 listeners_ = scm_c_make_hash_table (0);
39 Dispatcher::mark_smob (SCM sm)
41 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (sm);
42 scm_gc_mark (me->dispatchers_);
43 scm_gc_mark (me->listen_classes_);
44 return me->listeners_;
48 Dispatcher::print_smob (SCM s, SCM p, scm_print_state*)
50 Dispatcher *me = (Dispatcher *) SCM_CELL_WORD_1 (s);
51 scm_puts ("#<Dispatcher ", p);
52 scm_write (scm_vector_to_list (me->listeners_), p);
59 - Collect a list of listeners for each relevant class
60 - Send the event to each of these listeners, in increasing priority order.
61 This is done by keeping a priority queue of listener lists,
62 and iteratively send the event to the lowest-priority listener.
63 - An event is never sent twice to listeners with equal priority.
65 IMPLEMENT_LISTENER (Dispatcher, dispatch);
67 Dispatcher::dispatch (SCM sev)
69 Stream_event *ev = unsmob_stream_event (sev);
70 SCM class_symbol = ev->get_property ("class");
71 if (!scm_symbol_p (class_symbol))
73 warning (_f ("Unknown event class %s", ly_symbol2string (class_symbol).c_str ()));
77 SCM class_list = scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), class_symbol);
79 int num_classes = scm_ilength (class_list);
82 For each event class there is a list of listeners, which is
83 ordered by priority. Our next task is to call these listeners, in
84 priority order. A priority queue stores the next element in each
85 listener list, and the lowest priority element is repeatedly
88 The priority queue is implemented as a bubble-sorted C
89 array. Using the stack instead of native Scheme datastructures
90 avoids overheads for memory allocation. The queue is usually small
91 (around 2 elements), so the quadratic sorting time is not a
92 problem. (if this changes, it's easy to rewrite this routine using
95 The first step is to collect all listener lists and to initially
96 insert them in the priority queue.
98 struct { int prio; SCM list; } lists[num_classes+1];
100 for (SCM cl = class_list; scm_is_pair(cl); cl = scm_cdr (cl))
102 SCM list = scm_hashq_ref (listeners_, scm_car (cl), SCM_EOL);
103 if (!scm_is_pair(list))
108 int prio = scm_to_int (scm_caar (list));
110 for (j = i; j > 0 && lists[j-1].prio > prio; j--)
111 lists[j] = lists[j-1];
112 lists[j].prio = prio;
113 lists[j].list = list;
117 lists[num_classes].prio = INT_MAX;
119 // Never send an event to two listeners with equal priority.
120 int last_priority = -1;
122 Each iteration extracts the lowest-priority element, which is a
123 list of listeners. The first listener is called, and the tail of
124 the list is pushed back into the priority queue.
128 // Send the event, if we haven't already sent it to this target.
129 if (lists[0].prio != last_priority)
131 // process the listener
132 assert (lists[0].prio > last_priority);
133 last_priority = lists[0].prio;
135 Listener *l = unsmob_listener (scm_cdar (lists[0].list));
136 l->listen (ev->self_scm ());
139 // go to the next listener; bubble-sort the class list.
140 SCM next = scm_cdr (lists[0].list);
141 if (!scm_is_pair(next))
143 int prio = (scm_is_pair(next)) ? scm_to_int (scm_caar (next)) : INT_MAX;
144 for (i = 0; prio > lists[i+1].prio; i++)
145 lists[i] = lists[i+1];
146 lists[i].prio = prio;
147 lists[i].list = next;
151 warning (_f ("Junking event: %s", ly_symbol2string (class_symbol).c_str ()));
155 Dispatcher::broadcast (Stream_event *ev)
157 dispatch (ev->self_scm ());
161 Dispatcher::add_listener (Listener l, SCM ev_class)
163 internal_add_listener (l, ev_class, ++priority_count_);
167 Dispatcher::internal_add_listener (Listener l, SCM ev_class, int priority)
169 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
172 /* Register with all dispatchers. */
173 for (SCM disp = dispatchers_; scm_is_pair(disp); disp = scm_cdr (disp))
175 int priority = scm_to_int (scm_cdar (disp));
176 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
177 d->internal_add_listener (GET_LISTENER (dispatch), ev_class, priority);
179 listen_classes_ = scm_cons (ev_class, listen_classes_);
181 SCM entry = scm_cons (scm_int2num (priority), l.smobbed_copy ());
182 list = scm_merge_x (list, scm_list_1 (entry), ly_lily_module_constant ("car<"));
183 scm_hashq_set_x (listeners_, ev_class, list);
187 Dispatcher::remove_listener (Listener l, SCM ev_class)
189 SCM list = scm_hashq_ref (listeners_, ev_class, SCM_EOL);
193 programming_error ("remove_listener called with incorrect class.");
197 // We just remove the listener once.
200 SCM dummy = scm_cons (SCM_EOL, list);
202 while (scm_is_pair(scm_cdr (e)))
203 if (*unsmob_listener (scm_cdadr (e)) == l && first)
205 scm_set_cdr_x (e, scm_cddr(e));
211 list = scm_cdr (dummy);
214 warning ("Attempting to remove nonexisting listener.");
215 else if (list == SCM_EOL)
217 /* Unregister with all dispatchers. */
218 for (SCM disp = dispatchers_; disp != SCM_EOL; disp = scm_cdr (disp))
220 Dispatcher *d = unsmob_dispatcher (scm_caar (disp));
221 d->remove_listener (GET_LISTENER (dispatch), ev_class);
223 listen_classes_ = scm_delq_x (ev_class, listen_classes_);
227 /* Register as a listener to another dispatcher. */
229 Dispatcher::register_as_listener (Dispatcher *disp)
231 int priority = ++disp->priority_count_;
233 // Don't register twice to the same dispatcher.
234 if (scm_assq (disp->self_scm (), dispatchers_) != SCM_BOOL_F)
236 warning ("Already listening to dispatcher, ignoring request");
240 dispatchers_ = scm_acons (disp->self_scm (), scm_int2num (priority), dispatchers_);
242 Listener list = GET_LISTENER (dispatch);
243 for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
245 disp->internal_add_listener (list, scm_car (cl), priority);
249 /* Unregister as a listener to another dispatcher. */
251 Dispatcher::unregister_as_listener (Dispatcher *disp)
253 dispatchers_ = scm_assq_remove_x (dispatchers_, disp->self_scm ());
255 Listener list = GET_LISTENER (dispatch);
256 for (SCM cl = listen_classes_; cl != SCM_EOL; cl = scm_cdr (cl))
258 disp->remove_listener (list, scm_car (cl));