source file of the GNU LilyPond music typesetter
- (c) 1997--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+ (c) 1997--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
*/
#include "music-output-def.hh"
#include "moment.hh"
#include "scm-hash.hh"
#include "context-def.hh"
+#include "context.hh"
#include "main.hh"
#include "music.hh"
-Translator_group::Translator_group (Translator_group const&s)
- : Translator (s)
-{
- iterator_count_ =0;
-
- Scheme_hash_table * tab = new Scheme_hash_table (*s.properties_dict ());
- properties_scm_ = tab->self_scm ();
- scm_gc_unprotect_object (tab->self_scm ());
-}
-
-Scheme_hash_table*
-Translator_group::properties_dict () const
-{
- return Scheme_hash_table::unsmob (properties_scm_);
-}
-
-Translator_group::~Translator_group ()
-{
-
- //assert (is_removable ());
-}
-
-
-Translator_group::Translator_group ()
-{
- iterator_count_ = 0;
- Scheme_hash_table *tab = new Scheme_hash_table ;
- properties_scm_ = tab->self_scm ();
-
- scm_gc_unprotect_object (tab->self_scm ());
-}
-
-void
-Translator_group::check_removal ()
-{
- SCM next = SCM_EOL;
- for (SCM p = trans_group_list_; gh_pair_p (p); p = next)
- {
- next = ly_cdr (p);
-
- Translator_group *trg = dynamic_cast<Translator_group*> (unsmob_translator (ly_car (p)));
-
- trg->check_removal ();
- if (trg->is_removable ())
- terminate_translator (trg);
- }
-}
-
-SCM
-Translator_group::add_translator (SCM list, Translator *t)
-{
- /*
- Must append, since list ordering must be preserved.
- */
- list = gh_append2 (list, gh_cons (t->self_scm (), SCM_EOL));
- t->daddy_trans_ = this;
- t->output_def_ = output_def_;
-
- return list;
-}
-
-
-void
-Translator_group::add_used_group_translator (Translator *t)
-{
- trans_group_list_ = add_translator (trans_group_list_,t);
-}
-
-
-void
-Translator_group::add_fresh_group_translator (Translator*t)
-{
- Translator_group*tg = dynamic_cast<Translator_group*> (t);
- trans_group_list_ = add_translator (trans_group_list_,t);
- Context_def * td = unsmob_context_def (tg->definition_);
-
- /*
- this can not move before add_translator(), because \override
- operations require that we are in the hierarchy.
- */
- td->apply_default_property_operations (tg);
-
- t->initialize ();
-}
-
-bool
-Translator_group::is_removable () const
-{
- return trans_group_list_ == SCM_EOL && ! iterator_count_;
-}
-
-Translator_group *
-Translator_group::find_existing_translator (SCM n, String id)
-{
- if ((is_alias (n) && (id_string_ == id || id.is_empty ())) || n == ly_symbol2scm ("Current"))
- return this;
-
- Translator_group* r = 0;
- for (SCM p = trans_group_list_; !r && gh_pair_p (p); p = ly_cdr (p))
- {
- Translator * t = unsmob_translator (ly_car (p));
-
- r = dynamic_cast<Translator_group*> (t)->find_existing_translator (n, id); }
-
- return r;
-}
-
-
Translator_group*
-Translator_group::find_create_translator (SCM n, String id, SCM operations)
-{
- Translator_group * existing = find_existing_translator (n,id);
- if (existing)
- return existing;
-
-
- /*
- TODO: use accepts_list_.
- */
- Link_array<Context_def> path
- = unsmob_context_def (definition_)->path_to_acceptable_translator (n, get_output_def ());
-
- if (path.size ())
- {
- Translator_group * current = this;
-
- // start at 1. The first one (index 0) will be us.
- for (int i=0; i < path.size (); i++)
- {
- SCM ops = (i == path.size () -1) ? operations : SCM_EOL;
-
- Translator_group * new_group
- = path[i]->instantiate (output_def_, ops);
-
- if (i == path.size () -1)
- {
- new_group->id_string_ = id;
- }
-
- current->add_fresh_group_translator (new_group);
- apply_property_operations (new_group, ops);
-
- current = new_group;
- }
-
- return current;
- }
-
- Translator_group *ret = 0;
- if (daddy_trans_)
- ret = daddy_trans_->find_create_translator (n, id, operations);
- else
- {
- warning (_f ("can't find or create `%s' called `%s'", ly_symbol2string (n).to_str0 (), id));
- ret =0;
- }
- return ret;
-}
-
-bool
-Translator_group::try_music (Music* m)
+Translator_group::get_daddy_translator () const
{
- bool hebbes_b = try_music_on_nongroup_children (m);
-
- if (!hebbes_b && daddy_trans_)
- hebbes_b = daddy_trans_->try_music (m);
-
- return hebbes_b ;
+ Translator *t
+ = unsmob_translator (daddy_context_->daddy_context_->implementation_);
+ return dynamic_cast<Translator_group*> (t);
}
-int
-Translator_group::get_depth () const
-{
- return (daddy_trans_) ? daddy_trans_->get_depth () + 1 : 0;
-}
void
-Translator_group::terminate_translator (Translator*r)
-{
- r->finalize ();
- /*
- Return value ignored. GC does the rest.
- */
- remove_translator (r);
-}
-
-
-/**
- Remove a translator from the hierarchy.
- */
-Translator *
-Translator_group::remove_translator (Translator*trans)
-{
- assert (trans);
-
- trans_group_list_ = scm_delq_x (trans->self_scm (), trans_group_list_);
- trans->daddy_trans_ = 0;
- return trans;
-}
-
-
-/*
- Default child context as a SCM string, or something else if there is
- none.
-*/
-SCM
-default_child_context_name (Translator_group const *tg)
-{
- return gh_pair_p (tg->accepts_list_)
- ? ly_car (scm_last_pair (tg->accepts_list_))
- : SCM_EOL;
-}
-
-
-bool
-Translator_group::is_bottom_context () const
-{
- return !gh_symbol_p (default_child_context_name (this));
-}
-
-Translator_group*
-Translator_group::get_default_interpreter ()
-{
- if (!is_bottom_context ())
- {
- SCM nm = default_child_context_name (this);
- SCM st = get_output_def ()->find_translator (nm);
-
- Context_def *t = unsmob_context_def (st);
- if (!t)
- {
- warning (_f ("can't find or create: `%s'", ly_symbol2string (nm).to_str0 ()));
- t = unsmob_context_def (this->definition_);
- }
- Translator_group *tg = t->instantiate (output_def_, SCM_EOL);
- add_fresh_group_translator (tg);
-
- if (!tg->is_bottom_context ())
- return tg->get_default_interpreter ();
- else
- return tg;
- }
- return this;
-}
-
-static void
-static_each (SCM list, Method_pointer method)
+translator_each (SCM list, Translator_method method)
{
for (SCM p = list; gh_pair_p (p); p = ly_cdr (p))
(unsmob_translator (ly_car (p))->*method) ();
-
-}
-
-void
-Translator_group::each (Method_pointer method)
-{
- static_each (get_simple_trans_list (), method);
- static_each (trans_group_list_, method);
-}
-
-
-/*
- PROPERTIES
- */
-Translator_group*
-Translator_group::where_defined (SCM sym) const
-{
- if (properties_dict ()->contains (sym))
- {
- return (Translator_group*)this;
- }
-
- return (daddy_trans_) ? daddy_trans_->where_defined (sym) : 0;
-}
-
-/*
- return SCM_EOL when not found.
-*/
-SCM
-Translator_group::internal_get_property (SCM sym) const
-{
- SCM val =SCM_EOL;
- if (properties_dict ()->try_retrieve (sym, &val))
- return val;
-
- if (daddy_trans_)
- return daddy_trans_->internal_get_property (sym);
-
- return val;
-}
-
-void
-Translator_group::internal_set_property (SCM sym, SCM val)
-{
-#ifndef NDEBUG
- if (internal_type_checking_global_b)
- assert (type_check_assignment (sym, val, ly_symbol2scm ("translation-type?")));
-#endif
-
- properties_dict ()->set (sym, val);
-}
-
-/*
- TODO: look up to check whether we have inherited var?
- */
-void
-Translator_group::unset_property (SCM sym)
-{
- properties_dict ()->remove (sym);
-}
-
-
-/*
- Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL)
- entry from a translator property list by name of PROP
-*/
-void
-Translator_group::execute_pushpop_property (SCM prop, SCM eltprop, SCM val)
-{
- if (gh_symbol_p (prop))
- {
- if (val != SCM_UNDEFINED)
- {
- SCM prev = internal_get_property (prop);
-
- if (gh_pair_p (prev) || prev == SCM_EOL)
- {
- bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?"));
-
- if (ok)
- {
- prev = gh_cons (gh_cons (eltprop, val), prev);
- internal_set_property (prop, prev);
- }
- }
- else
- {
- // warning here.
- }
-
- }
- else
- {
- SCM prev = internal_get_property (prop);
-
- /*
- TODO: should have scm_equal_something () for reverting
- autobeam properties.
- */
- SCM newprops= SCM_EOL ;
- while (gh_pair_p (prev) && !SCM_EQ_P(ly_caar (prev), eltprop))
- {
- newprops = gh_cons (ly_car (prev), newprops);
- prev = ly_cdr (prev);
- }
-
- if (gh_pair_p (prev))
- {
- newprops = scm_reverse_x (newprops, ly_cdr (prev));
- internal_set_property (prop, newprops);
- }
- }
- }
}
-
-/*
- STUBS
-*/
-void
-Translator_group::stop_translation_timestep ()
-{
- each (&Translator::stop_translation_timestep);
-}
-
-void
-Translator_group::start_translation_timestep ()
-{
- each (&Translator::start_translation_timestep);
-}
-
-void
-Translator_group::do_announces ()
-{
- each (&Translator::do_announces);
-}
-
void
Translator_group::initialize ()
{
SCM tab = scm_make_vector (gh_int2scm (19), SCM_BOOL_F);
- set_property ("acceptHashTable", tab);
- each (&Translator::initialize);
+ daddy_context_->set_property ("acceptHashTable", tab);
}
-void
-Translator_group::finalize ()
-{
- each (&Translator::finalize);
-}
bool
translator_accepts_any_of (Translator*tr, SCM ifaces)
{
SCM ack_ifs = scm_assoc (ly_symbol2scm ("events-accepted"),
- tr->translator_description());
+ tr->translator_description ());
ack_ifs = gh_cdr (ack_ifs);
for (SCM s = ifaces; ly_pair_p (s); s = ly_cdr (s))
- if (scm_memq (ly_car (s), ack_ifs) != SCM_BOOL_F)
+ if (scm_c_memq (ly_car (s), ack_ifs) != SCM_BOOL_F)
return true;
return false;
}
}
bool
-Translator_group::try_music_on_nongroup_children (Music *m )
+Translator_group::try_music (Music* m)
{
SCM tab = get_property ("acceptHashTable");
SCM name = scm_sloppy_assq (ly_symbol2scm ("name"),
if (accept_list == SCM_BOOL_F)
{
accept_list = find_accept_translators (get_simple_trans_list (),
- m->get_mus_property ("types"));
+ m->get_property ("types"));
scm_hashq_set_x (tab, name, accept_list);
}
}
SCM
-Translator_group::properties_as_alist () const
-{
- return properties_dict()->to_alist();
-}
-
-String
-Translator_group::context_name () const
-{
- Context_def * td = unsmob_context_def (definition_ );
- return ly_symbol2string (td->get_context_name ());
-}
-
-/*
- PRE_INIT_OPS is in the order specified, and hence must be reversed.
- */
-void
-apply_property_operations (Translator_group*tg, SCM pre_init_ops)
-{
- SCM correct_order = scm_reverse (pre_init_ops);
- for (SCM s = correct_order; gh_pair_p (s); s = ly_cdr (s))
- {
- SCM entry = ly_car (s);
- SCM type = ly_car (entry);
- entry = ly_cdr (entry);
-
- if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush"))
- {
- SCM val = ly_cddr (entry);
- val = gh_pair_p (val) ? ly_car (val) : SCM_UNDEFINED;
-
- tg->execute_pushpop_property (ly_car (entry), ly_cadr (entry), val);
- }
- else if (type == ly_symbol2scm ("assign"))
- {
- tg->internal_set_property (ly_car (entry), ly_cadr (entry));
- }
- }
-}
-
-SCM
-names_to_translators (SCM namelist, Translator_group*tg)
+names_to_translators (SCM namelist, Context*tg)
{
SCM l = SCM_EOL;
for (SCM s = namelist; gh_pair_p (s) ; s = ly_cdr (s))
SCM str = tr->self_scm ();
l = gh_cons (str, l);
- tr->daddy_trans_ = tg;
- tr->output_def_ = tg->output_def_;
-
+ tr->daddy_context_ = tg;
scm_gc_unprotect_object (str);
}
}
Translator_group::get_simple_trans_list ()
{
return simple_trans_list_;
-
}
-
-
-#if 0
-SCM
-Translator_group::get_simple_trans_list ()
+void
+recurse_over_translators (Context * c, Translator_method ptr, Direction dir)
{
- if (simple_trans_list_ != SCM_BOOL_F)
- return simple_trans_list_;
-
- Context_def * td = unsmob_context_def (definition_);
+ Translator_group * tg
+ = dynamic_cast<Translator_group*> (unsmob_translator (c->implementation_));
+
/*
- The following cannot work, since start_translation_timestep ()
- triggers this code, and start_translation_timestep happens before
- \property Voice.Voice =#'()
-
+ Top down:
*/
- trans_names = td->get_translator_names (SCM_EOL);
-
- SCM trans_names = internal_get_property (td->get_context_name ());
- if (!gh_pair_p (trans_names))
+ if (dir == DOWN)
{
+ translator_each (tg->get_simple_trans_list (),
+ ptr);
+
+ (tg->*ptr) ();
}
- simple_trans_list_ = names_to_translators (trans_names, this);
+ for (SCM s = c->context_list_ ; gh_pair_p (s);
+ s =gh_cdr (s))
+ {
+ recurse_over_translators (unsmob_context (gh_car (s)), ptr, dir);
+ }
-
- static_each (simple_trans_list_, &Translator::initialize);
- return simple_trans_list_;
+ if (dir == UP)
+ {
+ translator_each (tg->get_simple_trans_list (),
+ ptr);
+
+ (tg->*ptr) ();
+ }
}
-#endif