X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Ftranslator-group.cc;h=367e6d127790db4d285104e2eba88bccaff7cd08;hb=7367bac15e22b0b2ae9a1a0a7f849860f9d66f45;hp=6e455d8e5c78227559b3b2104c19abd4ac31d37f;hpb=d8ddee6490dd1bb4965980d3e952a390493bfffd;p=lilypond.git diff --git a/lily/translator-group.cc b/lily/translator-group.cc index 6e455d8e5c..367e6d1277 100644 --- a/lily/translator-group.cc +++ b/lily/translator-group.cc @@ -70,8 +70,12 @@ Translator_group::add_translator (SCM list, Translator *t) list = gh_append2 (list, gh_cons (t->self_scm (), SCM_EOL)); t->daddy_trans_l_ = this; t->output_def_l_ = output_def_l_; - t->add_processing (); - + if (Translator_group*tg = dynamic_cast (t)) + { + unsmob_translator_def (tg->definition_)->apply_property_operations (tg); + } + + t->initialize (); return list; } void @@ -149,7 +153,6 @@ bool Translator_group::try_music_on_nongroup_children (Music *m) { bool hebbes_b =false; - for (SCM p = simple_trans_list_; !hebbes_b && gh_pair_p (p); p = gh_cdr (p)) { @@ -159,7 +162,7 @@ Translator_group::try_music_on_nongroup_children (Music *m) } bool -Translator_group::do_try_music (Music* m) +Translator_group::try_music (Music* m) { bool hebbes_b = try_music_on_nongroup_children (m); @@ -207,24 +210,6 @@ Translator_group::remove_translator_p (Translator*trans_l) return trans_l; } -#if 0 -/* - should not use, instead: use properties to communicate between engravers. - */ -Translator* -Translator_group::get_simple_translator (String type) const -{ - for (SCM p = simple_trans_list_; gh_pair_p (p); p =gh_cdr (p)) - { - if (classname (unsmob_translator (gh_car (p))) == type) - return unsmob_translator (gh_car (p)); - } - if (daddy_trans_l_) - return daddy_trans_l_->get_simple_translator (type); - return 0; -} -#endif - bool Translator_group::is_bottom_translator_b () const { @@ -273,18 +258,6 @@ Translator_group::each (Method_pointer method) } - -void -Translator_group::do_add_processing () -{ - unsmob_translator_def (definition_)->apply_property_operations (this); - for (SCM s = simple_trans_list_; gh_pair_p (s) ; s = gh_cdr (s)) - { - Translator * t = unsmob_translator (gh_car (s)); - t->add_processing (); - } -} - /* PROPERTIES */ @@ -299,10 +272,13 @@ Translator_group::where_defined (SCM sym) const return (daddy_trans_l_) ? daddy_trans_l_->where_defined (sym) : 0; } +/* + return SCM_EOL when not found. +*/ SCM Translator_group::get_property (SCM sym) const { - SCM val =SCM_UNDEFINED; + SCM val =SCM_EOL; if (properties_dict ()->try_retrieve (sym, &val)) return val; @@ -337,48 +313,12 @@ Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM va { SCM prev = get_property (prop); - /* - we don't tack onto SCM_UNDEFINED, because it creates - errors down the line, if we do scm_assoc(). - */ if (gh_pair_p (prev) || prev == SCM_EOL) { - bool ok = true; + bool ok = type_check_assignment (val, eltprop, ly_symbol2scm ("backend-type?")); - SCM errport = scm_current_error_port (); - - SCM meta = scm_assoc (ly_symbol2scm ("meta"), prev); - SCM props = scm_assoc (ly_symbol2scm ("properties"), gh_cdr (meta)); - SCM propdesc = scm_assoc (eltprop, gh_cdr (props)); - if (!gh_pair_p (propdesc)) - { - scm_puts (_("Couldn't find property description for #'").ch_C(),errport); - scm_display (eltprop, errport); - - scm_puts (_(" in element description ").ch_C(),errport); - scm_display (prop, errport); - - scm_puts (_(". Perhaps you made a typing error?\n").ch_C(),errport); - } - else - { - - SCM predicate = gh_cadr (propdesc); - if (gh_call1 (predicate, val) == SCM_BOOL_F) - { - ok = false; - scm_puts (_("Failed typecheck for #'").ch_C (),errport); - scm_display (eltprop,errport); - scm_puts ( _(", value ").ch_C (), errport); - scm_display (val, errport); - scm_puts (_(" must be of type ").ch_C (), errport); - SCM typefunc = scm_eval2 (ly_symbol2scm ("type-name"), SCM_EOL); - - scm_display (gh_call1 (typefunc, predicate), errport); - scm_puts ("\n", errport); - } - } + if (ok) { prev = gh_cons (gh_cons (eltprop, val), prev); @@ -419,31 +359,107 @@ Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM va STUBS */ void -Translator_group::do_pre_move_processing () +Translator_group::stop_translation_timestep () { each (&Translator::pre_move_processing); } void -Translator_group::do_post_move_processing () +Translator_group::start_translation_timestep () { each (&Translator::post_move_processing); } void -Translator_group::do_process_music () +Translator_group::do_announces () { - each (&Translator::process_music); + each (&Translator::announces); } void -Translator_group::do_creation_processing () +Translator_group::initialize () { - each (&Translator::creation_processing); + each (&Translator::initialize); } void -Translator_group::do_removal_processing () +Translator_group::finalize () { each (&Translator::removal_processing); } + + +bool +type_check_assignment (SCM val, SCM sym, SCM type_symbol) +{ + bool ok = true; + SCM type_p = SCM_EOL; + + if (gh_symbol_p(sym)) + type_p = scm_object_property (sym, type_symbol); + + if (type_p != SCM_EOL && !gh_procedure_p (type_p)) + { + warning (_f ("Can't find property type-check for `%s'. Perhaps you made a typing error?", + ly_symbol2string (sym).ch_C ())); + } + else + { + if (val != SCM_EOL + && gh_procedure_p (type_p) + && gh_call1 (type_p, val) == SCM_BOOL_F) + { + SCM errport = scm_current_error_port (); + ok = false; + SCM typefunc = scm_eval2 (ly_symbol2scm ("type-name"), SCM_EOL); + SCM type_name = gh_call1 (typefunc, type_p); + + scm_puts (_f ("Failed typecheck for `%s', value `%s' must be of type `%s'", + ly_symbol2string (sym).ch_C (), + ly_scm2string (ly_write2scm( val)).ch_C (), + ly_scm2string (type_name).ch_C ()).ch_C (), + errport); + scm_puts ("\n", errport); + } + } + return ok; +} + +SCM +ly_get_trans_property (SCM context, SCM name) +{ + Translator *t = unsmob_translator (context); + Translator_group* tr= dynamic_cast (t); + if (!t || !tr) + { + /* programming_error? */ + warning (_ ("ly-get-trans-property: expecting a Translator_group argument")); + return SCM_EOL; + } + return tr->get_property (name); + +} +SCM +ly_set_trans_property (SCM context, SCM name, SCM val) +{ + + Translator *t = unsmob_translator (context); + Translator_group* tr= dynamic_cast (t); + if (tr) + { + tr->set_property (name, val); + } + return SCM_UNSPECIFIED; +} + + + + +void +add_trans_scm_funcs () +{ + scm_make_gsubr ("ly-get-trans-property", 2, 0, 0, (Scheme_function_unknown)ly_get_trans_property); + scm_make_gsubr ("ly-get-trans-property", 3, 0, 0, (Scheme_function_unknown)ly_get_trans_property); +} + +ADD_SCM_INIT_FUNC(trans_scm, add_trans_scm_funcs);