2 scheme-engraver.cc -- implement Scheme_engraver
4 source file of the GNU LilyPond music typesetter
6 Copyright (c) 2009--2015 Han-Wen Nienhuys <hanwen@lilypond.org>
8 LilyPond is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 LilyPond is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
22 #include "scheme-engraver.hh"
26 #include "translator.icc"
28 Scheme_engraver::Scheme_engraver ()
30 stop_translation_timestep_function_ = SCM_EOL;
31 start_translation_timestep_function_ = SCM_EOL;
32 process_music_function_ = SCM_EOL;
33 process_acknowledged_function_ = SCM_EOL;
34 initialize_function_ = SCM_EOL;
35 finalize_function_ = SCM_EOL;
37 interface_acknowledger_hash_ = SCM_EOL;
38 interface_end_acknowledger_hash_ = SCM_EOL;
40 must_be_last_ = false;
41 per_instance_listeners_ = SCM_EOL;
44 Scheme_engraver::~Scheme_engraver ()
48 // Extracts the value if callable, if not return #f.
50 callable (SCM symbol, SCM defn)
52 SCM val = ly_assoc_get (symbol, defn, SCM_BOOL_F);
53 return ly_is_procedure (val) ? val : SCM_BOOL_F;
57 Scheme_engraver::must_be_last () const
63 Scheme_engraver::init_from_scheme (SCM definition)
65 start_translation_timestep_function_ = callable (ly_symbol2scm ("start-translation-timestep"),
67 stop_translation_timestep_function_ = callable (ly_symbol2scm ("stop-translation-timestep"),
69 process_music_function_ = callable (ly_symbol2scm ("process-music"), definition);
70 process_acknowledged_function_ = callable (ly_symbol2scm ("process-acknowledged"),
72 initialize_function_ = callable (ly_symbol2scm ("initialize"), definition);
73 finalize_function_ = callable (ly_symbol2scm ("finalize"), definition);
75 SCM listeners = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL);
77 per_instance_listeners_ = SCM_EOL;
79 must_be_last_ = to_boolean (ly_assoc_get (ly_symbol2scm ("must-be-last"),
83 for (SCM p = listeners; scm_is_pair (p); p = scm_cdr (p))
85 SCM event_class = scm_caar (p);
86 SCM proc = scm_cdar (p);
88 if (!(ly_is_procedure (proc) && ly_is_symbol (event_class)))
91 // We should check the arity of the function?
93 // Record for later lookup.
94 per_instance_listeners_ = scm_acons (event_class, proc, per_instance_listeners_);
97 init_acknowledgers (ly_assoc_get (ly_symbol2scm ("acknowledgers"),
99 &interface_acknowledger_hash_);
101 init_acknowledgers (ly_assoc_get (ly_symbol2scm ("end-acknowledgers"),
102 definition, SCM_EOL),
103 &interface_end_acknowledger_hash_);
105 // TODO: hook up description, props read/written, grobs created
106 // etc. to provide automatic documentation.
110 Scheme_engraver::init_acknowledgers (SCM alist,
113 *hash = scm_c_make_hash_table (7);
114 for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
116 SCM iface = scm_caar (p);
117 SCM proc = scm_cdar (p);
119 if (!(ly_is_procedure (proc) && ly_is_symbol (iface)))
122 scm_hashq_set_x (*hash, iface, proc);
126 // This is the easy way to do it, at the cost of too many invocations
127 // of Scheme_engraver::acknowledge_grob. The clever dispatching of
128 // acknowledgers is hardwired to have 1 method per engraver per
129 // grob-type, which doesn't work for this case.
131 Scheme_engraver::acknowledge_grob (Grob_info info)
133 acknowledge_grob_by_hash (info, interface_acknowledger_hash_);
137 Scheme_engraver::acknowledge_end_grob (Grob_info info)
139 acknowledge_grob_by_hash (info, interface_end_acknowledger_hash_);
143 Scheme_engraver::acknowledge_grob_by_hash (Grob_info info,
144 SCM iface_function_hash)
146 SCM meta = info.grob ()->get_property ("meta");
147 SCM ifaces = scm_cdr (scm_assoc (ly_symbol2scm ("interfaces"), meta));
148 for (SCM s = ifaces; scm_is_pair (s); s = scm_cdr (s))
150 SCM func = scm_hashq_ref (iface_function_hash,
151 scm_car (s), SCM_BOOL_F);
153 if (ly_is_procedure (func))
154 scm_call_3 (func, self_scm (), info.grob ()->self_scm (),
155 info.origin_translator ()->self_scm ());
160 Scheme_engraver::get_listener_list () const
162 return per_instance_listeners_;
165 #define DISPATCH(what) \
167 Scheme_engraver::what () \
169 if (what ## _function_ != SCM_BOOL_F) \
170 scm_call_1 (what ## _function_, self_scm ()); \
173 DISPATCH (start_translation_timestep);
174 DISPATCH (stop_translation_timestep);
175 DISPATCH (initialize);
177 DISPATCH (process_music);
178 DISPATCH (process_acknowledged);
181 Scheme_engraver::derived_mark () const
183 scm_gc_mark (start_translation_timestep_function_);
184 scm_gc_mark (stop_translation_timestep_function_);
185 scm_gc_mark (initialize_function_);
186 scm_gc_mark (finalize_function_);
187 scm_gc_mark (process_music_function_);
188 scm_gc_mark (process_acknowledged_function_);
189 scm_gc_mark (per_instance_listeners_);
190 scm_gc_mark (interface_acknowledger_hash_);
191 scm_gc_mark (interface_end_acknowledger_hash_);
194 ADD_ACKNOWLEDGER (Scheme_engraver, grob);
195 ADD_END_ACKNOWLEDGER (Scheme_engraver, grob);
197 ADD_TRANSLATOR (Scheme_engraver,
199 "Implement engravers in Scheme. Interprets arguments to"
200 " @code{\\consists} as callbacks.",