2 translator-def.cc -- implement Translator_def
4 source file of the GNU LilyPond music typesetter
6 (c) 2000--2003 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"
15 #include "ly-smobs.icc"
18 Translator_def::print_smob (SCM smob
, SCM port
, scm_print_state
*)
20 Translator_def
* me
= (Translator_def
*) SCM_CELL_WORD_1 (smob
);
22 scm_puts ("#<Translator_def ", port
);
23 scm_display (me
->context_name_
, port
);
30 Translator_def::mark_smob (SCM smob
)
32 Translator_def
* me
= (Translator_def
*) SCM_CELL_WORD_1 (smob
);
34 scm_gc_mark (me
->description_
);
35 scm_gc_mark (me
->context_aliases_
);
36 scm_gc_mark (me
->accept_mods_
);
37 scm_gc_mark (me
->translator_mods_
);
38 scm_gc_mark (me
->property_ops_
);
39 scm_gc_mark (me
->translator_group_type_
);
40 return me
->context_name_
;
44 Translator_def::Translator_def ()
46 context_aliases_
= SCM_EOL
;
47 translator_group_type_
= SCM_EOL
;
48 accept_mods_
= SCM_EOL
;
49 translator_mods_
= SCM_EOL
;
50 property_ops_
= SCM_EOL
;
51 context_name_
= SCM_EOL
;
52 description_
= SCM_EOL
;
57 Translator_def::~Translator_def ()
61 Translator_def::Translator_def (Translator_def
const & s
)
64 context_aliases_
= SCM_EOL
;
65 translator_group_type_
= SCM_EOL
;
66 accept_mods_
= SCM_EOL
;
67 translator_mods_
= SCM_EOL
;
68 property_ops_
= SCM_EOL
;
69 context_name_
= SCM_EOL
;
70 description_
= SCM_EOL
;
73 description_
= s
.description_
;
75 accept_mods_
= s
.accept_mods_
;
76 property_ops_
= s
.property_ops_
;
77 translator_mods_
= s
.translator_mods_
;
78 context_aliases_
= s
.context_aliases_
;
79 translator_group_type_
= s
.translator_group_type_
;
80 context_name_
= s
.context_name_
;
85 Translator_def::add_context_mod (SCM mod
)
87 SCM tag
= gh_car (mod
);
88 if (ly_symbol2scm ("description") == tag
)
90 description_
= gh_cadr (mod
);
94 SCM sym
= gh_cadr (mod
);
95 if (gh_string_p (sym
))
96 sym
= scm_string_to_symbol (sym
);
98 if (ly_symbol2scm ("consists") == tag
99 || ly_symbol2scm ("consists-end") == tag
100 || ly_symbol2scm ("remove") == tag
)
102 if (!get_translator (sym
))
103 error (_f ("Program has no such type: `%s'", ly_symbol2string (sym
).to_str0 ()));
105 translator_mods_
= gh_cons (scm_list_2 (tag
, sym
), translator_mods_
);
107 else if (ly_symbol2scm ("accepts") == tag
108 || ly_symbol2scm ("denies") == tag
)
110 accept_mods_
= gh_cons (scm_list_2 (tag
, sym
), accept_mods_
);
112 else if (ly_symbol2scm ("poppush") == tag
113 || ly_symbol2scm ("pop") == tag
114 || ly_symbol2scm ("push") == tag
115 || ly_symbol2scm ("assign") == tag
116 || ly_symbol2scm ("unset") == tag
)
118 property_ops_
= gh_cons (mod
, property_ops_
);
120 else if (ly_symbol2scm ("alias") == tag
)
122 context_aliases_
= gh_cons (sym
, context_aliases_
);
124 else if (ly_symbol2scm ("translator-type") == tag
)
126 translator_group_type_
= sym
;
128 else if (ly_symbol2scm ("context-name") == tag
)
134 programming_error ("Unknown context mod tag.");
141 Translator_def::get_context_name () const
143 return context_name_
;
147 Translator_def::get_accepted () const
149 SCM correct_order
= scm_reverse (accept_mods_
);
151 for (SCM s
= correct_order
; gh_pair_p (s
); s
= gh_cdr (s
))
153 SCM tag
= gh_caar (s
);
154 SCM sym
= gh_cadar (s
);
155 if (tag
== ly_symbol2scm ("accepts"))
156 acc
= gh_cons (sym
, acc
);
157 else if (tag
== ly_symbol2scm ("denies"))
158 acc
= scm_delete_x (sym
, acc
);
164 Link_array
<Translator_def
>
165 Translator_def::path_to_acceptable_translator (SCM type_sym
, Music_output_def
* odef
) const
167 assert (gh_symbol_p (type_sym
));
169 SCM accepted
= get_accepted ();
171 Link_array
<Translator_def
> accepteds
;
172 for (SCM s
= accepted
; gh_pair_p (s
); s
= ly_cdr (s
))
174 Translator_def
*t
= unsmob_translator_def (odef
->find_translator (ly_car (s
)));
180 Link_array
<Translator_def
> best_result
;
181 for (int i
=0; i
< accepteds
.size (); i
++)
184 don't check aliases, because \context Staff should not create RhythmicStaff.
186 if (gh_equal_p (accepteds
[i
]->get_context_name (), type_sym
))
188 best_result
.push (accepteds
[i
]);
193 int best_depth
= INT_MAX
;
194 for (int i
=0; i
< accepteds
.size (); i
++)
196 Translator_def
* g
= accepteds
[i
];
198 Link_array
<Translator_def
> result
199 = g
->path_to_acceptable_translator (type_sym
, odef
);
200 if (result
.size () && result
.size () < best_depth
)
203 best_result
= result
;
206 this following line was added in 1.9.3, but hsould've been
207 there all along... Let's hope it doesn't cause nightmares.
209 best_depth
= result
.size();
216 IMPLEMENT_SMOBS (Translator_def
);
217 IMPLEMENT_DEFAULT_EQUAL_P (Translator_def
);
221 names_to_translators (SCM namelist
, Translator_group
*tg
)
224 for (SCM s
= namelist
; gh_pair_p (s
) ; s
= ly_cdr (s
))
226 Translator
* t
= get_translator (ly_car (s
));
228 warning (_f ("can't find: `%s'", s
));
231 Translator
* tr
= t
->clone ();
232 SCM str
= tr
->self_scm ();
233 l
= gh_cons (str
, l
);
235 tr
->daddy_trans_
= tg
;
236 tr
->output_def_
= tg
->output_def_
;
238 scm_gc_unprotect_object (str
);
246 Translator_def::get_translator_names (SCM user_mod
) const
251 SCM mods
= scm_reverse_x (scm_list_copy (translator_mods_
),
254 for (SCM s
= mods
; gh_pair_p (s
); s
= gh_cdr (s
))
256 SCM tag
= gh_caar (s
);
257 SCM arg
= gh_cadar (s
);
259 if (gh_string_p (arg
))
260 arg
= scm_string_to_symbol (arg
);
262 if (ly_symbol2scm ("consists") == tag
)
263 l1
= gh_cons (arg
, l1
);
264 else if (ly_symbol2scm ("consists-end") == tag
)
265 l2
= gh_cons (arg
, l2
);
266 else if (ly_symbol2scm ("remove") == tag
)
268 l1
= scm_delete_x (arg
, l1
);
269 l2
= scm_delete_x (arg
, l2
);
273 return scm_append_x (scm_list_2 (l1
, l2
));
278 Translator_def::instantiate (Music_output_def
* md
, SCM ops
)
280 Translator
* g
= get_translator (translator_group_type_
);
283 Translator_group
*tg
= dynamic_cast<Translator_group
*> (g
);
284 tg
->output_def_
= md
;
285 tg
->definition_
= self_scm ();
287 SCM trans_names
= get_translator_names (ops
);
288 tg
->simple_trans_list_
= names_to_translators (trans_names
, tg
);
294 Translator_def::clone_scm () const
296 Translator_def
* t
= new Translator_def (*this);
297 scm_gc_unprotect_object (t
->self_scm());
298 return t
->self_scm();
302 Translator_def::make_scm ()
304 Translator_def
* t
= new Translator_def
;
305 scm_gc_unprotect_object (t
->self_scm());
306 return t
->self_scm();
311 Default child context as a SCM string, or something else if there is
315 Translator_def::default_child_context_name ()
317 SCM d
= get_accepted ();
318 return gh_pair_p (d
) ? ly_car (scm_last_pair (d
)) : SCM_EOL
;
321 Translator_def::apply_default_property_operations (Translator_group
*tg
)
323 apply_property_operations (tg
, property_ops_
);
327 Translator_def::to_alist () const
331 l
= gh_cons (gh_cons (ly_symbol2scm ("consists"),
332 get_translator_names (SCM_EOL
)), l
);
333 l
= gh_cons (gh_cons (ly_symbol2scm ("description"), description_
), l
);
334 l
= gh_cons (gh_cons (ly_symbol2scm ("aliases"), context_aliases_
), l
);
335 l
= gh_cons (gh_cons (ly_symbol2scm ("accepts"), get_accepted ()), l
);
336 l
= gh_cons (gh_cons (ly_symbol2scm ("property-ops"), property_ops_
), l
);
337 l
= gh_cons (gh_cons (ly_symbol2scm ("context-name"), context_name_
), l
);
338 l
= gh_cons (gh_cons (ly_symbol2scm ("group-type"), translator_group_type_
), l
);
344 Translator_def::is_alias (SCM sym
) const
346 bool b
= sym
== context_name_
;
348 for (SCM a
= context_aliases_
; !b
&& gh_pair_p (a
); a
= ly_cdr (a
))
349 b
= b
|| sym
== ly_car (a
);