2 translator-def.cc -- implement Translator_def
4 source file of the GNU LilyPond music typesetter
6 (c) 2000--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "lily-proto.hh"
11 #include "translator-def.hh"
12 #include "translator-group.hh"
14 #include "music-output-def.hh"
16 #include "ly-smobs.icc"
19 Translator_def::print_smob (SCM smob, SCM port, scm_print_state*)
21 Translator_def* me = (Translator_def*) SCM_CELL_WORD_1 (smob);
23 scm_puts ("#<Translator_def ", port);
24 scm_display (me->type_name_, port);
31 Translator_def::mark_smob (SCM smob)
33 Translator_def* me = (Translator_def*) SCM_CELL_WORD_1 (smob);
35 scm_gc_mark (me->type_aliases_);
36 scm_gc_mark (me->consists_name_list_);
37 scm_gc_mark (me->accepts_name_list_);
38 scm_gc_mark (me->end_consists_name_list_);
39 scm_gc_mark (me->property_ops_);
40 scm_gc_mark (me->translator_group_type_);
41 return me->type_name_;
50 push_sym = scm_permanent_object (ly_symbol2scm ("push"));
51 assign_sym = scm_permanent_object (ly_symbol2scm ("assign"));
54 ADD_SCM_INIT_FUNC (transdef, foo_init);
56 Translator_def::Translator_def ()
58 type_aliases_ = SCM_EOL;
59 translator_group_type_ = SCM_EOL;
60 accepts_name_list_ = SCM_EOL;
61 consists_name_list_ = SCM_EOL;
62 end_consists_name_list_ = SCM_EOL;
63 property_ops_ = SCM_EOL;
66 Translator_def::~Translator_def ()
70 Translator_def::Translator_def (Translator_def const & s)
73 consists_name_list_ = scm_list_copy (s.consists_name_list_);
74 end_consists_name_list_ = scm_list_copy (s.end_consists_name_list_);
75 accepts_name_list_ = scm_list_copy (s.accepts_name_list_);
76 property_ops_ = scm_list_copy (s.property_ops_);
77 type_aliases_ = s.type_aliases_;
78 translator_group_type_ = s.translator_group_type_;
79 type_name_ = s.type_name_;
85 Translator_def::set_acceptor (SCM name, bool add)
88 this->accepts_name_list_ = gh_cons (name, this->accepts_name_list_);
90 this->accepts_name_list_ = scm_delete_x (name, this->accepts_name_list_);
95 Translator_def::modify_definition (SCM list, SCM str, bool add)
97 String s = ly_scm2string (str);
98 if (!get_translator_l (s))
99 error (_ ("Program has no such type"));
103 if (scm_memq (str, list) != SCM_BOOL_F)
105 warning (_f ("Already contains: `%s'", s));
106 warning (_f ("Not adding translator: `%s'", s));
109 list= gh_cons (str, list);
113 list = scm_delete_x (str, list);
121 Translator_def::remove_element (SCM s)
123 this->end_consists_name_list_ = modify_definition (this->end_consists_name_list_, s, false);
124 this->consists_name_list_ = modify_definition (this->consists_name_list_, s, false);
128 Translator_def::add_element (SCM s)
130 this->consists_name_list_ = modify_definition (this->consists_name_list_, s, true);
134 Translator_def::add_last_element (SCM s)
136 this->end_consists_name_list_ = modify_definition (this->end_consists_name_list_, s, true);
139 Translator_def::add_push_property (SCM props, SCM syms, SCM vals)
141 this->property_ops_ = gh_cons (gh_list (push_sym, props, syms, vals, SCM_UNDEFINED),
142 this->property_ops_);
146 Translator_def::add_pop_property (SCM props, SCM syms)
148 this->property_ops_ = gh_cons (gh_list (push_sym, props, syms, SCM_UNDEFINED),
149 this->property_ops_);
153 Do it. SYMS maybe a symbol or a list of symbols. VAL is
154 SCM_UNDEFINED in case of a pop
157 Translator_def::apply_pushpop_property (Translator_group* me,SCM syms, SCM eprop, SCM val)
159 if (gh_symbol_p (syms))
160 dynamic_cast<Translator_group*> (me)->execute_single_pushpop_property (syms, eprop, val);
161 else for (SCM s = syms; gh_pair_p (s); s = gh_cdr (s))
162 dynamic_cast<Translator_group*> (me)->execute_single_pushpop_property (gh_car (s), eprop, val);
167 Link_array<Translator_def>
168 Translator_def::path_to_acceptable_translator (SCM type_str, Music_output_def* odef) const
170 assert (gh_string_p (type_str));
172 Link_array<Translator_def> accepted_arr;
173 for (SCM s = accepts_name_list_; gh_pair_p (s); s = gh_cdr (s))
175 Translator_def *t = unsmob_translator_def (odef->find_translator_l (gh_car (s)));
178 accepted_arr.push (t);
181 Link_array<Translator_def> best_result;
182 for (int i=0; i < accepted_arr.size (); i++)
185 if (scm_equal_p (accepted_arr[i]->type_name_, type_str) == SCM_BOOL_T)
188 for (SCM s = accepted_arr[i]->type_aliases_; !found && gh_pair_p (s); s = gh_cdr (s))
189 found = found || (gh_equal_p (gh_car (s), type_str));
193 best_result.push (accepted_arr[i]);
198 int best_depth= INT_MAX;
199 for (int i=0; i < accepted_arr.size (); i++)
201 Translator_def * g = accepted_arr[i];
203 Link_array<Translator_def> result
204 = g->path_to_acceptable_translator (type_str, odef);
205 if (result.size () && result.size () < best_depth)
208 best_result = result;
214 IMPLEMENT_UNSMOB (Translator_def,translator_def);
215 IMPLEMENT_SMOBS (Translator_def);
216 IMPLEMENT_DEFAULT_EQUAL_P (Translator_def);
220 trans_list (SCM namelist, Translator_group*tg)
223 for (SCM s = namelist; gh_pair_p (s) ; s = gh_cdr (s))
225 Translator * t = get_translator_l (ly_scm2string (gh_car (s)));
227 warning (_f ("can't find: `%s'", s));
230 Translator * tr = t->clone ();
231 SCM str = tr->self_scm ();
232 l = gh_cons (str, l);
234 tr->daddy_trans_l_ = tg;
235 tr->output_def_l_ = tg->output_def_l_;
237 scm_unprotect_object (str);
245 Translator_def::instantiate (Music_output_def* md)
247 Translator * g = get_translator_l (ly_scm2string (translator_group_type_));
250 Translator_group *tg = dynamic_cast<Translator_group*> (g);
251 tg->output_def_l_ = md;
252 tg->definition_ = self_scm ();
253 tg->type_str_ = ly_scm2string (type_name_);
254 SCM l1 = trans_list (consists_name_list_, tg);
255 SCM l2 =trans_list (end_consists_name_list_,tg);
256 l1 = scm_reverse_x (l1, l2);
258 tg->simple_trans_list_ = l1;
265 Translator_def::apply_property_operations (Translator_group*tg)
267 SCM correct_order = scm_reverse (property_ops_); // pity of the mem.
268 for (SCM s = correct_order; gh_pair_p (s); s = gh_cdr (s))
270 SCM entry = gh_car (s);
271 SCM type = gh_car (entry);
272 entry = gh_cdr (entry);
274 if (type == push_sym)
276 SCM val = gh_cddr (entry);
277 val = gh_pair_p (val) ? gh_car (val) : SCM_UNDEFINED;
279 apply_pushpop_property (tg, gh_car (entry), gh_cadr (entry), val);
281 else if (type == assign_sym)
283 tg->set_property (gh_car (entry), gh_cadr (entry));
289 Translator_def::clone_scm () const
291 Translator_def * t = new Translator_def (*this);
292 return t->unprotected_smobify_self ();
296 Translator_def::make_scm ()
298 Translator_def* t = new Translator_def;
299 return t->unprotected_smobify_self ();
303 Translator_def::add_property_assign (SCM nm, SCM val)
305 this->property_ops_ = gh_cons (gh_list (assign_sym, scm_string_to_symbol (nm), val, SCM_UNDEFINED),
306 this->property_ops_);
310 Default child context as a SCM string, or something else if there is
314 Translator_def::default_child_context_name ()
316 SCM d = accepts_name_list_;
317 return gh_pair_p (d) ? gh_car (scm_last_pair (d)) : SCM_EOL;
321 Translator_def::to_alist ()const
325 l = gh_cons (gh_cons (ly_symbol2scm ("consists"), consists_name_list_), l);
326 l = gh_cons (gh_cons (ly_symbol2scm ("end-consists"), end_consists_name_list_), l);
327 l = gh_cons (gh_cons (ly_symbol2scm ("accepts"), accepts_name_list_), l);
328 l = gh_cons (gh_cons (ly_symbol2scm ("property-ops"), property_ops_), l);
329 l = gh_cons (gh_cons (ly_symbol2scm ("type-name"), type_name_), l); // junkme.
330 l = gh_cons (gh_cons (ly_symbol2scm ("group-type"), translator_group_type_), l);