2 context.cc -- implement Context
4 source file of the GNU LilyPond music typesetter
6 (c) 2004--2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
11 #include "context-def.hh"
12 #include "ly-smobs.icc"
14 #include "output-def.hh"
15 #include "scm-hash.hh"
16 #include "score-context.hh"
17 #include "translator-group.hh"
19 #include "lilypond-key.hh"
22 Context::is_removable () const
24 return context_list_
== SCM_EOL
&& ! iterator_count_
25 && !dynamic_cast<Score_context
const *> (this);
29 Context::check_removal ()
31 for (SCM p
= context_list_
; scm_is_pair (p
); p
= scm_cdr (p
))
33 Context
*trg
= unsmob_context (scm_car (p
));
35 trg
->check_removal ();
36 if (trg
->is_removable ())
38 recurse_over_translators (trg
, &Translator::finalize
, UP
);
44 Context::Context (Context
const &)
50 Context::properties_dict () const
52 return Scheme_hash_table::unsmob (properties_scm_
);
56 Context::add_context (Context
*t
)
58 SCM ts
= t
->self_scm ();
59 context_list_
= ly_append2 (context_list_
,
60 scm_cons (ts
, SCM_EOL
));
62 t
->daddy_context_
= this;
67 scm_gc_unprotect_object (ts
);
68 Context_def
*td
= unsmob_context_def (t
->definition_
);
70 /* This cannot move before add_context (), because \override
71 operations require that we are in the hierarchy. */
72 td
->apply_default_property_operations (t
);
74 recurse_over_translators (t
, &Translator::initialize
, DOWN
);
79 Context::get_key () const
84 Context::Context (Object_key
const *key
)
91 implementation_
= SCM_EOL
;
92 properties_scm_
= SCM_EOL
;
93 accepts_list_
= SCM_EOL
;
94 context_list_
= SCM_EOL
;
95 definition_
= SCM_EOL
;
98 properties_scm_
= (new Scheme_hash_table
)->self_scm ();
99 scm_gc_unprotect_object (properties_scm_
);
100 scm_gc_unprotect_object (key_
->self_scm ());
103 /* TODO: this shares code with find_create_context (). */
105 Context::create_unique_context (SCM n
, SCM operations
)
108 Don't create multiple score contexts.
110 if (dynamic_cast<Global_context
*> (this)
111 && dynamic_cast<Global_context
*> (this)->get_score_context ())
112 return get_score_context ()->create_unique_context (n
, operations
);
115 TODO: use accepts_list_.
117 Link_array
<Context_def
> path
118 = unsmob_context_def (definition_
)->path_to_acceptable_context (n
, get_output_def ());
122 Context
*current
= this;
124 // start at 1. The first one (index 0) will be us.
125 for (int i
= 0; i
< path
.size (); i
++)
127 SCM ops
= (i
== path
.size () -1) ? operations
: SCM_EOL
;
129 current
= current
->create_context (path
[i
],
138 Don't go up to Global_context, because global goes down to
142 if (daddy_context_
&& !dynamic_cast<Global_context
*> (daddy_context_
))
143 ret
= daddy_context_
->create_unique_context (n
, operations
);
146 warning (_f ("can't find or create new `%s'",
147 ly_symbol2string (n
).to_str0 ()));
154 Context::find_create_context (SCM n
, String id
, SCM operations
)
157 Don't create multiple score contexts.
159 if (dynamic_cast<Global_context
*> (this)
160 && dynamic_cast<Global_context
*> (this)->get_score_context ())
161 return get_score_context ()->find_create_context (n
, id
, operations
);
163 if (Context
*existing
= find_context_below (this, n
, id
))
166 if (n
== ly_symbol2scm ("Bottom"))
168 Context
*tg
= get_default_interpreter ();
173 TODO: use accepts_list_.
175 Link_array
<Context_def
> path
176 = unsmob_context_def (definition_
)->path_to_acceptable_context (n
, get_output_def ());
180 Context
*current
= this;
182 // start at 1. The first one (index 0) will be us.
183 for (int i
= 0; i
< path
.size (); i
++)
185 SCM ops
= (i
== path
.size () -1) ? operations
: SCM_EOL
;
188 if (i
== path
.size () -1)
193 current
= current
->create_context (path
[i
],
202 Don't go up to Global_context, because global goes down to
206 if (daddy_context_
&& !dynamic_cast<Global_context
*> (daddy_context_
))
207 ret
= daddy_context_
->find_create_context (n
, id
, operations
);
210 warning (_f ("can't find or create `%s' called `%s'",
211 ly_symbol2string (n
).to_str0 (), id
));
218 Context::create_context (Context_def
*cdef
,
222 String type
= ly_symbol2string (cdef
->get_context_name ());
223 Object_key
const *key
= get_context_key (type
, id
);
225 = cdef
->instantiate (ops
, key
);
227 new_group
->id_string_
= id
;
228 add_context (new_group
);
229 apply_property_operations (new_group
, ops
);
235 Context::get_context_key (String type
, String id
)
237 String now_key
= type
+ "@" + id
;
239 int disambiguation_count
= 0;
240 if (context_counts_
.find (now_key
) != context_counts_
.end ())
242 disambiguation_count
= context_counts_
[now_key
];
245 context_counts_
[now_key
] = disambiguation_count
+ 1;
247 return new Lilypond_context_key (get_key (),
250 disambiguation_count
);
254 Context::get_grob_key (String name
)
256 int disambiguation_count
= 0;
257 if (grob_counts_
.find (name
) != grob_counts_
.end ())
259 disambiguation_count
= grob_counts_
[name
];
261 grob_counts_
[name
] = disambiguation_count
+ 1;
263 Object_key
*k
= new Lilypond_grob_key (get_key (),
266 disambiguation_count
);
272 Default child context as a SCM string, or something else if there is
276 Context::default_child_context_name () const
278 return scm_is_pair (accepts_list_
)
279 ? scm_car (scm_last_pair (accepts_list_
))
284 Context::is_bottom_context () const
286 return !scm_is_symbol (default_child_context_name ());
290 Context::get_default_interpreter ()
292 if (!is_bottom_context ())
294 SCM nm
= default_child_context_name ();
295 SCM st
= find_context_def (get_output_def (), nm
);
297 String name
= ly_symbol2string (nm
);
298 Context_def
*t
= unsmob_context_def (st
);
301 warning (_f ("can't find or create: `%s'", name
.to_str0 ()));
302 t
= unsmob_context_def (this->definition_
);
305 Context
*tg
= create_context (t
, "", SCM_EOL
);
306 if (!tg
->is_bottom_context ())
307 return tg
->get_default_interpreter ();
318 Context::where_defined (SCM sym
) const
320 if (properties_dict ()->contains (sym
))
322 return (Context
*)this;
325 return (daddy_context_
) ? daddy_context_
->where_defined (sym
) : 0;
329 return SCM_EOL when not found.
332 Context::internal_get_property (SCM sym
) const
335 if (properties_dict ()->try_retrieve (sym
, &val
))
339 return daddy_context_
->internal_get_property (sym
);
345 Context::is_alias (SCM sym
) const
347 if (sym
== ly_symbol2scm ("Bottom")
348 && !scm_is_pair (accepts_list_
))
350 if (sym
== unsmob_context_def (definition_
)->get_context_name ())
353 return scm_c_memq (sym
, aliases_
) != SCM_BOOL_F
;
357 Context::add_alias (SCM sym
)
359 aliases_
= scm_cons (sym
, aliases_
);
363 Context::internal_set_property (SCM sym
, SCM val
)
366 if (do_internal_type_checking_global
)
367 assert (type_check_assignment (sym
, val
, ly_symbol2scm ("translation-type?")));
370 properties_dict ()->set (sym
, val
);
374 TODO: look up to check whether we have inherited var?
377 Context::unset_property (SCM sym
)
379 properties_dict ()->remove (sym
);
383 Remove a context from the hierarchy.
386 Context::remove_context (Context
*trans
)
390 context_list_
= scm_delq_x (trans
->self_scm (), context_list_
);
391 trans
->daddy_context_
= 0;
396 ID == "" means accept any ID.
399 find_context_below (Context
*where
,
402 if (where
->is_alias (type
))
404 if (id
== "" || where
->id_string () == id
)
409 for (SCM s
= where
->children_contexts ();
410 !found
&& scm_is_pair (s
); s
= scm_cdr (s
))
412 Context
*tr
= unsmob_context (scm_car (s
));
414 found
= find_context_below (tr
, type
, id
);
421 Context::properties_as_alist () const
423 return properties_dict ()->to_alist ();
427 Context::context_name_symbol () const
429 Context_def
*td
= unsmob_context_def (definition_
);
430 return td
->get_context_name ();
434 Context::context_name () const
436 return ly_symbol2string (context_name_symbol ());
440 Context::get_score_context () const
442 if (Score_context
*sc
= dynamic_cast<Score_context
*> ((Context
*) this))
444 else if (daddy_context_
)
445 return daddy_context_
->get_score_context ();
451 Context::get_output_def () const
453 return daddy_context_
? daddy_context_
->get_output_def () : 0;
461 Context::now_mom () const
463 return daddy_context_
->now_mom ();
467 Context::print_smob (SCM s
, SCM port
, scm_print_state
*)
469 Context
*sc
= (Context
*) SCM_CELL_WORD_1 (s
);
471 scm_puts ("#<", port
);
472 scm_puts (classname (sc
), port
);
473 if (Context_def
*d
= unsmob_context_def (sc
->definition_
))
475 scm_puts (" ", port
);
476 scm_display (d
->get_context_name (), port
);
479 if (Context
*td
= dynamic_cast<Context
*> (sc
))
481 scm_puts ("=", port
);
482 scm_puts (td
->id_string_
.to_str0 (), port
);
485 scm_puts (" ", port
);
487 scm_display (sc
->context_list_
, port
);
488 scm_puts (" >", port
);
494 Context::mark_smob (SCM sm
)
496 Context
*me
= (Context
*) SCM_CELL_WORD_1 (sm
);
497 scm_gc_mark (me
->key_
->self_scm ());
498 scm_gc_mark (me
->context_list_
);
499 scm_gc_mark (me
->aliases_
);
500 scm_gc_mark (me
->definition_
);
501 scm_gc_mark (me
->properties_scm_
);
502 scm_gc_mark (me
->accepts_list_
);
503 scm_gc_mark (me
->implementation_
);
505 return me
->properties_scm_
;
508 IMPLEMENT_SMOBS (Context
);
509 IMPLEMENT_DEFAULT_EQUAL_P (Context
);
510 IMPLEMENT_TYPE_P (Context
, "ly:context?");
513 Context::try_music (Music
*m
)
515 Translator
*t
= implementation ();
519 bool b
= t
->try_music (m
);
520 if (!b
&& daddy_context_
)
521 b
= daddy_context_
->try_music (m
);
527 Context::get_global_context () const
529 if (dynamic_cast<Global_context
*> ((Context
*) this))
530 return dynamic_cast<Global_context
*> ((Context
*) this);
533 return daddy_context_
->get_global_context ();
535 programming_error ("no Global context");
540 Context::get_parent_context () const
542 return daddy_context_
;
546 Context::implementation () const
548 return dynamic_cast<Translator_group
*> (unsmob_translator (implementation_
));
552 Context::clear_key_disambiguations ()
554 grob_counts_
.clear ();
555 context_counts_
.clear ();
556 for (SCM s
= context_list_
; scm_is_pair (s
); s
= scm_cdr (s
))
558 unsmob_context (scm_car (s
))->clear_key_disambiguations ();