]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/translator-group.cc
2003 -> 2004
[lilypond.git] / lily / translator-group.cc
index aa2541ebe453f6d48df3ea5b410b61ee87165109..ced34587173fcd15fcd8f55ba07dd40d121ae4dc 100644 (file)
@@ -3,26 +3,27 @@
 
   source file of the GNU LilyPond music typesetter
 
-  (c)  1997--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  (c) 1997--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 */
 
 #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 "killing-cons.tcc"
-#include "translator-def.hh"
+#include "context-def.hh"
+#include "main.hh"
+#include "music.hh"
 
 Translator_group::Translator_group (Translator_group const&s)
-  : Translator(s)
+  : Translator (s)
 {
   iterator_count_ =0;
   
   Scheme_hash_table * tab =  new Scheme_hash_table (*s.properties_dict ());
   properties_scm_ = tab->self_scm ();
-  scm_unprotect_object (tab->self_scm( ));
+  scm_gc_unprotect_object (tab->self_scm ());
 }
 
 Scheme_hash_table*
@@ -34,89 +35,108 @@ Translator_group::properties_dict () const
 Translator_group::~Translator_group ()
 {
   
-  //assert (removable_b());
+  //assert (is_removable ());
 }
 
 
-Translator_group::Translator_group()
+Translator_group::Translator_group ()
 {
   iterator_count_  = 0;
   Scheme_hash_table *tab = new Scheme_hash_table ;
   properties_scm_ = tab->self_scm ();
 
-  scm_unprotect_object (tab->self_scm ());
+  scm_gc_unprotect_object (tab->self_scm ());
 }
 
 void
-Translator_group::check_removal()
+Translator_group::check_removal ()
 {
   SCM next = SCM_EOL; 
   for (SCM p = trans_group_list_; gh_pair_p (p); p = next)
     {
-      next = gh_cdr (p);
+      next = ly_cdr (p);
 
-      Translator_group *trg =  dynamic_cast<Translator_group*> (unsmob_translator (gh_car (p)));
+      Translator_group *trg =  dynamic_cast<Translator_group*> (unsmob_translator (ly_car (p)));
 
       trg->check_removal ();
-      if (trg->removable_b())
+      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_l_ = this;
-  t->output_def_l_ = output_def_l_;
-  t->add_processing ();
+  t->daddy_trans_ = this;
+  t->output_def_ = output_def_;
 
   return list;
 }
+
+
 void
-Translator_group::add_group_translator (Translator *t)
+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::removable_b() const
+Translator_group::is_removable () const
 {
   return trans_group_list_ == SCM_EOL && ! iterator_count_;
 }
 
 Translator_group *
-Translator_group::find_existing_translator_l (String n, String id)
+Translator_group::find_existing_translator (SCM n, String id)
 {
-  if (is_alias_b (n) && (id_str_ == id || id.empty_b ()))
+  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 = gh_cdr (p))
+  for (SCM p = trans_group_list_; !r && gh_pair_p (p); p = ly_cdr (p))
     {
-      Translator *  t = unsmob_translator (gh_car (p));
+      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;
 }
 
 
-
-
 Translator_group*
-Translator_group::find_create_translator_l (String n, String id)
+Translator_group::find_create_translator (SCM n, String id, SCM operations)
 {
-  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 ());
+
+  /*
+    TODO: use accepts_list_.
+   */
+  Link_array<Context_def> path
+    = unsmob_context_def (definition_)->path_to_acceptable_translator (n, get_output_def ());
 
   if (path.size ())
     {
@@ -125,72 +145,62 @@ 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_);
+         SCM ops = (i == path.size () -1) ? operations : SCM_EOL;
+
+         Translator_group * new_group
+           = path[i]->instantiate (output_def_, ops);
 
-         current->add_group_translator (new_group);
+         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;
        }
-      current->id_str_ = id;
+
       return current;
     }
 
   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, operations);
   else
     {
-      warning (_f ("can't find or create `%s' called `%s'", n, id));
+      warning (_f ("Cannot find or create `%s' called `%s'",
+                  ly_symbol2string (n).to_str0 (), id));
       ret =0;
     }
   return ret;
 }
 
 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))
-    {
-      hebbes_b = unsmob_translator (gh_car (p))->try_music (m);
-    }
-  return hebbes_b;
-}
-
-bool
-Translator_group::do_try_music (Music* m)
+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
-{
-  return (daddy_trans_l_) ? daddy_trans_l_->depth_i()  + 1 : 0;
-}
-
-Translator_group*
-Translator_group::ancestor_l (int level)
+Translator_group::get_depth () const
 {
-  if (!level || !daddy_trans_l_)
-    return this;
-
-  return daddy_trans_l_->ancestor_l (level-1);
+  return (daddy_trans_) ? daddy_trans_->get_depth ()  + 1 : 0;
 }
 
 void
-Translator_group::terminate_translator (Translator*r_l)
+Translator_group::terminate_translator (Translator*r)
 {
-  r_l->removal_processing();
+  r->finalize ();
   /*
     Return value ignored. GC does the rest.
    */
-  remove_translator_p (r_l);
+  remove_translator (r);
 }
 
 
@@ -198,40 +208,53 @@ 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
-Translator_group::is_bottom_translator_b () const
+
+/*
+  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_string_p (unsmob_translator_def (definition_)->default_child_context_name ());
+  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()
+Translator_group::get_default_interpreter ()
 {
-  if (!is_bottom_translator_b ())
+  if (!is_bottom_context ())
     {
-      SCM nm = unsmob_translator_def (definition_)->default_child_context_name ();
-      SCM st = output_def_l ()->find_translator_l (nm);
+      SCM nm = default_child_context_name (this);
+      SCM st = get_output_def ()->find_translator (nm);
 
-      Translator_def *t = unsmob_translator_def (st);
+      Context_def *t = unsmob_context_def (st);
       if (!t)
        {
-         warning (_f ("can't find or create: `%s'", ly_scm2string (nm).ch_C()));
-         t = unsmob_translator_def (this->definition_);
+         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_l_);
-      add_group_translator (tg);
+      Translator_group *tg = t->instantiate (output_def_, SCM_EOL);
+      add_fresh_group_translator (tg);
 
-      if (!tg->is_bottom_translator_b ())
+      if (!tg->is_bottom_context ())
        return tg->get_default_interpreter ();
       else
        return tg;
@@ -242,134 +265,91 @@ Translator_group::get_default_interpreter()
 static void
 static_each (SCM list, Method_pointer method)
 {
-  for (SCM p = list; gh_pair_p (p); p = gh_cdr(p))
-    (unsmob_translator (gh_car (p))->*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 (simple_trans_list_, method);
+  static_each (get_simple_trans_list (), method);
   static_each (trans_group_list_, 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
  */
 Translator_group*
 Translator_group::where_defined (SCM sym) const
 {
-  if (properties_dict ()->elem_b (sym))
+  if (properties_dict ()->contains (sym))
     {
       return (Translator_group*)this;
     }
 
-  return (daddy_trans_l_) ? daddy_trans_l_->where_defined (sym) : 0;
+  return (daddy_trans_) ? daddy_trans_->where_defined (sym) : 0;
 }
 
 /*
   return SCM_EOL when not found.
 */
 SCM
-Translator_group::get_property (SCM sym) const
+Translator_group::internal_get_property (SCM sym) const
 {
   SCM val =SCM_EOL;
   if (properties_dict ()->try_retrieve (sym, &val))
     return val;
 
-  if (daddy_trans_l_)
-    return daddy_trans_l_->get_property (sym);
+  if (daddy_trans_)
+    return daddy_trans_->internal_get_property (sym);
   
   return val;
 }
 
 void
-Translator_group::set_property (String id, SCM val)
+Translator_group::internal_set_property (SCM sym, SCM val)
 {
-  set_property (ly_symbol2scm (id.ch_C()), 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::set_property (SCM sym, SCM val)
+Translator_group::unset_property (SCM sym)
 {
-  properties_dict ()->set (sym, val);
+  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_single_pushpop_property (SCM prop, SCM eltprop, SCM val)
+Translator_group::execute_pushpop_property (SCM prop, SCM eltprop, SCM val)
 {
-  if (gh_symbol_p(prop))
+  if (gh_symbol_p (prop))
     {
       if (val != SCM_UNDEFINED)
        {
-         SCM prev = get_property (prop);
+         SCM prev = internal_get_property (prop);
 
          if (gh_pair_p (prev) || prev == SCM_EOL)
            {
-             bool ok = true;
+             bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?"));
              
-             SCM errport = scm_current_error_port ();
-             
-             SCM meta = scm_assoc (ly_symbol2scm ("meta"), prev);
-
-             /*
-               We're probably in a performer.
-              */
-             if (!gh_pair_p (meta))
-               return;
-             
-             SCM props = scm_assoc (ly_symbol2scm ("properties"), gh_cdr (meta));
-             SCM type_p = scm_assoc (eltprop, gh_cdr (props));
-             if (!gh_pair_p (type_p))
-               {
-                 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
-               {
-                 type_p = gh_cdr (type_p);
-                 if (val != SCM_EOL
-                     && gh_call1 (type_p, 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_write (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, type_p), errport);
-                     scm_puts ("\n", errport);               
-                   }
-               }
-
              if (ok)
                {
                  prev = gh_cons (gh_cons (eltprop, val), prev);
-                 set_property (prop, prev);
+                 internal_set_property (prop, prev);
                }
            }
          else
@@ -380,19 +360,23 @@ Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM va
        }
       else
        {
-         SCM prev = get_property (prop);
+         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) && gh_caar (prev) != eltprop)
+         while (gh_pair_p (prev) && !SCM_EQ_P(ly_caar (prev), eltprop))
            {
-             newprops = gh_cons (gh_car (prev), newprops);
-             prev = gh_cdr (prev);
+             newprops = gh_cons (ly_car (prev), newprops);
+             prev = ly_cdr (prev);
            }
          
          if (gh_pair_p (prev))
            {
-             newprops = scm_reverse_x (newprops, gh_cdr (prev));
-             set_property (prop, newprops);
+             newprops = scm_reverse_x (newprops, ly_cdr (prev));
+             internal_set_property (prop, newprops);
            }
        }
     }
@@ -400,44 +384,196 @@ 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);
+  each (&Translator::stop_translation_timestep);
 }
 
 void
-Translator_group::do_post_move_processing ()
+Translator_group::start_translation_timestep ()
 {
-  each (&Translator::post_move_processing);
+  each (&Translator::start_translation_timestep);
 }
 
 void
-Translator_group::deprecated_process_music ()
+Translator_group::do_announces ()
 {
-  assert (0);
-  each (&Translator::process_music);
+  each (&Translator::do_announces);
 }
 
 void
-Translator_group::do_announces ()
+Translator_group::initialize ()
 {
-  each (&Translator::announces);
+  SCM tab = scm_make_vector (gh_int2scm (19), SCM_BOOL_F);
+  set_property ("acceptHashTable", tab);
+  each (&Translator::initialize);
 }
 
 void
-Translator_group::do_creation_processing ()
+Translator_group::finalize ()
+{
+  each (&Translator::finalize);
+}
+
+bool
+translator_accepts_any_of (Translator*tr, SCM ifaces)
 {
-  each (&Translator::creation_processing);
+  SCM ack_ifs = scm_assoc (ly_symbol2scm ("events-accepted"),
+                          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)
+      return true;
+  return false;
 }
 
+SCM
+find_accept_translators (SCM gravlist, SCM ifaces)
+{
+  SCM l = SCM_EOL;
+  for (SCM s = gravlist; ly_pair_p (s);  s = ly_cdr (s))
+    {
+      Translator* tr = unsmob_translator (ly_car (s));
+      if (translator_accepts_any_of (tr, ifaces))
+       l = scm_cons (tr->self_scm (), l); 
+    }
+  l = scm_reverse_x (l, SCM_EOL);
+
+  return l;
+}
+
+bool
+Translator_group::try_music_on_nongroup_children (Music *m )
+{
+  SCM tab = get_property ("acceptHashTable");
+  SCM name = scm_sloppy_assq (ly_symbol2scm ("name"),
+                             m->get_property_alist (false));
+
+  if (!gh_pair_p (name))
+    return false;
+
+  name = gh_cdr (name);
+  SCM accept_list = scm_hashq_ref (tab, name, SCM_UNDEFINED);
+  if (accept_list == SCM_BOOL_F)
+    {
+      accept_list = find_accept_translators (get_simple_trans_list (),
+                                            m->get_mus_property ("types"));
+      scm_hashq_set_x (tab, name, accept_list);
+    }
+
+  for (SCM p = accept_list; gh_pair_p (p); p = ly_cdr (p))
+    {
+      Translator * t = unsmob_translator (ly_car (p));
+      if (t && t->try_music (m))
+       return true;
+    }
+  return false;
+}
+
+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
-Translator_group::do_removal_processing ()
+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)
 {
-  each (&Translator::removal_processing);
+  SCM l = SCM_EOL;
+  for (SCM s = namelist; gh_pair_p (s) ; s = ly_cdr (s))
+    {
+      Translator * t = get_translator (ly_car (s));
+      if (!t)
+       warning (_f ("can't find: `%s'", s));
+      else
+       {
+         Translator * tr = t->clone ();
+         SCM str = tr->self_scm ();
+         l = gh_cons (str, l);
+
+         tr->daddy_trans_ = tg;
+         tr->output_def_  = tg->output_def_;
+
+         scm_gc_unprotect_object (str);
+       }
+    }
+  return l;
+}
+
+
+SCM
+Translator_group::get_simple_trans_list ()
+{
+  return simple_trans_list_;
+
+}
+
+
+  
+#if 0
+SCM
+Translator_group::get_simple_trans_list ()
+{
+  if (simple_trans_list_ != SCM_BOOL_F)
+    return simple_trans_list_;
+  
+  Context_def * td = unsmob_context_def (definition_);
+
+  /*
+    The following cannot work, since start_translation_timestep ()
+    triggers this code, and start_translation_timestep happens before
+    \property Voice.Voice =#'()
+    
+   */
+      trans_names = td->get_translator_names (SCM_EOL); 
+  
+  SCM trans_names = internal_get_property (td->get_context_name ());
+  if (!gh_pair_p (trans_names))
+    {
+    }
+
+  simple_trans_list_ = names_to_translators (trans_names, this);
+
+  
+  static_each (simple_trans_list_, &Translator::initialize);
+  return simple_trans_list_;
 }
+#endif