X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fcontext.cc;h=5e97a6171de24c24830548e4c141ed763d587dac;hb=ffb9d71ab52ad8d9a891f8070525d949789e5058;hp=b97a5f1a62b0b3812e759d6d16bfa957ff88fad1;hpb=7a748b8d385139bf3c68d1370a119d277d92134b;p=lilypond.git

diff --git a/lily/context.cc b/lily/context.cc
index b97a5f1a62..5e97a6171d 100644
--- a/lily/context.cc
+++ b/lily/context.cc
@@ -1,152 +1,219 @@
-/*   
-  context.cc --  implement Context
+/*
+  context.cc -- implement Context
 
   source file of the GNU LilyPond music typesetter
 
-  (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
-
+  (c) 2004--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
 */
 
-#include "translator-group.hh"
-#include "context-def.hh"
 #include "context.hh"
-#include "warn.hh"
-#include "music-output-def.hh"
-#include "scm-hash.hh"
-#include "main.hh"
+
+#include "context-def.hh"
+#include "dispatcher.hh"
+#include "international.hh"
 #include "ly-smobs.icc"
+#include "main.hh"
+#include "output-def.hh"
+#include "profile.hh"
+#include "program-option.hh"
+#include "scm-hash.hh"
 #include "score-context.hh"
+#include "translator-group.hh"
+#include "warn.hh"
 
 bool
 Context::is_removable () const
 {
-  return context_list_ == SCM_EOL && ! iterator_count_ &&
-	  !dynamic_cast<Score_context const*> (this)
-    ;
+  return context_list_ == SCM_EOL && ! iterator_count_
+    && !dynamic_cast<Global_context const *> (daddy_context_);
 }
 
 void
 Context::check_removal ()
 {
-  for (SCM p = context_list_; ly_c_pair_p (p); p = ly_cdr (p))
+  for (SCM p = context_list_; scm_is_pair (p); p = scm_cdr (p))
     {
-      Context *trg =  unsmob_context (ly_car (p));
+      Context *trg = unsmob_context (scm_car (p));
 
       trg->check_removal ();
       if (trg->is_removable ())
 	{
-	  recurse_over_translators (trg, &Translator::finalize, UP);
+	  recurse_over_translators (trg, &Translator::finalize,
+				    &Translator_group::finalize,
+				    UP);
 	  remove_context (trg);
 	}
     }
 }
 
-Context::Context (Context const&)
+Context::Context (Context const &src)
+  : key_manager_ (src.key_manager_)
 {
   assert (false);
 }
 
-Scheme_hash_table*
+Scheme_hash_table *
 Context::properties_dict () const
 {
   return Scheme_hash_table::unsmob (properties_scm_);
 }
 
 void
-Context::add_context (Context*t)
+Context::add_context (Context *t)
 {
   SCM ts = t->self_scm ();
   context_list_ = ly_append2 (context_list_,
 			      scm_cons (ts, SCM_EOL));
-  
+
   t->daddy_context_ = this;
   if (!t->init_)
     {
       t->init_ = true;
-      
-      scm_gc_unprotect_object (ts);
-      Context_def * td = unsmob_context_def (t->definition_);
-
-      /*
-	this can not move before add_context (), because \override
-	operations require that we are in the hierarchy.
-      */
+
+      t->unprotect ();
+      Context_def *td = unsmob_context_def (t->definition_);
+
+      /* This cannot move before add_context (), because \override
+	 operations require that we are in the hierarchy.  */
       td->apply_default_property_operations (t);
 
-      recurse_over_translators (t, &Translator::initialize, DOWN);
+      recurse_over_translators (t,
+				&Translator::initialize,
+				&Translator_group::initialize,
+				DOWN);
     }
 }
 
-Context::Context ()
+
+Context::Context (Object_key const *key)
+  : key_manager_ (key)
 {
   daddy_context_ = 0;
   init_ = false;
   aliases_ = SCM_EOL;
-  iterator_count_  = 0;
-  implementation_ = SCM_EOL;
+  iterator_count_ = 0;
+  implementation_ = 0;
   properties_scm_ = SCM_EOL;
   accepts_list_ = SCM_EOL;
   context_list_ = SCM_EOL;
   definition_ = SCM_EOL;
-  
+  definition_mods_ = SCM_EOL;
+  unique_ = -1;
+  event_source_ = 0;
+  events_below_ = 0;
+
   smobify_self ();
 
-  properties_scm_ = (new Scheme_hash_table)->self_scm ();
-  scm_gc_unprotect_object (properties_scm_);
+  Scheme_hash_table *tab = new Scheme_hash_table;
+  properties_scm_ = tab->unprotect ();
+  event_source_ = new Dispatcher ();
+  event_source_->unprotect ();
+  events_below_ = new Dispatcher ();
+  events_below_->unprotect ();
+
+  /*
+    UGH UGH
+    const correctness.
+  */
+  key_manager_.unprotect();
 }
 
+/* TODO:  this shares code with find_create_context ().  */
+Context *
+Context::create_unique_context (SCM name, string id, SCM operations)
+{
+  /*
+    Don't create multiple score contexts.
+  */
+  Global_context *gthis = dynamic_cast<Global_context *> (this);
+  if (gthis && gthis->get_score_context ())
+    return gthis->get_score_context ()->create_unique_context (name, id, operations);
+
+  /*
+    TODO: use accepts_list_.
+  */
+  vector<Context_def*> path
+    = unsmob_context_def (definition_)->path_to_acceptable_context (name, get_output_def ());
+
+  if (path.size ())
+    {
+      Context *current = this;
+
+      // start at 1.  The first one (index 0) will be us.
+      for (vsize i = 0; i < path.size (); i++)
+	{
+	  SCM ops = SCM_EOL;
+	  string id_str = "\\new";
+	  if (i == path.size () - 1)
+	    {
+	      ops = operations;
+	      id_str = id;
+	    }
+	  current = current->create_context (path[i],
+					     id_str,
+					     ops);
+	}
+
+      return current;
+    }
 
+  /*
+    Don't go up to Global_context, because global goes down to
+    Score_context
+  */
+  Context *ret = 0;
+  if (daddy_context_ && !dynamic_cast<Global_context *> (daddy_context_))
+    ret = daddy_context_->create_unique_context (name, id, operations);
+  else
+    {
+      warning (_f ("can't find or create new `%s'",
+		   ly_symbol2string (name).c_str ()));
+      ret = 0;
+    }
+  return ret;
+}
 
-Context*
-Context::find_create_context (SCM n, String id,
-			      SCM operations)
+Context *
+Context::find_create_context (SCM n, string id, SCM operations)
 {
   /*
     Don't create multiple score contexts.
-   */
-  if (dynamic_cast<Global_context*> (this)
-      && dynamic_cast<Global_context*> (this)->get_score_context ())
-    return get_score_context ()->find_create_context (n, id, operations);
-    
-  
-  Context * existing = find_context_below (this, n,id);
-  if (existing)
+  */
+  Global_context *gthis = dynamic_cast<Global_context *> (this);
+  if (gthis && gthis->get_score_context ())
+    return gthis->get_score_context ()->find_create_context (n, id, operations);
+
+  if (Context *existing = find_context_below (this, n, id))
     return existing;
 
   if (n == ly_symbol2scm ("Bottom"))
     {
-      Context* tg = get_default_interpreter ();
-      tg->id_string_ = id;
+      Context *tg = get_default_interpreter ();
       return tg;
     }
 
   /*
     TODO: use accepts_list_.
-   */
-  Link_array<Context_def> path
+  */
+  vector<Context_def*> path
     = unsmob_context_def (definition_)->path_to_acceptable_context (n, get_output_def ());
 
   if (path.size ())
     {
-      Context * current = this;
+      Context *current = this;
 
       // start at 1.  The first one (index 0) will be us.
-      for (int i=0; i < path.size (); i++)
+      for (vsize i = 0; i < path.size (); i++)
 	{
 	  SCM ops = (i == path.size () -1) ? operations : SCM_EOL;
 
-	  Context * new_group
-	    = path[i]->instantiate (ops);
-
+	  string this_id = "";
 	  if (i == path.size () -1)
-	    {
-	      new_group->id_string_ = id;
-	    }
+	    this_id = id;
 
-	  current->add_context (new_group);
-	  apply_property_operations (new_group, ops);
-	  
-	  current = new_group;
+	  current = current->create_context (path[i],
+					     this_id,
+					     ops);
 	}
 
       return current;
@@ -155,19 +222,51 @@ Context::find_create_context (SCM n, String id,
   /*
     Don't go up to Global_context, because global goes down to
     Score_context
-   */
+  */
   Context *ret = 0;
-  if (daddy_context_ && !dynamic_cast<Global_context*> (daddy_context_))
+  if (daddy_context_ && !dynamic_cast<Global_context *> (daddy_context_))
     ret = daddy_context_->find_create_context (n, id, operations);
   else
     {
-      warning (_f ("Cannot find or create `%s' called `%s'",
-		   ly_symbol2string (n).to_str0 (), id));
-      ret =0;
+      warning (_f ("can't find or create `%s' called `%s'",
+		   ly_symbol2string (n).c_str (), id));
+      ret = 0;
     }
   return ret;
 }
 
+Context *
+Context::create_context (Context_def *cdef,
+			 string id,
+			 SCM ops)
+{
+  int unique = get_global_context()->new_unique();
+
+  // TODO: The following should be carried out by a listener.
+  string type = ly_symbol2string (cdef->get_context_name ());
+  Object_key const *key = key_manager_.get_context_key (now_mom(), type, id);
+  Context *new_context
+    = cdef->instantiate (ops, key);
+
+  new_context->id_string_ = id;
+  new_context->unique_ = unique;
+  
+  new_context->events_below_->register_as_listener (new_context->event_source_);
+  
+  add_context (new_context);
+  apply_property_operations (new_context, ops);
+  events_below_->register_as_listener (new_context->events_below_);
+
+  // TODO: The above operations should be performed by a listener to the following event.
+  send_stream_event (this, "CreateContext",
+                     ly_symbol2scm ("unique"), scm_int2num (unique),
+                     ly_symbol2scm ("ops"), ops,
+                     ly_symbol2scm ("type"), cdef->get_context_name (),
+                     ly_symbol2scm ("id"), scm_makfrom0str (id.c_str ()));
+
+  return new_context;
+}
+
 /*
   Default child context as a SCM string, or something else if there is
   none.
@@ -175,54 +274,54 @@ Context::find_create_context (SCM n, String id,
 SCM
 Context::default_child_context_name () const
 {
-  return ly_c_pair_p (accepts_list_)
-    ? ly_car (scm_last_pair (accepts_list_))
+  return scm_is_pair (accepts_list_)
+    ? scm_car (accepts_list_)
     : SCM_EOL;
 }
 
-
 bool
 Context::is_bottom_context () const
 {
-  return !ly_c_symbol_p (default_child_context_name ());
+  return !scm_is_symbol (default_child_context_name ());
 }
 
-Context*
+Context *
 Context::get_default_interpreter ()
 {
   if (!is_bottom_context ())
     {
       SCM nm = default_child_context_name ();
-      SCM st = get_output_def ()->find_context_def (nm);
+      SCM st = find_context_def (get_output_def (), nm);
 
+      string name = ly_symbol2string (nm);
       Context_def *t = unsmob_context_def (st);
       if (!t)
 	{
-	  warning (_f ("can't find or create: `%s'", ly_symbol2string (nm).to_str0 ()));
+	  warning (_f ("can't find or create: `%s'", name.c_str ()));
 	  t = unsmob_context_def (this->definition_);
 	}
-      Context *tg = t->instantiate (SCM_EOL);
-      add_context (tg);
-      if (!tg->is_bottom_context ())
-	return tg->get_default_interpreter ();
-      else
-	return tg;
+
+      Context *tg = create_context (t, "", SCM_EOL);
+      return tg->get_default_interpreter ();
     }
   return this;
 }
 
 /*
   PROPERTIES
- */
-Context*
-Context::where_defined (SCM sym) const
+*/
+Context *
+Context::where_defined (SCM sym, SCM *value) const
 {
-  if (properties_dict ()->contains (sym))
-    {
-      return (Context*)this;
-    }
+#ifndef NDEBUG
+  if (profile_property_accesses)
+    note_property_access (&context_property_lookup_table, sym);
+#endif
+
+  if (properties_dict ()->try_retrieve (sym, value))
+    return (Context *)this;
 
-  return (daddy_context_) ? daddy_context_->where_defined (sym) : 0;
+  return (daddy_context_) ? daddy_context_->where_defined (sym, value) : 0;
 }
 
 /*
@@ -231,25 +330,47 @@ Context::where_defined (SCM sym) const
 SCM
 Context::internal_get_property (SCM sym) const
 {
-  SCM val =SCM_EOL;
+#ifndef NDEBUG
+  if (profile_property_accesses)
+    note_property_access (&context_property_lookup_table, sym);
+#endif
+
+  SCM val = SCM_EOL;
   if (properties_dict ()->try_retrieve (sym, &val))
     return val;
 
   if (daddy_context_)
     return daddy_context_->internal_get_property (sym);
-  
+
   return val;
 }
 
+/*
+Called by the send_stream_event macro. props is a 0-terminated array of
+properties and corresponding values, interleaved. This method should not
+be called from any other place than the send_stream_event macro.
+*/
+void
+Context::internal_send_stream_event (SCM type, SCM props[])
+{
+  Stream_event *e = new Stream_event (this, type);
+  for (int i = 0; props[i]; i += 2)
+    {
+      e->internal_set_property (props[i], props[i+1]);
+    }
+  event_source_->broadcast (e);
+  e->unprotect ();
+}
+
 bool
 Context::is_alias (SCM sym) const
 {
   if (sym == ly_symbol2scm ("Bottom")
-      && !ly_c_pair_p (accepts_list_))
+      && !scm_is_pair (accepts_list_))
     return true;
   if (sym == unsmob_context_def (definition_)->get_context_name ())
     return true;
-  
+
   return scm_c_memq (sym, aliases_) != SCM_BOOL_F;
 }
 
@@ -259,22 +380,20 @@ Context::add_alias (SCM sym)
   aliases_ = scm_cons (sym, aliases_);
 }
 
-
-
 void
 Context::internal_set_property (SCM sym, SCM val)
 {
 #ifndef NDEBUG
-  if (internal_type_checking_global_b)
+  if (do_internal_type_checking_global)
     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? 
- */
+  TODO: look up to check whether we have inherited var?
+*/
 void
 Context::unset_property (SCM sym)
 {
@@ -283,9 +402,9 @@ Context::unset_property (SCM sym)
 
 /**
    Remove a context from the hierarchy.
- */
+*/
 Context *
-Context::remove_context (Context*trans)
+Context::remove_context (Context *trans)
 {
   assert (trans);
 
@@ -294,29 +413,49 @@ Context::remove_context (Context*trans)
   return trans;
 }
 
+
 /*
   ID == "" means accept any ID.
- */
+*/
 Context *
-find_context_below (Context * where,
-		    SCM type, String id)
+find_context_below (Context *where,
+		    SCM type, string id)
 {
   if (where->is_alias (type))
     {
       if (id == "" || where->id_string () == id)
 	return where;
     }
-  
-  Context * found = 0;
+
+  Context *found = 0;
   for (SCM s = where->children_contexts ();
-       !found && ly_c_pair_p (s); s = ly_cdr (s))
+       !found && scm_is_pair (s); s = scm_cdr (s))
     {
-      Context * tr = unsmob_context (ly_car (s));
+      Context *tr = unsmob_context (scm_car (s));
 
       found = find_context_below (tr, type, id);
     }
 
-  return found; 
+  return found;
+}
+
+Context *
+find_context_below (Context *where,
+                    int unique)
+{
+  if (where->get_unique () == unique)
+    return where;
+
+  Context *found = 0;
+  for (SCM s = where->children_contexts ();
+       !found && scm_is_pair (s); s = scm_cdr (s))
+    {
+      Context *tr = unsmob_context (scm_car (s));
+
+      found = find_context_below (tr, unique);
+    }
+
+  return found;
 }
 
 SCM
@@ -325,18 +464,23 @@ Context::properties_as_alist () const
   return properties_dict ()->to_alist ();
 }
 
-String
-Context::context_name () const
+SCM
+Context::context_name_symbol () const
 {
-  Context_def * td = unsmob_context_def (definition_ );
-  return ly_symbol2string (td->get_context_name ());
+  Context_def *td = unsmob_context_def (definition_);
+  return td->get_context_name ();
 }
 
+string
+Context::context_name () const
+{
+  return ly_symbol2string (context_name_symbol ());
+}
 
-Score_context*
+Score_context *
 Context::get_score_context () const
 {
-  if (Score_context *sc =dynamic_cast<Score_context*> ((Context*)this))
+  if (Score_context *sc = dynamic_cast<Score_context *> ((Context *) this))
     return sc;
   else if (daddy_context_)
     return daddy_context_->get_score_context ();
@@ -344,78 +488,96 @@ Context::get_score_context () const
     return 0;
 }
 
-Music_output_def *
+Output_def *
 Context::get_output_def () const
 {
-  return  (daddy_context_)
-    ? daddy_context_->get_output_def () : 0;
+  return daddy_context_ ? daddy_context_->get_output_def () : 0;
 }
 
 Context::~Context ()
 {
-  
 }
 
 Moment
 Context::now_mom () const
 {
-  return daddy_context_->now_mom ();
+  Context const *p = this;
+  while (p->daddy_context_)
+    p = p->daddy_context_;
+
+  return p->now_mom ();
 }
 
 int
 Context::print_smob (SCM s, SCM port, scm_print_state *)
 {
-  Context *sc = (Context *) ly_cdr (s);
-     
+  Context *sc = (Context *) SCM_CELL_WORD_1 (s);
+
   scm_puts ("#<", port);
-  scm_puts (classname (sc), port);
-  if (Context_def *d=unsmob_context_def (sc->definition_))
+  scm_puts (sc->class_name (), port);
+  if (Context_def *d = unsmob_context_def (sc->definition_))
     {
       scm_puts (" ", port);
       scm_display (d->get_context_name (), port);
     }
 
-  if (Context *td=dynamic_cast<Context *> (sc))
+  if (!sc->id_string_.empty ())
     {
       scm_puts ("=", port);
-      scm_puts (td->id_string_.to_str0 (), port);
+      scm_puts (sc->id_string_.c_str (), port);
     }
-  
 
   scm_puts (" ", port);
 
   scm_display (sc->context_list_, port);
   scm_puts (" >", port);
-  
+
   return 1;
 }
 
+Object_key const *
+Context::get_grob_key (string name)
+{
+  return key_manager_.get_grob_key (now_mom (), name);
+}
+
+Object_key const *
+Context::get_context_key (string name, string id)
+{
+  return key_manager_.get_context_key (now_mom (), name, id);
+}
+
 SCM
 Context::mark_smob (SCM sm)
 {
-  Context * me = (Context*) SCM_CELL_WORD_1 (sm);
-  
+  Context *me = (Context *) SCM_CELL_WORD_1 (sm);
+  me->key_manager_.gc_mark();
+
   scm_gc_mark (me->context_list_);
   scm_gc_mark (me->aliases_);
-  scm_gc_mark (me->definition_);  
-  scm_gc_mark (me->properties_scm_);  
+  scm_gc_mark (me->definition_);
+  scm_gc_mark (me->definition_mods_);
+  scm_gc_mark (me->properties_scm_);
   scm_gc_mark (me->accepts_list_);
-  scm_gc_mark (me->implementation_);
+  if (me->implementation_)
+    scm_gc_mark (me->implementation_->self_scm ());
+  if (me->event_source_) scm_gc_mark (me->event_source_->self_scm ());
+  if (me->events_below_) scm_gc_mark (me->events_below_->self_scm ());
 
   return me->properties_scm_;
 }
 
 IMPLEMENT_SMOBS (Context);
 IMPLEMENT_DEFAULT_EQUAL_P (Context);
-IMPLEMENT_TYPE_P (Context,"ly:context?");
+IMPLEMENT_TYPE_P (Context, "ly:context?");
 
 bool
-Context::try_music (Music* m)
+Context::try_music (Music *m)
 {
-  Translator*  t = implementation ();
+  Translator_group *t = implementation ();
   if (!t)
     return false;
-  
+
   bool b = t->try_music (m);
   if (!b && daddy_context_)
     b = daddy_context_->try_music (m);
@@ -423,28 +585,91 @@ Context::try_music (Music* m)
   return b;
 }
 
-
-Global_context*
+Global_context *
 Context::get_global_context () const
 {
-  if (dynamic_cast<Global_context *>((Context*) this))
-    return dynamic_cast<Global_context *> ((Context*) this);
+  if (dynamic_cast<Global_context *> ((Context *) this))
+    return dynamic_cast<Global_context *> ((Context *) this);
 
   if (daddy_context_)
     return daddy_context_->get_global_context ();
 
-  programming_error ("No Global context!");
+  programming_error ("no Global context");
   return 0;
 }
 
-Context*
+Context *
 Context::get_parent_context () const
 {
   return daddy_context_;
 }
 
-Translator_group*
-Context::implementation () const
+void
+Context::clear_key_disambiguations ()
+{
+  if (!use_object_keys)
+    return;
+
+  key_manager_.clear ();
+  for (SCM s = context_list_; scm_is_pair (s); s = scm_cdr (s))
+    unsmob_context (scm_car (s))->clear_key_disambiguations ();
+}
+
+/*
+  Ugh. Where to put this?
+*/
+Rational
+measure_length (Context const *context)
+{
+  SCM l = context->get_property ("measureLength");
+  Rational length (1);
+  if (unsmob_moment (l))
+    length = unsmob_moment (l)->main_part_;
+  return length;
+}
+
+Moment
+measure_position (Context const *context)
+{
+  SCM sm = context->get_property ("measurePosition");
+
+  Moment m = 0;
+  if (unsmob_moment (sm))
+    {
+      m = *unsmob_moment (sm);
+
+      if (m.main_part_ < Rational (0))
+	{
+	  Rational length (measure_length (context));
+	  while (m.main_part_ < Rational (0))
+	    m.main_part_ += length;
+	}
+    }
+
+  return m;
+}
+
+
+void
+set_context_property_on_children (Context *trans, SCM sym, SCM val)
+{
+  trans->internal_set_property (sym, ly_deep_copy (val));
+  for (SCM p = trans->children_contexts (); scm_is_pair (p); p = scm_cdr (p))
+    {
+      Context *trg = unsmob_context (scm_car (p));
+      set_context_property_on_children (trg, sym, ly_deep_copy (val));
+    }
+}
+
+bool
+melisma_busy (Context *tr)
 {
-  return dynamic_cast<Translator_group*> (unsmob_translator (implementation_));
+  SCM melisma_properties = tr->get_property ("melismaBusyProperties");
+  bool busy = false;
+
+  for (; scm_is_pair (melisma_properties);
+       melisma_properties = scm_cdr (melisma_properties))
+    busy = busy || to_boolean (tr->internal_get_property (scm_car (melisma_properties)));
+
+  return busy;
 }