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