]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/context.cc
smobs.hh: mention that GUILE 1 gives callable structs at most 3 args
[lilypond.git] / lily / context.cc
index 9dad38f269c623a9264966ebee9d1cd381ad0357..51aa8f024edb618ae4274c9d459a54b88c9e35ec 100644 (file)
@@ -43,7 +43,7 @@ Context::check_removal ()
 {
   for (SCM p = context_list_; scm_is_pair (p); p = scm_cdr (p))
     {
-      Context *ctx = Context::unsmob (scm_car (p));
+      Context *ctx = unsmob<Context> (scm_car (p));
 
       ctx->check_removal ();
       if (ctx->is_removable ())
@@ -59,7 +59,7 @@ Context::check_removal ()
 Scheme_hash_table *
 Context::properties_dict () const
 {
-  return Scheme_hash_table::unsmob (properties_scm_);
+  return unsmob<Scheme_hash_table> (properties_scm_);
 }
 
 void
@@ -170,7 +170,7 @@ Context::find_create_context (SCM n, const string &id, SCM operations)
       SCM score_name = default_child_context_name ();
       SCM score_def = find_context_def (get_output_def (), score_name);
 
-      if (Context_def *cd = Context_def::unsmob (score_def))
+      if (Context_def *cd = unsmob<Context_def> (score_def))
         {
           if (cd->is_alias (n))
             return create_context (cd, id, operations);
@@ -226,18 +226,16 @@ Context::find_create_context (SCM n, const string &id, SCM operations)
   return ret;
 }
 
-IMPLEMENT_LISTENER (Context, acknowledge_infant);
 void
 Context::acknowledge_infant (SCM sev)
 {
-  infant_event_ = Stream_event::unsmob (sev);
+  infant_event_ = unsmob<Stream_event> (sev);
 }
 
-IMPLEMENT_LISTENER (Context, set_property_from_event);
 void
 Context::set_property_from_event (SCM sev)
 {
-  Stream_event *ev = Stream_event::unsmob (sev);
+  Stream_event *ev = unsmob<Stream_event> (sev);
 
   SCM sym = ev->get_property ("symbol");
   if (scm_is_symbol (sym))
@@ -257,11 +255,10 @@ Context::set_property_from_event (SCM sev)
     }
 }
 
-IMPLEMENT_LISTENER (Context, unset_property_from_event);
 void
 Context::unset_property_from_event (SCM sev)
 {
-  Stream_event *ev = Stream_event::unsmob (sev);
+  Stream_event *ev = unsmob<Stream_event> (sev);
 
   SCM sym = ev->get_property ("symbol");
   type_check_assignment (sym, SCM_EOL, ly_symbol2scm ("translation-type?"));
@@ -272,11 +269,10 @@ Context::unset_property_from_event (SCM sev)
   Creates a new context from a CreateContext event, and sends an
   AnnounceNewContext event to this context.
 */
-IMPLEMENT_LISTENER (Context, create_context_from_event);
 void
 Context::create_context_from_event (SCM sev)
 {
-  Stream_event *ev = Stream_event::unsmob (sev);
+  Stream_event *ev = unsmob<Stream_event> (sev);
 
   string id = ly_scm2string (ev->get_property ("id"));
   SCM ops = ev->get_property ("ops");
@@ -302,19 +298,19 @@ Context::create_context_from_event (SCM sev)
   /* We want to be the first ones to hear our own events. Therefore, wait
      before registering events_below_ */
   new_context->event_source ()->
-  add_listener (GET_LISTENER (new_context->create_context_from_event),
+  add_listener (new_context->GET_LISTENER (Context, create_context_from_event),
                 ly_symbol2scm ("CreateContext"));
   new_context->event_source ()->
-  add_listener (GET_LISTENER (new_context->remove_context),
+  add_listener (new_context->GET_LISTENER (Context, remove_context),
                 ly_symbol2scm ("RemoveContext"));
   new_context->event_source ()->
-  add_listener (GET_LISTENER (new_context->change_parent),
+  add_listener (new_context->GET_LISTENER (Context, change_parent),
                 ly_symbol2scm ("ChangeParent"));
   new_context->event_source ()->
-  add_listener (GET_LISTENER (new_context->set_property_from_event),
+  add_listener (new_context->GET_LISTENER (Context, set_property_from_event),
                 ly_symbol2scm ("SetProperty"));
   new_context->event_source ()->
-  add_listener (GET_LISTENER (new_context->unset_property_from_event),
+  add_listener (new_context->GET_LISTENER (Context, unset_property_from_event),
                 ly_symbol2scm ("UnsetProperty"));
 
   new_context->events_below_->register_as_listener (new_context->event_source_);
@@ -322,7 +318,7 @@ Context::create_context_from_event (SCM sev)
 
   new_context->unprotect ();
 
-  Context_def *td = Context_def::unsmob (new_context->definition_);
+  Context_def *td = unsmob<Context_def> (new_context->definition_);
 
   /* This cannot move before add_context (), because \override
      operations require that we are in the hierarchy.  */
@@ -347,7 +343,7 @@ Context::path_to_acceptable_context (SCM name) const
         accepts = scm_cons (elt, accepts);
       }
 
-  return Context_def::unsmob (definition_)->path_to_acceptable_context (name,
+  return unsmob<Context_def> (definition_)->path_to_acceptable_context (name,
          get_output_def (),
          scm_reverse_x (accepts, SCM_EOL));
 
@@ -362,7 +358,7 @@ Context::create_context (Context_def *cdef,
   /* TODO: This is fairly misplaced. We can fix this when we have taken out all
      iterator specific stuff from the Context class */
   event_source_->
-  add_listener (GET_LISTENER (acknowledge_infant),
+  add_listener (GET_LISTENER (Context, acknowledge_infant),
                 ly_symbol2scm ("AnnounceNewContext"));
   /* The CreateContext creates a new context, and sends an announcement of the
      new context through another event. That event will be stored in
@@ -372,12 +368,12 @@ Context::create_context (Context_def *cdef,
                      ly_symbol2scm ("type"), cdef->get_context_name (),
                      ly_symbol2scm ("id"), ly_string2scm (id));
   event_source_->
-  remove_listener (GET_LISTENER (acknowledge_infant),
+  remove_listener (GET_LISTENER (Context, acknowledge_infant),
                    ly_symbol2scm ("AnnounceNewContext"));
 
   assert (infant_event_);
   SCM infant_scm = infant_event_->get_property ("context");
-  Context *infant = Context::unsmob (infant_scm);
+  Context *infant = unsmob<Context> (infant_scm);
 
   if (!infant || infant->get_parent_context () != this)
     {
@@ -413,11 +409,11 @@ Context::get_default_interpreter (const string &context_id)
       SCM st = find_context_def (get_output_def (), nm);
 
       string name = ly_symbol2string (nm);
-      Context_def *t = Context_def::unsmob (st);
+      Context_def *t = unsmob<Context_def> (st);
       if (!t)
         {
           warning (_f ("cannot find or create: `%s'", name.c_str ()));
-          t = Context_def::unsmob (this->definition_);
+          t = unsmob<Context_def> (this->definition_);
         }
       if (scm_is_symbol (t->get_default_child (SCM_EOL)))
         {
@@ -442,7 +438,7 @@ Context::get_default_interpreter (const string &context_id)
 Context *
 Context::where_defined (SCM sym, SCM *value) const
 {
-#ifndef NDEBUG
+#ifdef DEBUG
   if (profile_property_accesses)
     note_property_access (&context_property_lookup_table, sym);
 #endif
@@ -458,7 +454,7 @@ Context::where_defined (SCM sym, SCM *value) const
 bool
 Context::here_defined (SCM sym, SCM *value) const
 {
-#ifndef NDEBUG
+#ifdef DEBUG
   if (profile_property_accesses)
     note_property_access (&context_property_lookup_table, sym);
 #endif
@@ -472,7 +468,7 @@ Context::here_defined (SCM sym, SCM *value) const
 SCM
 Context::internal_get_property (SCM sym) const
 {
-#ifndef NDEBUG
+#ifdef DEBUG
   if (profile_property_accesses)
     note_property_access (&context_property_lookup_table, sym);
 #endif
@@ -551,12 +547,11 @@ Context::unset_property (SCM sym)
   properties_dict ()->remove (sym);
 }
 
-IMPLEMENT_LISTENER (Context, change_parent);
 void
 Context::change_parent (SCM sev)
 {
-  Stream_event *ev = Stream_event::unsmob (sev);
-  Context *to = Context::unsmob (ev->get_property ("context"));
+  Stream_event *ev = unsmob<Stream_event> (sev);
+  Context *to = unsmob<Context> (ev->get_property ("context"));
 
   disconnect_from_parent ();
   to->add_context (this);
@@ -565,7 +560,6 @@ Context::change_parent (SCM sev)
 /*
   Die. The next GC sweep should take care of the actual death.
  */
-IMPLEMENT_LISTENER (Context, remove_context);
 void
 Context::remove_context (SCM)
 {
@@ -584,9 +578,26 @@ Context::disconnect_from_parent ()
   daddy_context_ = 0;
 }
 
-/*
-  ID == "" means accept any ID.
-*/
+Context *
+find_context_above (Context *where, SCM type)
+{
+  while (where && !where->is_alias (type))
+    where = where->get_parent_context ();
+
+  return where;
+}
+
+Context *
+find_context_above_by_parent_type (Context *where, SCM parent_type)
+{
+  for (Context *child = 0; where;
+       child = where, where = where->get_parent_context ())
+    if (where->is_alias (parent_type))
+      return child;
+
+  return 0;
+}
+
 Context *
 find_context_below (Context *where,
                     SCM type, const string &id)
@@ -601,7 +612,7 @@ find_context_below (Context *where,
   for (SCM s = where->children_contexts ();
        !found && scm_is_pair (s); s = scm_cdr (s))
     {
-      Context *tr = Context::unsmob (scm_car (s));
+      Context *tr = unsmob<Context> (scm_car (s));
 
       found = find_context_below (tr, type, id);
     }
@@ -609,6 +620,29 @@ find_context_below (Context *where,
   return found;
 }
 
+Context *
+find_context_near (Context *where,
+                   SCM type, const string &id)
+{
+  for ( ; where; where = where->get_parent_context ())
+    {
+      Context *found = find_context_below (where, type, id);
+      if (found)
+        return found;
+    }
+
+  return 0;
+}
+
+Context *
+find_top_context (Context *where)
+{
+  Context *top = where;
+  for ( ; where; where = where->get_parent_context())
+    top = where;
+  return top;
+}
+
 SCM
 Context::properties_as_alist () const
 {
@@ -618,7 +652,7 @@ Context::properties_as_alist () const
 SCM
 Context::context_name_symbol () const
 {
-  Context_def *td = Context_def::unsmob (definition_);
+  Context_def *td = unsmob<Context_def> (definition_);
   return td->get_context_name ();
 }
 
@@ -662,7 +696,7 @@ Context::print_smob (SCM port, scm_print_state *)
 {
   scm_puts ("#<", port);
   scm_puts (class_name (), port);
-  if (Context_def *d = Context_def::unsmob (definition_))
+  if (Context_def *d = unsmob<Context_def> (definition_))
     {
       scm_puts (" ", port);
       scm_display (d->get_context_name (), port);
@@ -734,8 +768,8 @@ measure_length (Context const *context)
 {
   SCM l = context->get_property ("measureLength");
   Rational length (1);
-  if (Moment::is_smob (l))
-    length = Moment::unsmob (l)->main_part_;
+  if (unsmob<Moment> (l))
+    length = unsmob<Moment> (l)->main_part_;
   return length;
 }
 
@@ -745,9 +779,9 @@ measure_position (Context const *context)
   SCM sm = context->get_property ("measurePosition");
 
   Moment m = 0;
-  if (Moment::is_smob (sm))
+  if (unsmob<Moment> (sm))
     {
-      m = *Moment::unsmob (sm);
+      m = *unsmob<Moment> (sm);
 
       if (m.main_part_ < Rational (0))
         {
@@ -795,7 +829,7 @@ set_context_property_on_children (Context *trans, SCM sym, SCM val)
   trans->set_property (sym, ly_deep_copy (val));
   for (SCM p = trans->children_contexts (); scm_is_pair (p); p = scm_cdr (p))
     {
-      Context *trg = Context::unsmob (scm_car (p));
+      Context *trg = unsmob<Context> (scm_car (p));
       set_context_property_on_children (trg, sym, ly_deep_copy (val));
     }
 }
@@ -812,7 +846,7 @@ melisma_busy (Context *tr)
       // to true.
 
       do {
-        if (!melisma_busy (Context::unsmob (scm_car (ch))))
+        if (!melisma_busy (unsmob<Context> (scm_car (ch))))
           return false;
         ch = scm_cdr (ch);
       } while (scm_is_pair (ch));