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 "international.hh"
  13 #include "ly-smobs.icc"
  14 #include "main.hh"
  15 #include "output-def.hh"
  16 #include "profile.hh"
  17 #include "program-option.hh"
  18 #include "scm-hash.hh"
  19 #include "score-context.hh"
  20 #include "translator-group.hh"
  21 #include "warn.hh"
  22
  23 bool
  24 Context::is_removable () const
  25 {
  26   return context_list_ == SCM_EOL && ! iterator_count_
  27     && !dynamic_cast<Score_context const *> (this);
  28 }
  29
  30 void
  31 Context::check_removal ()
  32 {
  33   for (SCM p = context_list_; scm_is_pair (p); p = scm_cdr (p))
  34     {
  35       Context *trg = unsmob_context (scm_car (p));
  36
  37       trg->check_removal ();
  38       if (trg->is_removable ())
  39         {
  40           recurse_over_translators (trg, &Translator::finalize,
  41                                     &Translator_group::finalize,
  42                                     UP);
  43           remove_context (trg);
  44         }
  45     }
  46 }
  47
  48 Context::Context (Context const &src)
  49   : key_manager_ (src.key_manager_)
  50 {
  51   assert (false);
  52 }
  53
  54 Scheme_hash_table *
  55 Context::properties_dict () const
  56 {
  57   return Scheme_hash_table::unsmob (properties_scm_);
  58 }
  59
  60 void
  61 Context::add_context (Context *t)
  62 {
  63   SCM ts = t->self_scm ();
  64   context_list_ = ly_append2 (context_list_,
  65                               scm_cons (ts, SCM_EOL));
  66
  67   t->daddy_context_ = this;
  68   if (!t->init_)
  69     {
  70       t->init_ = true;
  71
  72       t->unprotect ();
  73       Context_def *td = unsmob_context_def (t->definition_);
  74
  75       /* This cannot move before add_context (), because \override
  76          operations require that we are in the hierarchy.  */
  77       td->apply_default_property_operations (t);
  78
  79       recurse_over_translators (t,
  80                                 &Translator::initialize,
  81                                 &Translator_group::initialize,
  82                                 DOWN);
  83     }
  84 }
  85
  86
  87 Context::Context (Object_key const *key)
  88   : key_manager_ (key)
  89 {
  90   daddy_context_ = 0;
  91   init_ = false;
  92   aliases_ = SCM_EOL;
  93   iterator_count_ = 0;
  94   implementation_ = 0;
  95   properties_scm_ = SCM_EOL;
  96   accepts_list_ = SCM_EOL;
  97   context_list_ = SCM_EOL;
  98   definition_ = SCM_EOL;
  99
 100   smobify_self ();
 101
 102   Scheme_hash_table *tab = new Scheme_hash_table;
 103   properties_scm_ = tab->unprotect ();
 104
 105   /*
 106     UGH UGH
 107     const correctness.
 108   */
 109   key_manager_.unprotect();
 110 }
 111
 112 /* TODO:  this shares code with find_create_context ().  */
 113 Context *
 114 Context::create_unique_context (SCM name, string id, SCM operations)
 115 {
 116   /*
 117     Don't create multiple score contexts.
 118   */
 119   if (dynamic_cast<Global_context *> (this)
 120       && dynamic_cast<Global_context *> (this)->get_score_context ())
 121     return get_score_context ()->create_unique_context (name, id, operations);
 122
 123   /*
 124     TODO: use accepts_list_.
 125   */
 126   vector<Context_def*> path
 127     = unsmob_context_def (definition_)->path_to_acceptable_context (name, get_output_def ());
 128
 129   if (path.size ())
 130     {
 131       Context *current = this;
 132
 133       // start at 1.  The first one (index 0) will be us.
 134       for (vsize i = 0; i < path.size (); i++)
 135         {
 136           SCM ops = SCM_EOL;
 137           string id_str = "\\new";
 138           if (i == path.size () - 1)
 139             {
 140               ops = operations;
 141               id_str = id;
 142             }
 143           current = current->create_context (path[i],
 144                                              id_str,
 145                                              ops);
 146         }
 147
 148       return current;
 149     }
 150
 151   /*
 152     Don't go up to Global_context, because global goes down to
 153     Score_context
 154   */
 155   Context *ret = 0;
 156   if (daddy_context_ && !dynamic_cast<Global_context *> (daddy_context_))
 157     ret = daddy_context_->create_unique_context (name, id, operations);
 158   else
 159     {
 160       warning (_f ("can't find or create new `%s'",
 161                    ly_symbol2string (name).c_str ()));
 162       ret = 0;
 163     }
 164   return ret;
 165 }
 166
 167 Context *
 168 Context::find_create_context (SCM n, string id, SCM operations)
 169 {
 170   /*
 171     Don't create multiple score contexts.
 172   */
 173   if (dynamic_cast<Global_context *> (this)
 174       && dynamic_cast<Global_context *> (this)->get_score_context ())
 175     return get_score_context ()->find_create_context (n, id, operations);
 176
 177   if (Context *existing = find_context_below (this, n, id))
 178     return existing;
 179
 180   if (n == ly_symbol2scm ("Bottom"))
 181     {
 182       Context *tg = get_default_interpreter ();
 183       return tg;
 184     }
 185
 186   /*
 187     TODO: use accepts_list_.
 188   */
 189   vector<Context_def*> path
 190     = unsmob_context_def (definition_)->path_to_acceptable_context (n, get_output_def ());
 191
 192   if (path.size ())
 193     {
 194       Context *current = this;
 195
 196       // start at 1.  The first one (index 0) will be us.
 197       for (vsize i = 0; i < path.size (); i++)
 198         {
 199           SCM ops = (i == path.size () -1) ? operations : SCM_EOL;
 200
 201           string this_id = "";
 202           if (i == path.size () -1)
 203             this_id = id;
 204
 205           current = current->create_context (path[i],
 206                                              this_id,
 207                                              ops);
 208         }
 209
 210       return current;
 211     }
 212
 213   /*
 214     Don't go up to Global_context, because global goes down to
 215     Score_context
 216   */
 217   Context *ret = 0;
 218   if (daddy_context_ && !dynamic_cast<Global_context *> (daddy_context_))
 219     ret = daddy_context_->find_create_context (n, id, operations);
 220   else
 221     {
 222       warning (_f ("can't find or create `%s' called `%s'",
 223                    ly_symbol2string (n).c_str (), id));
 224       ret = 0;
 225     }
 226   return ret;
 227 }
 228
 229 Context *
 230 Context::create_context (Context_def *cdef,
 231                          string id,
 232                          SCM ops)
 233 {
 234   string type = ly_symbol2string (cdef->get_context_name ());
 235   Object_key const *key = key_manager_.get_context_key (now_mom(), type, id);
 236   Context *new_context
 237     = cdef->instantiate (ops, key);
 238
 239   new_context->id_string_ = id;
 240   add_context (new_context);
 241   apply_property_operations (new_context, ops);
 242
 243   return new_context;
 244 }
 245
 246 /*
 247   Default child context as a SCM string, or something else if there is
 248   none.
 249 */
 250 SCM
 251 Context::default_child_context_name () const
 252 {
 253   return scm_is_pair (accepts_list_)
 254     ? scm_car (accepts_list_)
 255     : SCM_EOL;
 256 }
 257
 258 bool
 259 Context::is_bottom_context () const
 260 {
 261   return !scm_is_symbol (default_child_context_name ());
 262 }
 263
 264 Context *
 265 Context::get_default_interpreter ()
 266 {
 267   if (!is_bottom_context ())
 268     {
 269       SCM nm = default_child_context_name ();
 270       SCM st = find_context_def (get_output_def (), nm);
 271
 272       string name = ly_symbol2string (nm);
 273       Context_def *t = unsmob_context_def (st);
 274       if (!t)
 275         {
 276           warning (_f ("can't find or create: `%s'", name.c_str ()));
 277           t = unsmob_context_def (this->definition_);
 278         }
 279
 280       Context *tg = create_context (t, "", SCM_EOL);
 281       if (!tg->is_bottom_context ())
 282         return tg->get_default_interpreter ();
 283       else
 284         return tg;
 285     }
 286   return this;
 287 }
 288
 289 /*
 290   PROPERTIES
 291 */
 292 Context *
 293 Context::where_defined (SCM sym, SCM *value) const
 294 {
 295 #ifndef NDEBUG
 296   if (profile_property_accesses)
 297     note_property_access (&context_property_lookup_table, sym);
 298 #endif
 299
 300   if (properties_dict ()->try_retrieve (sym, value))
 301     return (Context *)this;
 302
 303   return (daddy_context_) ? daddy_context_->where_defined (sym, value) : 0;
 304 }
 305
 306 /*
 307   return SCM_EOL when not found.
 308 */
 309 SCM
 310 Context::internal_get_property (SCM sym) const
 311 {
 312 #ifndef NDEBUG
 313   if (profile_property_accesses)
 314     note_property_access (&context_property_lookup_table, sym);
 315 #endif
 316
 317   SCM val = SCM_EOL;
 318   if (properties_dict ()->try_retrieve (sym, &val))
 319     return val;
 320
 321   if (daddy_context_)
 322     return daddy_context_->internal_get_property (sym);
 323
 324   return val;
 325 }
 326
 327 bool
 328 Context::is_alias (SCM sym) const
 329 {
 330   if (sym == ly_symbol2scm ("Bottom")
 331       && !scm_is_pair (accepts_list_))
 332     return true;
 333   if (sym == unsmob_context_def (definition_)->get_context_name ())
 334     return true;
 335
 336   return scm_c_memq (sym, aliases_) != SCM_BOOL_F;
 337 }
 338
 339 void
 340 Context::add_alias (SCM sym)
 341 {
 342   aliases_ = scm_cons (sym, aliases_);
 343 }
 344
 345 void
 346 Context::internal_set_property (SCM sym, SCM val)
 347 {
 348 #ifndef NDEBUG
 349   if (do_internal_type_checking_global)
 350     assert (type_check_assignment (sym, val, ly_symbol2scm ("translation-type?")));
 351 #endif
 352
 353   properties_dict ()->set (sym, val);
 354 }
 355
 356 /*
 357   TODO: look up to check whether we have inherited var?
 358 */
 359 void
 360 Context::unset_property (SCM sym)
 361 {
 362   properties_dict ()->remove (sym);
 363 }
 364
 365 /**
 366    Remove a context from the hierarchy.
 367 */
 368 Context *
 369 Context::remove_context (Context *trans)
 370 {
 371   assert (trans);
 372
 373   context_list_ = scm_delq_x (trans->self_scm (), context_list_);
 374   trans->daddy_context_ = 0;
 375   return trans;
 376 }
 377
 378 /*
 379   ID == "" means accept any ID.
 380 */
 381 Context *
 382 find_context_below (Context *where,
 383                     SCM type, string id)
 384 {
 385   if (where->is_alias (type))
 386     {
 387       if (id == "" || where->id_string () == id)
 388         return where;
 389     }
 390
 391   Context *found = 0;
 392   for (SCM s = where->children_contexts ();
 393        !found && scm_is_pair (s); s = scm_cdr (s))
 394     {
 395       Context *tr = unsmob_context (scm_car (s));
 396
 397       found = find_context_below (tr, type, id);
 398     }
 399
 400   return found;
 401 }
 402
 403 SCM
 404 Context::properties_as_alist () const
 405 {
 406   return properties_dict ()->to_alist ();
 407 }
 408
 409 SCM
 410 Context::context_name_symbol () const
 411 {
 412   Context_def *td = unsmob_context_def (definition_);
 413   return td->get_context_name ();
 414 }
 415
 416 string
 417 Context::context_name () const
 418 {
 419   return ly_symbol2string (context_name_symbol ());
 420 }
 421
 422 Score_context *
 423 Context::get_score_context () const
 424 {
 425   if (Score_context *sc = dynamic_cast<Score_context *> ((Context *) this))
 426     return sc;
 427   else if (daddy_context_)
 428     return daddy_context_->get_score_context ();
 429   else
 430     return 0;
 431 }
 432
 433 Output_def *
 434 Context::get_output_def () const
 435 {
 436   return daddy_context_ ? daddy_context_->get_output_def () : 0;
 437 }
 438
 439 Context::~Context ()
 440 {
 441 }
 442
 443 Moment
 444 Context::now_mom () const
 445 {
 446   Context const *p = this;
 447   while (p->daddy_context_)
 448     p = p->daddy_context_;
 449
 450   return p->now_mom ();
 451 }
 452
 453 int
 454 Context::print_smob (SCM s, SCM port, scm_print_state *)
 455 {
 456   Context *sc = (Context *) SCM_CELL_WORD_1 (s);
 457
 458   scm_puts ("#<", port);
 459   scm_puts (sc->class_name (), port);
 460   if (Context_def *d = unsmob_context_def (sc->definition_))
 461     {
 462       scm_puts (" ", port);
 463       scm_display (d->get_context_name (), port);
 464     }
 465
 466   if (!sc->id_string_.empty ())
 467     {
 468       scm_puts ("=", port);
 469       scm_puts (sc->id_string_.c_str (), port);
 470     }
 471
 472   scm_puts (" ", port);
 473
 474   scm_display (sc->context_list_, port);
 475   scm_puts (" >", port);
 476
 477   return 1;
 478 }
 479
 480 Object_key const *
 481 Context::get_grob_key (string name)
 482 {
 483   return key_manager_.get_grob_key (now_mom (), name);
 484 }
 485
 486 Object_key const *
 487 Context::get_context_key (string name, string id)
 488 {
 489   return key_manager_.get_context_key (now_mom (), name, id);
 490 }
 491
 492 SCM
 493 Context::mark_smob (SCM sm)
 494 {
 495   Context *me = (Context *) SCM_CELL_WORD_1 (sm);
 496   me->key_manager_.gc_mark();
 497
 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   if (me->implementation_)
 504     scm_gc_mark (me->implementation_->self_scm ());
 505
 506   return me->properties_scm_;
 507 }
 508
 509 IMPLEMENT_SMOBS (Context);
 510 IMPLEMENT_DEFAULT_EQUAL_P (Context);
 511 IMPLEMENT_TYPE_P (Context, "ly:context?");
 512
 513 bool
 514 Context::try_music (Music *m)
 515 {
 516   Translator_group *t = implementation ();
 517   if (!t)
 518     return false;
 519
 520   bool b = t->try_music (m);
 521   if (!b && daddy_context_)
 522     b = daddy_context_->try_music (m);
 523
 524   return b;
 525 }
 526
 527 Global_context *
 528 Context::get_global_context () const
 529 {
 530   if (dynamic_cast<Global_context *> ((Context *) this))
 531     return dynamic_cast<Global_context *> ((Context *) this);
 532
 533   if (daddy_context_)
 534     return daddy_context_->get_global_context ();
 535
 536   programming_error ("no Global context");
 537   return 0;
 538 }
 539
 540 Context *
 541 Context::get_parent_context () const
 542 {
 543   return daddy_context_;
 544 }
 545
 546 void
 547 Context::clear_key_disambiguations ()
 548 {
 549   if (!use_object_keys)
 550     return;
 551
 552   key_manager_.clear ();
 553   for (SCM s = context_list_; scm_is_pair (s); s = scm_cdr (s))
 554     unsmob_context (scm_car (s))->clear_key_disambiguations ();
 555 }
 556
 557 /*
 558   Ugh. Where to put this?
 559 */
 560 Rational
 561 measure_length (Context const *context)
 562 {
 563   SCM l = context->get_property ("measureLength");
 564   Rational length (1);
 565   if (unsmob_moment (l))
 566     length = unsmob_moment (l)->main_part_;
 567   return length;
 568 }
 569
 570 Moment
 571 measure_position (Context const *context)
 572 {
 573   SCM sm = context->get_property ("measurePosition");
 574
 575   Moment m = 0;
 576   if (unsmob_moment (sm))
 577     {
 578       m = *unsmob_moment (sm);
 579
 580       if (m.main_part_ < Rational (0))
 581         {
 582           Rational length (measure_length (context));
 583           while (m.main_part_ < Rational (0))
 584             m.main_part_ += length;
 585         }
 586     }
 587
 588   return m;
 589 }
 590
 591
 592 void
 593 set_context_property_on_children (Context *trans, SCM sym, SCM val)
 594 {
 595   trans->internal_set_property (sym, ly_deep_copy (val));
 596   for (SCM p = trans->children_contexts (); scm_is_pair (p); p = scm_cdr (p))
 597     {
 598       Context *trg = unsmob_context (scm_car (p));
 599       set_context_property_on_children (trg, sym, ly_deep_copy (val));
 600     }
 601 }