]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/translator-group.cc
2002-07-31 Rune Zedeler <rune@zedeler.dk>
[lilypond.git] / lily / translator-group.cc
index bd9d1d1002ecba3ed41960ae05773a19ec6390e3..629d75c6f88b08df3f6b6d9f497fb1b5f5453f98 100644 (file)
@@ -9,10 +9,11 @@
 #include "music-output-def.hh"
 #include "translator-group.hh"
 #include "translator.hh"
-#include "debug.hh"
+#include "warn.hh"
 #include "moment.hh"
 #include "scm-hash.hh"
 #include "translator-def.hh"
+#include "main.hh"
 
 Translator_group::Translator_group (Translator_group const&s)
   : Translator (s)
@@ -69,18 +70,12 @@ 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_l_ = this;
-  t->output_def_l_ = output_def_l_;
+  t->daddy_trans_ = this;
+  t->output_def_ = output_def_;
 
   return list;
 }
 
-void
-Translator_group::add_fresh_simple_translator (Translator*t)
-{
-  simple_trans_list_ = add_translator (simple_trans_list_, t);
-  t->initialize ();
-}
 
 void
 Translator_group::add_used_group_translator (Translator *t)
@@ -109,9 +104,9 @@ Translator_group::removable_b () const
 }
 
 Translator_group *
-Translator_group::find_existing_translator_l (String n, String id)
+Translator_group::find_existing_translator (String n, String id)
 {
-  if (is_alias_b (n) && (id_str_ == id || id.empty_b ()))
+  if ((is_alias_b (n) && (id_string_ == id || id.empty_b ())) || n == "Current")
     return this;
 
   Translator_group* r = 0;
@@ -119,7 +114,7 @@ Translator_group::find_existing_translator_l (String n, String id)
     {
       Translator *  t = unsmob_translator (ly_car (p));
       
-      r = dynamic_cast<Translator_group*> (t)->find_existing_translator_l (n, id);
+      r = dynamic_cast<Translator_group*> (t)->find_existing_translator (n, id);
     }
 
   return r;
@@ -129,14 +124,14 @@ Translator_group::find_existing_translator_l (String n, String id)
 
 
 Translator_group*
-Translator_group::find_create_translator_l (String n, String id)
+Translator_group::find_create_translator (String n, String id)
 {
-  Translator_group * existing = find_existing_translator_l (n,id);
+  Translator_group * existing = find_existing_translator (n,id);
   if (existing)
     return existing;
 
   Link_array<Translator_def> path
-    = unsmob_translator_def (definition_)->path_to_acceptable_translator (ly_str02scm ((char*)n.ch_C ()), output_def_l ());
+    = unsmob_translator_def (definition_)->path_to_acceptable_translator (ly_str02scm ((char*)n.to_str0 ()), get_output_def ());
 
   if (path.size ())
     {
@@ -145,10 +140,10 @@ Translator_group::find_create_translator_l (String n, String id)
       // start at 1.  The first one (index 0) will be us.
       for (int i=0; i < path.size (); i++)
        {
-         Translator_group * new_group = path[i]->instantiate (output_def_l_);
+         Translator_group * new_group = path[i]->instantiate (output_def_);
 
          if (i == path.size () -1)
-           new_group->id_str_ = id;      
+           new_group->id_string_ = id;   
          current->add_fresh_group_translator (new_group);
          current = new_group;
        }
@@ -157,8 +152,8 @@ Translator_group::find_create_translator_l (String n, String id)
     }
 
   Translator_group *ret = 0;
-  if (daddy_trans_l_)
-    ret = daddy_trans_l_->find_create_translator_l (n,id);
+  if (daddy_trans_)
+    ret = daddy_trans_->find_create_translator (n,id);
   else
     {
       warning (_f ("can't find or create `%s' called `%s'", n, id));
@@ -184,34 +179,34 @@ Translator_group::try_music (Music* m)
 {
   bool hebbes_b = try_music_on_nongroup_children (m);
   
-  if (!hebbes_b && daddy_trans_l_)
-    hebbes_b = daddy_trans_l_->try_music (m);
+  if (!hebbes_b && daddy_trans_)
+    hebbes_b = daddy_trans_->try_music (m);
   return hebbes_b ;
 }
 
 int
-Translator_group::depth_i () const
+Translator_group::get_depth () const
 {
-  return (daddy_trans_l_) ? daddy_trans_l_->depth_i ()  + 1 : 0;
+  return (daddy_trans_) ? daddy_trans_->get_depth ()  + 1 : 0;
 }
 
 Translator_group*
-Translator_group::ancestor_l (int level)
+Translator_group::get_ancestor (int level)
 {
-  if (!level || !daddy_trans_l_)
+  if (!level || !daddy_trans_)
     return this;
 
-  return daddy_trans_l_->ancestor_l (level-1);
+  return daddy_trans_->get_ancestor (level-1);
 }
 
 void
-Translator_group::terminate_translator (Translator*r_l)
+Translator_group::terminate_translator (Translator*r)
 {
-  r_l->removal_processing ();
+  r->removal_processing ();
   /*
     Return value ignored. GC does the rest.
    */
-  remove_translator_p (r_l);
+  remove_translator (r);
 }
 
 
@@ -219,13 +214,13 @@ Translator_group::terminate_translator (Translator*r_l)
    Remove a translator from the hierarchy.
  */
 Translator *
-Translator_group::remove_translator_p (Translator*trans_l)
+Translator_group::remove_translator (Translator*trans)
 {
-  assert (trans_l);
+  assert (trans);
 
-  trans_group_list_ = scm_delq_x (trans_l->self_scm (), trans_group_list_);
-  trans_l->daddy_trans_l_ = 0;
-  return trans_l;
+  trans_group_list_ = scm_delq_x (trans->self_scm (), trans_group_list_);
+  trans->daddy_trans_ = 0;
+  return trans;
 }
 
 bool
@@ -241,15 +236,15 @@ Translator_group::get_default_interpreter ()
   if (!is_bottom_translator_b ())
     {
       SCM nm = unsmob_translator_def (definition_)->default_child_context_name ();
-      SCM st = output_def_l ()->find_translator_l (nm);
+      SCM st = get_output_def ()->find_translator (nm);
 
       Translator_def *t = unsmob_translator_def (st);
       if (!t)
        {
-         warning (_f ("can't find or create: `%s'", ly_scm2string (nm).ch_C ()));
+         warning (_f ("can't find or create: `%s'", ly_scm2string (nm).to_str0 ()));
          t = unsmob_translator_def (this->definition_);
        }
-      Translator_group *tg = t->instantiate (output_def_l_);
+      Translator_group *tg = t->instantiate (output_def_);
       add_fresh_group_translator (tg);
 
       if (!tg->is_bottom_translator_b ())
@@ -287,7 +282,7 @@ Translator_group::where_defined (SCM sym) const
       return (Translator_group*)this;
     }
 
-  return (daddy_trans_l_) ? daddy_trans_l_->where_defined (sym) : 0;
+  return (daddy_trans_) ? daddy_trans_->where_defined (sym) : 0;
 }
 
 /*
@@ -300,16 +295,20 @@ Translator_group::internal_get_property (SCM sym) const
   if (properties_dict ()->try_retrieve (sym, &val))
     return val;
 
-  if (daddy_trans_l_)
-    return daddy_trans_l_->internal_get_property (sym);
+  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);
 }
 
@@ -338,7 +337,7 @@ Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM va
 
          if (gh_pair_p (prev) || prev == SCM_EOL)
            {
-             bool ok = type_check_assignment (val, eltprop, ly_symbol2scm ("backend-type?"));
+             bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?"));
              
              if (ok)
                {
@@ -394,7 +393,7 @@ Translator_group::start_translation_timestep ()
 void
 Translator_group::do_announces ()
 {
-  each (&Translator::announces);
+  each (&Translator::do_announces);
 }
 
 void
@@ -409,78 +408,31 @@ 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? Doing assignment anyway.",
-                    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_primitive_eval (ly_symbol2scm ("type-name"));
-         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)
+LY_DEFINE(ly_get_context_property,
+         "ly-get-context-property", 2, 0, 0,
+         (SCM context, SCM name),
+         "retrieve the value of @var{sym} from context @var{tr}")
 {
   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;
-    }
+  SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group");
+  SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
+
   return tr->internal_get_property (name);
   
 }
-SCM
-ly_set_trans_property (SCM context, SCM name, SCM val)
-{
 
+LY_DEFINE(ly_set_context_property,
+         "ly-set-context-property", 3, 0, 0,
+         (SCM context, SCM name, SCM val),
+         "set value of property @var{sym} in context @var{tr} to @var{val}.
+")
+{
   Translator *t = unsmob_translator (context);
   Translator_group* tr=   dynamic_cast<Translator_group*> (t);
-  if (tr)
-    {
-      tr->internal_set_property (name, val);
-    }
-  return SCM_UNSPECIFIED;
-}
-
-
 
+  SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
+  tr->internal_set_property (name, val);
 
-void
-add_trans_scm_funcs ()
-{
-  scm_c_define_gsubr ("ly-get-trans-property", 2, 0, 0, (Scheme_function_unknown)ly_get_trans_property);
-  scm_c_define_gsubr ("ly-set-trans-property", 3, 0, 0, (Scheme_function_unknown)ly_set_trans_property);
+  return SCM_UNSPECIFIED;
 }
-
-ADD_SCM_INIT_FUNC (trans_scm, add_trans_scm_funcs);