#include "scm-hash.hh"
#include "translator-group.hh"
#include "warn.hh"
+#include "lily-imports.hh"
bool
Context::is_removable () const
ctx->check_removal ();
if (ctx->is_removable ())
{
- recurse_over_translators (ctx, &Translator::finalize,
- &Translator_group::finalize,
- UP);
- send_stream_event (ctx, "RemoveContext", 0, 0);
+ recurse_over_translators
+ (ctx,
+ Callback0_wrapper::make_smob
+ <Translator, &Translator::finalize> (),
+ Callback0_wrapper::make_smob
+ <Translator_group, &Translator_group::finalize> (),
+ UP);
+ send_stream_event (ctx, "RemoveContext", 0);
}
}
}
scm_cons (child->self_scm (), SCM_EOL));
child->daddy_context_ = this;
- this->events_below_->register_as_listener (child->events_below_);
+ events_below_->register_as_listener (child->events_below_);
}
Context::Context ()
smobify_self ();
- Scheme_hash_table *tab = new Scheme_hash_table;
- properties_scm_ = tab->unprotect ();
+ properties_scm_ = Scheme_hash_table::make_smob ();
event_source_ = new Dispatcher ();
event_source_->unprotect ();
events_below_ = new Dispatcher ();
ok = type_check_assignment (sym, val, ly_symbol2scm ("translation-type?"));
if (ok)
- set_property (sym, val);
+ {
+ if (to_boolean (ev->get_property ("once")))
+ {
+ if (Global_context *g = get_global_context ())
+ {
+ SCM old_val = SCM_UNDEFINED;
+ if (here_defined (sym, &old_val))
+ g->add_finalization (scm_list_4 (ly_context_set_property_x_proc,
+ self_scm (),
+ sym,
+ old_val));
+ else
+ g->add_finalization (scm_list_3 (ly_context_unset_property_proc,
+ self_scm (),
+ sym));
+ }
+ }
+ set_property (sym, val);
+ }
}
}
Stream_event *ev = unsmob<Stream_event> (sev);
SCM sym = ev->get_property ("symbol");
- type_check_assignment (sym, SCM_EOL, ly_symbol2scm ("translation-type?"));
- unset_property (sym);
+ bool ok = type_check_assignment (sym, SCM_EOL, ly_symbol2scm ("translation-type?"));
+
+ if (ok)
+ {
+ if (to_boolean (ev->get_property ("once")))
+ {
+ if (Global_context *g = get_global_context ())
+ {
+ SCM old_val = SCM_UNDEFINED;
+ if (here_defined (sym, &old_val))
+ g->add_finalization (scm_list_4 (ly_context_set_property_x_proc,
+ self_scm (),
+ sym,
+ old_val));
+ else
+ g->add_finalization (scm_list_3 (ly_context_unset_property_proc,
+ self_scm (),
+ sym));
+ }
+ }
+ unset_property (sym);
+ }
}
/*
ly_symbol2scm ("UnsetProperty"));
new_context->events_below_->register_as_listener (new_context->event_source_);
- this->add_context (new_context);
+ add_context (new_context);
new_context->unprotect ();
if (!t)
{
warning (_f ("cannot find or create: `%s'", name.c_str ()));
- t = unsmob<Context_def> (this->definition_);
+ t = unsmob<Context_def> (definition_);
}
if (scm_is_symbol (t->get_default_child (SCM_EOL)))
{
}
/*
-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.
+These methods should not be called from any other place than the
+send_stream_event macro.
*/
+
void
-Context::internal_send_stream_event (SCM type, Input *origin, SCM props[])
+Context::internal_send_stream_event (SCM type, Input *origin)
{
- Stream_event *e = new Stream_event
- (scm_call_1 (ly_lily_module_constant ("ly:make-event-class"), type),
- origin);
- for (int i = 0; props[i]; i += 2)
- {
- e->set_property (props[i], props[i + 1]);
- }
+ Stream_event *e = new Stream_event (Lily::ly_make_event_class (type), origin);
+ event_source_->broadcast (e);
+ e->unprotect ();
+}
+
+void
+Context::internal_send_stream_event (SCM type, Input *origin,
+ SCM prop, SCM val)
+{
+ Stream_event *e = new Stream_event (Lily::ly_make_event_class (type), origin);
+ e->set_property (prop, val);
+ event_source_->broadcast (e);
+ e->unprotect ();
+}
+
+void
+Context::internal_send_stream_event (SCM type, Input *origin,
+ SCM prop, SCM val, SCM prop2, SCM val2)
+{
+ Stream_event *e = new Stream_event (Lily::ly_make_event_class (type), origin);
+ e->set_property (prop, val);
+ e->set_property (prop2, val2);
+ event_source_->broadcast (e);
+ e->unprotect ();
+}
+
+void
+Context::internal_send_stream_event (SCM type, Input *origin,
+ SCM prop, SCM val, SCM prop2, SCM val2,
+ SCM prop3, SCM val3)
+{
+ Stream_event *e = new Stream_event (Lily::ly_make_event_class (type), origin);
+ e->set_property (prop, val);
+ e->set_property (prop2, val2);
+ e->set_property (prop3, val3);
+ event_source_->broadcast (e);
+ e->unprotect ();
+}
+
+void
+Context::internal_send_stream_event (SCM type, Input *origin,
+ SCM prop, SCM val, SCM prop2, SCM val2,
+ SCM prop3, SCM val3, SCM prop4, SCM val4)
+{
+ Stream_event *e = new Stream_event (Lily::ly_make_event_class (type), origin);
+ e->set_property (prop, val);
+ e->set_property (prop2, val2);
+ e->set_property (prop3, val3);
+ e->set_property (prop4, val4);
event_source_->broadcast (e);
e->unprotect ();
}
void
Context::disconnect_from_parent ()
{
- daddy_context_->events_below_->unregister_as_listener (this->events_below_);
- daddy_context_->context_list_ = scm_delq_x (this->self_scm (), daddy_context_->context_list_);
+ daddy_context_->events_below_->unregister_as_listener (events_below_);
+ daddy_context_->context_list_ = scm_delq_x (self_scm (), daddy_context_->context_list_);
daddy_context_ = 0;
}
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;
-
+ while (Context *parent = where->get_parent_context ())
+ {
+ if (parent->is_alias (parent_type))
+ return where;
+ where = parent;
+ }
return 0;
}
}
int
-Context::print_smob (SCM port, scm_print_state *)
+Context::print_smob (SCM port, scm_print_state *) const
{
scm_puts ("#<", port);
scm_puts (class_name (), port);
return 1;
}
+void
+Context::derived_mark () const
+{
+}
+
SCM
Context::mark_smob () const
{
if (events_below_)
scm_gc_mark (events_below_->self_scm ());
+ derived_mark ();
+
return properties_scm_;
}
-const char Context::type_p_name_[] = "ly:context?";
+const char * const Context::type_p_name_ = "ly:context?";
Global_context *
Context::get_global_context () const
projects / lilypond.git / blobdiff