+
+
+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 ("Type check for `%s' failed; 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<Translator_group*> (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<Translator_group*> (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-set-trans-property", 3, 0, 0, (Scheme_function_unknown)ly_set_trans_property);
+}
+
+ADD_SCM_INIT_FUNC (trans_scm, add_trans_scm_funcs);