lily/context.cc

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