]> git.donarmstrong.com Git - lilypond.git/blob - lily/context.cc
(Invoking lilypond-book):
[lilypond.git] / lily / context.cc
1 /*
2   context.cc -- implement Context
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 2004--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
7 */
8
9 #include "context.hh"
10
11 #include "context-def.hh"
12 #include "dispatcher.hh"
13 #include "global-context.hh"
14 #include "international.hh"
15 #include "ly-smobs.icc"
16 #include "main.hh"
17 #include "output-def.hh"
18 #include "profile.hh"
19 #include "program-option.hh"
20 #include "scm-hash.hh"
21 #include "translator-group.hh"
22 #include "warn.hh"
23
24 bool
25 Context::is_removable () const
26 {
27   return context_list_ == SCM_EOL && ! iterator_count_
28     && !dynamic_cast<Global_context const *> (daddy_context_);
29 }
30
31 void
32 Context::check_removal ()
33 {
34   for (SCM p = context_list_; scm_is_pair (p); p = scm_cdr (p))
35     {
36       Context *ctx = unsmob_context (scm_car (p));
37
38       ctx->check_removal ();
39       if (ctx->is_removable ())
40         {
41           recurse_over_translators (ctx, &Translator::finalize,
42                                     &Translator_group::finalize,
43                                     UP);
44           send_stream_event (ctx, "RemoveContext", 0, 0);
45         }
46     }
47 }
48
49 Context::Context (Context const &src)
50   : key_manager_ (src.key_manager_)
51 {
52   assert (false);
53 }
54
55 Scheme_hash_table *
56 Context::properties_dict () const
57 {
58   return Scheme_hash_table::unsmob (properties_scm_);
59 }
60
61 void
62 Context::add_context (Context *child)
63 {
64   context_list_ = ly_append2 (context_list_,
65                               scm_cons (child->self_scm (), SCM_EOL));
66
67   child->daddy_context_ = this;
68   this->events_below_->register_as_listener (child->events_below_);
69 }
70
71
72 Context::Context (Object_key const *key)
73   : key_manager_ (key)
74 {
75   daddy_context_ = 0;
76   aliases_ = SCM_EOL;
77   iterator_count_ = 0;
78   implementation_ = 0;
79   properties_scm_ = SCM_EOL;
80   accepts_list_ = SCM_EOL;
81   context_list_ = SCM_EOL;
82   definition_ = SCM_EOL;
83   definition_mods_ = SCM_EOL;
84   event_source_ = 0;
85   events_below_ = 0;
86
87   smobify_self ();
88
89   Scheme_hash_table *tab = new Scheme_hash_table;
90   properties_scm_ = tab->unprotect ();
91   event_source_ = new Dispatcher ();
92   event_source_->unprotect ();
93   events_below_ = new Dispatcher ();
94   events_below_->unprotect ();
95
96   /*
97     UGH UGH
98     const correctness.
99   */
100   key_manager_.unprotect();
101 }
102
103 /* TODO:  this shares code with find_create_context ().  */
104 Context *
105 Context::create_unique_context (SCM name, string id, SCM operations)
106 {
107   /*
108     Don't create multiple score contexts.
109   */
110   Global_context *gthis = dynamic_cast<Global_context *> (this);
111   if (gthis && gthis->get_score_context ())
112     return gthis->get_score_context ()->create_unique_context (name, id, operations);
113
114   /*
115     TODO: use accepts_list_.
116   */
117   vector<Context_def*> path
118     = unsmob_context_def (definition_)->path_to_acceptable_context (name, get_output_def ());
119
120   if (path.size ())
121     {
122       Context *current = this;
123
124       // start at 1.  The first one (index 0) will be us.
125       for (vsize i = 0; i < path.size (); i++)
126         {
127           SCM ops = SCM_EOL;
128           string id_str = "\\new";
129           if (i == path.size () - 1)
130             {
131               ops = operations;
132               id_str = id;
133             }
134           current = current->create_context (path[i],
135                                              id_str,
136                                              ops);
137         }
138
139       return current;
140     }
141
142   /*
143     Don't go up to Global_context, because global goes down to the
144     Score context
145   */
146   Context *ret = 0;
147   if (daddy_context_ && !dynamic_cast<Global_context *> (daddy_context_))
148     ret = daddy_context_->create_unique_context (name, id, operations);
149   else
150     {
151       warning (_f ("can't find or create new `%s'",
152                    ly_symbol2string (name).c_str ()));
153       ret = 0;
154     }
155   return ret;
156 }
157
158 Context *
159 Context::find_create_context (SCM n, string id, SCM operations)
160 {
161   /*
162     Don't create multiple score contexts.
163   */
164   Global_context *gthis = dynamic_cast<Global_context *> (this);
165   if (gthis && gthis->get_score_context ())
166     return gthis->get_score_context ()->find_create_context (n, id, operations);
167
168   if (Context *existing = find_context_below (this, n, id))
169     return existing;
170
171   if (n == ly_symbol2scm ("Bottom"))
172     {
173       Context *tg = get_default_interpreter ();
174       return tg;
175     }
176
177   /*
178     TODO: use accepts_list_.
179   */
180   vector<Context_def*> path
181     = unsmob_context_def (definition_)->path_to_acceptable_context (n, get_output_def ());
182
183   if (path.size ())
184     {
185       Context *current = this;
186
187       // start at 1.  The first one (index 0) will be us.
188       for (vsize i = 0; i < path.size (); i++)
189         {
190           SCM ops = (i == path.size () -1) ? operations : SCM_EOL;
191
192           string this_id = "";
193           if (i == path.size () -1)
194             this_id = id;
195
196           current = current->create_context (path[i],
197                                              this_id,
198                                              ops);
199         }
200
201       return current;
202     }
203
204   /*
205     Don't go up to Global_context, because global goes down to the
206     Score context
207   */
208   Context *ret = 0;
209   if (daddy_context_ && !dynamic_cast<Global_context *> (daddy_context_))
210     ret = daddy_context_->find_create_context (n, id, operations);
211   else
212     {
213       warning (_f ("can't find or create `%s' called `%s'",
214                    ly_symbol2string (n).c_str (), id));
215       ret = 0;
216     }
217   return ret;
218 }
219
220 IMPLEMENT_LISTENER (Context, acknowledge_infant);
221 void
222 Context::acknowledge_infant (SCM sev)
223 {
224   infant_event_ = unsmob_stream_event (sev);
225 }
226
227 IMPLEMENT_LISTENER (Context, set_property_from_event);
228 void
229 Context::set_property_from_event (SCM sev)
230 {
231   Stream_event *ev = unsmob_stream_event (sev);
232   
233   SCM sym = ev->get_property ("symbol");
234   if (scm_is_symbol (sym))
235     {
236       SCM val = ev->get_property ("value");
237       bool ok = true;
238       if (val != SCM_EOL)
239         ok = type_check_assignment (sym, val, ly_symbol2scm ("translation-type?"));
240       if (ok)
241         internal_set_property (sym, val);
242     }
243 }
244
245 IMPLEMENT_LISTENER (Context, unset_property_from_event);
246 void
247 Context::unset_property_from_event (SCM sev)
248 {
249   Stream_event *ev = unsmob_stream_event (sev);
250   
251   SCM sym = ev->get_property ("symbol");
252   type_check_assignment (sym, SCM_EOL, ly_symbol2scm ("translation-type?"));
253   unset_property (sym);
254 }
255
256 /*
257   Creates a new context from a CreateContext event, and sends an
258   AnnounceNewContext event to this context.
259 */
260 IMPLEMENT_LISTENER (Context, create_context_from_event);
261 void
262 Context::create_context_from_event (SCM sev)
263 {
264   Stream_event *ev = unsmob_stream_event (sev);
265   
266   string id = ly_scm2string (ev->get_property ("id"));
267   SCM ops = ev->get_property ("ops");
268   SCM type_scm = ev->get_property ("type");
269   string type = ly_symbol2string (type_scm);
270   Object_key const *key = key_manager_.get_context_key (now_mom(), type, id);
271   
272   vector<Context_def*> path
273     = unsmob_context_def (definition_)->path_to_acceptable_context (type_scm, get_output_def ());
274   if (path.size () != 1)
275     {
276       programming_error (_f ("Invalid CreateContext event: Cannot create %s context", type.c_str ()));
277       return;
278     }
279   Context_def *cdef = path[0];
280   
281   Context *new_context = cdef->instantiate (ops, key);
282
283   new_context->id_string_ = id;
284   
285   /* Register various listeners:
286       - Make the new context hear events that universally affect contexts
287       - connect events_below etc. properly */
288   /* We want to be the first ones to hear our own events. Therefore, wait
289      before registering events_below_ */
290   new_context->event_source ()->
291     add_listener (GET_LISTENER (new_context->create_context_from_event),
292                   ly_symbol2scm ("CreateContext"));
293   new_context->event_source ()->
294     add_listener (GET_LISTENER (new_context->remove_context),
295                   ly_symbol2scm ("RemoveContext"));
296   new_context->event_source ()->
297     add_listener (GET_LISTENER (new_context->change_parent),
298                   ly_symbol2scm ("ChangeParent"));
299   new_context->event_source ()->
300     add_listener (GET_LISTENER (new_context->set_property_from_event),
301                   ly_symbol2scm ("SetProperty"));
302   new_context->event_source ()->
303     add_listener (GET_LISTENER (new_context->unset_property_from_event),
304                   ly_symbol2scm ("UnsetProperty"));
305
306   new_context->events_below_->register_as_listener (new_context->event_source_);
307   this->add_context (new_context);
308
309   new_context->unprotect ();
310
311   Context_def *td = unsmob_context_def (new_context->definition_);
312
313   /* This cannot move before add_context (), because \override
314      operations require that we are in the hierarchy.  */
315   td->apply_default_property_operations (new_context);
316   apply_property_operations (new_context, ops);
317
318   send_stream_event (this, "AnnounceNewContext", 0,
319                      ly_symbol2scm ("context"), new_context->self_scm (),
320                      ly_symbol2scm ("creator"), sev);
321 }
322
323 Context *
324 Context::create_context (Context_def *cdef,
325                          string id,
326                          SCM ops)
327 {
328   infant_event_ = 0;
329   /* TODO: This is fairly misplaced. We can fix this when we have taken out all
330      iterator specific stuff from the Context class */
331   event_source_->
332     add_listener (GET_LISTENER (acknowledge_infant),
333                   ly_symbol2scm ("AnnounceNewContext"));
334   /* The CreateContext creates a new context, and sends an announcement of the
335      new context through another event. That event will be stored in
336      infant_event_ to create a return value. */
337   send_stream_event (this, "CreateContext", 0,
338                      ly_symbol2scm ("ops"), ops,
339                      ly_symbol2scm ("type"), cdef->get_context_name (),
340                      ly_symbol2scm ("id"), scm_makfrom0str (id.c_str ()));
341   event_source_->
342     remove_listener (GET_LISTENER (acknowledge_infant),
343                      ly_symbol2scm ("AnnounceNewContext"));
344
345   assert (infant_event_);
346   SCM infant_scm = infant_event_->get_property ("context");
347   Context *infant = unsmob_context (infant_scm);
348
349   if (!infant || infant->get_parent_context () != this)
350     {
351       programming_error ("create_context: can't locate newly created context");
352       return 0;
353     }
354
355   return infant;
356 }
357
358 /*
359   Default child context as a SCM string, or something else if there is
360   none.
361 */
362 SCM
363 Context::default_child_context_name () const
364 {
365   return scm_is_pair (accepts_list_)
366     ? scm_car (accepts_list_)
367     : SCM_EOL;
368 }
369
370 bool
371 Context::is_bottom_context () const
372 {
373   return !scm_is_symbol (default_child_context_name ());
374 }
375
376 Context *
377 Context::get_default_interpreter ()
378 {
379   if (!is_bottom_context ())
380     {
381       SCM nm = default_child_context_name ();
382       SCM st = find_context_def (get_output_def (), nm);
383
384       string name = ly_symbol2string (nm);
385       Context_def *t = unsmob_context_def (st);
386       if (!t)
387         {
388           warning (_f ("can't find or create: `%s'", name.c_str ()));
389           t = unsmob_context_def (this->definition_);
390         }
391
392       Context *tg = create_context (t, "", SCM_EOL);
393       return tg->get_default_interpreter ();
394     }
395   return this;
396 }
397
398 /*
399   PROPERTIES
400 */
401 Context *
402 Context::where_defined (SCM sym, SCM *value) const
403 {
404 #ifndef NDEBUG
405   if (profile_property_accesses)
406     note_property_access (&context_property_lookup_table, sym);
407 #endif
408
409   if (properties_dict ()->try_retrieve (sym, value))
410     return (Context *)this;
411
412   return (daddy_context_) ? daddy_context_->where_defined (sym, value) : 0;
413 }
414
415 /*
416   return SCM_EOL when not found.
417 */
418 SCM
419 Context::internal_get_property (SCM sym) const
420 {
421 #ifndef NDEBUG
422   if (profile_property_accesses)
423     note_property_access (&context_property_lookup_table, sym);
424 #endif
425
426   SCM val = SCM_EOL;
427   if (properties_dict ()->try_retrieve (sym, &val))
428     return val;
429
430   if (daddy_context_)
431     return daddy_context_->internal_get_property (sym);
432
433   return val;
434 }
435
436 /*
437 Called by the send_stream_event macro. props is a 0-terminated array of
438 properties and corresponding values, interleaved. This method should not
439 be called from any other place than the send_stream_event macro.
440 */
441 void
442 Context::internal_send_stream_event (SCM type, Input *origin, SCM props[])
443 {
444   Stream_event *e = new Stream_event (type, origin);
445   for (int i = 0; props[i]; i += 2)
446     {
447       e->internal_set_property (props[i], props[i+1]);
448     }
449   event_source_->broadcast (e);
450   e->unprotect ();
451 }
452
453 bool
454 Context::is_alias (SCM sym) const
455 {
456   if (sym == ly_symbol2scm ("Bottom")
457       && !scm_is_pair (accepts_list_))
458     return true;
459   if (sym == unsmob_context_def (definition_)->get_context_name ())
460     return true;
461
462   return scm_c_memq (sym, aliases_) != SCM_BOOL_F;
463 }
464
465 void
466 Context::add_alias (SCM sym)
467 {
468   aliases_ = scm_cons (sym, aliases_);
469 }
470
471 void
472 Context::internal_set_property (SCM sym, SCM val)
473 {
474 #ifndef NDEBUG
475   if (do_internal_type_checking_global)
476     assert (type_check_assignment (sym, val, ly_symbol2scm ("translation-type?")));
477 #endif
478
479   properties_dict ()->set (sym, val);
480 }
481
482 /*
483   TODO: look up to check whether we have inherited var?
484 */
485 void
486 Context::unset_property (SCM sym)
487 {
488   properties_dict ()->remove (sym);
489 }
490
491 IMPLEMENT_LISTENER (Context, change_parent);
492 void
493 Context::change_parent (SCM sev)
494 {
495   Stream_event *ev = unsmob_stream_event (sev);
496   Context *to = unsmob_context (ev->get_property ("context"));
497
498   disconnect_from_parent ();
499   to->add_context (this);
500 }
501
502 /*
503   Die. The next GC sweep should take care of the actual death.
504  */
505 IMPLEMENT_LISTENER (Context, remove_context);
506 void
507 Context::remove_context (SCM)
508 {
509   /* ugh, the translator group should listen to RemoveContext events by itself */
510   implementation ()->disconnect_from_context ();
511   disconnect_from_parent ();
512 }
513
514 void
515 Context::disconnect_from_parent ()
516 {
517   daddy_context_->events_below_->unregister_as_listener (this->events_below_);
518   daddy_context_->context_list_ = scm_delq_x (this->self_scm (), daddy_context_->context_list_);
519   daddy_context_ = 0;
520 }
521
522 /*
523   ID == "" means accept any ID.
524 */
525 Context *
526 find_context_below (Context *where,
527                     SCM type, string id)
528 {
529   if (where->is_alias (type))
530     {
531       if (id == "" || where->id_string () == id)
532         return where;
533     }
534
535   Context *found = 0;
536   for (SCM s = where->children_contexts ();
537        !found && scm_is_pair (s); s = scm_cdr (s))
538     {
539       Context *tr = unsmob_context (scm_car (s));
540
541       found = find_context_below (tr, type, id);
542     }
543
544   return found;
545 }
546
547 SCM
548 Context::properties_as_alist () const
549 {
550   return properties_dict ()->to_alist ();
551 }
552
553 SCM
554 Context::context_name_symbol () const
555 {
556   Context_def *td = unsmob_context_def (definition_);
557   return td->get_context_name ();
558 }
559
560 string
561 Context::context_name () const
562 {
563   return ly_symbol2string (context_name_symbol ());
564 }
565
566 Context *
567 Context::get_score_context () const
568 {
569   if (daddy_context_)
570     return daddy_context_->get_score_context ();
571   else
572     return 0;
573 }
574
575 Output_def *
576 Context::get_output_def () const
577 {
578   return daddy_context_ ? daddy_context_->get_output_def () : 0;
579 }
580
581 Context::~Context ()
582 {
583 }
584
585 Moment
586 Context::now_mom () const
587 {
588   Context const *p = this;
589   while (p->daddy_context_)
590     p = p->daddy_context_;
591
592   return p->now_mom ();
593 }
594
595 int
596 Context::print_smob (SCM s, SCM port, scm_print_state *)
597 {
598   Context *sc = (Context *) SCM_CELL_WORD_1 (s);
599
600   scm_puts ("#<", port);
601   scm_puts (sc->class_name (), port);
602   if (Context_def *d = unsmob_context_def (sc->definition_))
603     {
604       scm_puts (" ", port);
605       scm_display (d->get_context_name (), port);
606     }
607
608   if (!sc->id_string_.empty ())
609     {
610       scm_puts ("=", port);
611       scm_puts (sc->id_string_.c_str (), port);
612     }
613
614   scm_puts (" ", port);
615
616   scm_display (sc->context_list_, port);
617   scm_puts (" >", port);
618
619   return 1;
620 }
621
622 Object_key const *
623 Context::get_grob_key (string name)
624 {
625   return key_manager_.get_grob_key (now_mom (), name);
626 }
627
628 Object_key const *
629 Context::get_context_key (string name, string id)
630 {
631   return key_manager_.get_context_key (now_mom (), name, id);
632 }
633
634 SCM
635 Context::mark_smob (SCM sm)
636 {
637   Context *me = (Context *) SCM_CELL_WORD_1 (sm);
638   me->key_manager_.gc_mark();
639
640   scm_gc_mark (me->context_list_);
641   scm_gc_mark (me->aliases_);
642   scm_gc_mark (me->definition_);
643   scm_gc_mark (me->definition_mods_);
644   scm_gc_mark (me->properties_scm_);
645   scm_gc_mark (me->accepts_list_);
646   if (me->implementation_)
647     scm_gc_mark (me->implementation_->self_scm ());
648   if (me->event_source_) scm_gc_mark (me->event_source_->self_scm ());
649   if (me->events_below_) scm_gc_mark (me->events_below_->self_scm ());
650
651   return me->properties_scm_;
652 }
653
654 IMPLEMENT_SMOBS (Context);
655 IMPLEMENT_DEFAULT_EQUAL_P (Context);
656 IMPLEMENT_TYPE_P (Context, "ly:context?");
657
658 bool
659 Context::try_music (Music *m)
660 {
661   Translator_group *t = implementation ();
662   if (!t)
663     return false;
664
665   bool b = t->try_music (m);
666   if (!b && daddy_context_)
667     b = daddy_context_->try_music (m);
668
669   return b;
670 }
671
672 Global_context *
673 Context::get_global_context () const
674 {
675   if (dynamic_cast<Global_context *> ((Context *) this))
676     return dynamic_cast<Global_context *> ((Context *) this);
677
678   if (daddy_context_)
679     return daddy_context_->get_global_context ();
680
681   programming_error ("no Global context");
682   return 0;
683 }
684
685 Context *
686 Context::get_parent_context () const
687 {
688   return daddy_context_;
689 }
690
691 void
692 Context::clear_key_disambiguations ()
693 {
694   if (!use_object_keys)
695     return;
696
697   key_manager_.clear ();
698   for (SCM s = context_list_; scm_is_pair (s); s = scm_cdr (s))
699     unsmob_context (scm_car (s))->clear_key_disambiguations ();
700 }
701
702 /*
703   Ugh. Where to put this?
704 */
705 Rational
706 measure_length (Context const *context)
707 {
708   SCM l = context->get_property ("measureLength");
709   Rational length (1);
710   if (unsmob_moment (l))
711     length = unsmob_moment (l)->main_part_;
712   return length;
713 }
714
715 Moment
716 measure_position (Context const *context)
717 {
718   SCM sm = context->get_property ("measurePosition");
719
720   Moment m = 0;
721   if (unsmob_moment (sm))
722     {
723       m = *unsmob_moment (sm);
724
725       if (m.main_part_ < Rational (0))
726         {
727           Rational length (measure_length (context));
728           while (m.main_part_ < Rational (0))
729             m.main_part_ += length;
730         }
731     }
732
733   return m;
734 }
735
736
737 void
738 set_context_property_on_children (Context *trans, SCM sym, SCM val)
739 {
740   trans->internal_set_property (sym, ly_deep_copy (val));
741   for (SCM p = trans->children_contexts (); scm_is_pair (p); p = scm_cdr (p))
742     {
743       Context *trg = unsmob_context (scm_car (p));
744       set_context_property_on_children (trg, sym, ly_deep_copy (val));
745     }
746 }
747
748 bool
749 melisma_busy (Context *tr)
750 {
751   SCM melisma_properties = tr->get_property ("melismaBusyProperties");
752   bool busy = false;
753
754   for (; scm_is_pair (melisma_properties);
755        melisma_properties = scm_cdr (melisma_properties))
756     busy = busy || to_boolean (tr->internal_get_property (scm_car (melisma_properties)));
757
758   return busy;
759 }