lily/grob.cc

   1 /*
   2   grob.cc -- implement Grob
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 */
   8
   9
  10 #include <string.h>
  11 #include <math.h>
  12
  13 #include "main.hh"
  14 #include "input-smob.hh"
  15
  16 #include "group-interface.hh"
  17 #include "misc.hh"
  18 #include "paper-score.hh"
  19 #include "paper-def.hh"
  20 #include "molecule.hh"
  21 #include "grob.hh"
  22 #include "debug.hh"
  23 #include "spanner.hh"
  24 #include "system.hh"
  25 #include "item.hh"
  26 #include "paper-column.hh"
  27 #include "molecule.hh"
  28 #include "misc.hh"
  29 #include "paper-outputter.hh"
  30 #include "music.hh"
  31 #include "item.hh"
  32
  33 #include "ly-smobs.icc"
  34
  35 /*
  36 TODO:
  37
  38 remove dynamic_cast<Spanner,Item> and put this code into respective
  39   subclass.
  40 */
  41
  42
  43 #define INFINITY_MSG "Infinity or NaN encountered"
  44
  45 Grob::Grob (SCM basicprops)
  46 {
  47   /*
  48     fixme: default should be no callback.
  49    */
  50
  51   pscore_l_=0;
  52   status_c_ = 0;
  53   original_l_ = 0;
  54   immutable_property_alist_ =  basicprops;
  55   mutable_property_alist_ = SCM_EOL;
  56
  57   /*
  58     We do smobify_self() as the first step. Since the object lives on
  59     the heap, none of its SCM variables are protected from GC. After
  60     smobify_self(), they are.
  61    */
  62   smobify_self ();
  63
  64
  65   SCM meta = get_grob_property ("meta");
  66   if (gh_pair_p (meta))
  67     {
  68       SCM ifs = scm_assoc (ly_symbol2scm ("interfaces"), meta);
  69
  70       /*
  71         do it directly to bypass interface checks.
  72        */
  73       mutable_property_alist_ = gh_cons (gh_cons (ly_symbol2scm ("interfaces"),
  74                                                   gh_cdr (ifs)),
  75                                          mutable_property_alist_);
  76     }
  77
  78   /*
  79     TODO:
  80
  81     destill this into a function, so we can re-init the immutable
  82     properties with a new BASICPROPS value after creation. Convenient
  83     eg. when using \override with StaffSymbol.  */
  84
  85   char const*onames[] = {"X-offset-callbacks", "Y-offset-callbacks"};
  86   char const*enames[] = {"X-extent-callback", "Y-extent-callback"};
  87
  88   for (int a = X_AXIS; a <= Y_AXIS; a++)
  89     {
  90       SCM l = get_grob_property (onames[a]);
  91
  92       if (scm_ilength (l) >=0)
  93         {
  94           dim_cache_[a].offset_callbacks_ = l;
  95           dim_cache_[a].offsets_left_ = scm_ilength (l);
  96         }
  97       else
  98         {
  99           programming_error ("[XY]-offset-callbacks must be a list");
 100         }
 101
 102       SCM cb = get_grob_property (enames[a]);
 103
 104       /*
 105         Should change default to be empty?
 106       */
 107       if (cb != SCM_BOOL_F
 108           && !gh_procedure_p (cb) && !gh_pair_p (cb)
 109           && gh_procedure_p (get_grob_property ("molecule-callback"))
 110           )
 111         cb = molecule_extent_proc;
 112
 113       dim_cache_[a].dimension_ = cb;
 114     }
 115
 116 }
 117
 118 Grob::Grob (Grob const&s)
 119    : dim_cache_ (s.dim_cache_)
 120 {
 121   original_l_ = (Grob*) &s;
 122   immutable_property_alist_ = s.immutable_property_alist_;
 123   mutable_property_alist_ = SCM_EOL;
 124
 125   /*
 126     No properties are copied. That is the job of handle_broken_dependencies.
 127    */
 128
 129   status_c_ = s.status_c_;
 130   pscore_l_ = s.pscore_l_;
 131
 132   smobify_self ();
 133
 134
 135 }
 136
 137 Grob::~Grob ()
 138 {
 139   /*
 140     do nothing scm-ish and no unprotecting here.
 141    */
 142 }
 143
 144
 145
 146 extern void check_interfaces_for_property (Grob const *me, SCM sym);
 147
 148 void
 149 Grob::internal_set_grob_property (SCM s, SCM v)
 150 {
 151 #ifndef NDEBUG
 152   if (internal_type_checking_global_b)
 153     {
 154       assert (type_check_assignment (s, v, ly_symbol2scm ("backend-type?")));
 155       check_interfaces_for_property(this, s);
 156     }
 157 #endif
 158
 159
 160   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v);
 161 }
 162
 163
 164 SCM
 165 Grob::internal_get_grob_property (SCM sym) const
 166 {
 167   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 168   if (s != SCM_BOOL_F)
 169     return ly_cdr (s);
 170
 171   s = scm_sloppy_assq (sym, immutable_property_alist_);
 172
 173 #ifndef NDEBUG
 174   if (internal_type_checking_global_b && gh_pair_p (s))
 175     {
 176       assert (type_check_assignment (sym, gh_cdr (s), ly_symbol2scm ("backend-type?")));
 177       check_interfaces_for_property(this, sym);
 178     }
 179 #endif
 180
 181   return (s == SCM_BOOL_F) ? SCM_EOL : ly_cdr (s);
 182 }
 183
 184 /*
 185   Remove the value associated with KEY, and return it. The result is
 186   that a next call will yield SCM_EOL (and not the underlying
 187   `basic' property.
 188 */
 189 SCM
 190 Grob::remove_grob_property (const char* key)
 191 {
 192   SCM val = get_grob_property (key);
 193   if (val != SCM_EOL)
 194     set_grob_property (key, SCM_EOL);
 195   return val;
 196 }
 197
 198
 199
 200 MAKE_SCHEME_CALLBACK (Grob,molecule_extent,2);
 201 SCM
 202 Grob::molecule_extent (SCM element_smob, SCM scm_axis)
 203 {
 204   Grob *s = unsmob_grob (element_smob);
 205   Axis a = (Axis) gh_scm2int (scm_axis);
 206
 207   Molecule *m = s->get_molecule ();
 208   Interval e ;
 209   if (m)
 210     e = m->extent (a);
 211   return ly_interval2scm (e);
 212 }
 213
 214 MAKE_SCHEME_CALLBACK (Grob,preset_extent,2);
 215
 216 SCM
 217 Grob::preset_extent (SCM element_smob, SCM scm_axis)
 218 {
 219   Grob *s = unsmob_grob (element_smob);
 220   Axis a = (Axis) gh_scm2int (scm_axis);
 221
 222   SCM ext = s->get_grob_property ((a == X_AXIS)
 223                                  ? "extent-X"
 224                                  : "extent-Y");
 225
 226   if (gh_pair_p (ext))
 227     {
 228       Real l = gh_scm2double (ly_car (ext));
 229       Real r = gh_scm2double (ly_cdr (ext));
 230       return ly_interval2scm (Interval (l, r));
 231     }
 232
 233   return ly_interval2scm (Interval ());
 234 }
 235
 236
 237
 238 Paper_def*
 239 Grob::paper_l ()  const
 240 {
 241  return pscore_l_ ? pscore_l_->paper_l_ : 0;
 242 }
 243
 244 void
 245 Grob::calculate_dependencies (int final, int busy, SCM funcname)
 246 {
 247   if (status_c_ >= final)
 248     return;
 249
 250   if (status_c_== busy)
 251     {
 252       programming_error ("Element is busy, come back later");
 253       return;
 254     }
 255
 256   status_c_= busy;
 257
 258   for (SCM d = get_grob_property ("dependencies"); gh_pair_p (d);
 259        d = ly_cdr (d))
 260     {
 261       unsmob_grob (ly_car (d))
 262         ->calculate_dependencies (final, busy, funcname);
 263     }
 264
 265
 266   SCM proc = internal_get_grob_property (funcname);
 267   if (gh_procedure_p (proc))
 268     gh_call1 (proc, this->self_scm ());
 269
 270   status_c_= final;
 271 }
 272
 273 Molecule *
 274 Grob::get_molecule ()  const
 275 {
 276   if (immutable_property_alist_ == SCM_EOL)
 277     {
 278       return 0;
 279
 280     }
 281
 282   SCM mol = get_grob_property ("molecule");
 283   if (unsmob_molecule (mol))
 284     return unsmob_molecule (mol);
 285
 286   mol =  get_uncached_molecule ();
 287
 288   Grob *me = (Grob*)this;
 289   me->set_grob_property ("molecule", mol);
 290
 291   return unsmob_molecule (mol);
 292 }
 293 SCM
 294 Grob::get_uncached_molecule ()const
 295 {
 296   SCM proc = get_grob_property ("molecule-callback");
 297
 298   SCM  mol = SCM_EOL;
 299   if (gh_procedure_p (proc))
 300     mol = gh_apply (proc, scm_list_n (this->self_scm (), SCM_UNDEFINED));
 301
 302
 303   Molecule *m = unsmob_molecule (mol);
 304
 305   if (unsmob_molecule (mol))
 306     {
 307       SCM origin = ly_symbol2scm ("no-origin");
 308
 309       if (store_locations_global_b){
 310         SCM cause = get_grob_property ("cause");
 311         if (Music*m = unsmob_music (cause))
 312           {
 313             SCM music_origin = m->get_mus_property ("origin");
 314             if (unsmob_input (music_origin))
 315               origin = music_origin;
 316           }
 317       }
 318
 319       // ugr.
 320
 321       mol = Molecule (m->extent_box (),
 322                       scm_list_n (origin, m->get_expr (), SCM_UNDEFINED)
 323                       ). smobbed_copy ();
 324
 325       m = unsmob_molecule (mol);
 326     }
 327
 328   /*
 329     transparent retains dimensions of element.
 330    */
 331   if (m && to_boolean (get_grob_property ("transparent")))
 332     mol = Molecule (m->extent_box (), SCM_EOL).smobbed_copy ();
 333
 334   return mol;
 335 }
 336
 337 /*
 338
 339   VIRTUAL STUBS
 340
 341  */
 342 void
 343 Grob::do_break_processing ()
 344 {
 345 }
 346
 347
 348
 349
 350
 351
 352 System *
 353 Grob::line_l () const
 354 {
 355   return 0;
 356 }
 357
 358 void
 359 Grob::add_dependency (Grob*e)
 360 {
 361   if (e)
 362     {
 363       Pointer_group_interface::add_grob (this, ly_symbol2scm ("dependencies"),e);
 364     }
 365   else
 366     programming_error ("Null dependency added");
 367 }
 368
 369
 370
 371
 372 /**
 373       Do break substitution in S, using CRITERION. Return new value.
 374       CRITERION is either a SMOB pointer to the desired line, or a number
 375       representing the break direction. Do not modify SRC.
 376
 377       It is rather tightly coded, since it takes a lot of time; it is
 378       one of the top functions in the profile.
 379
 380       We don't pass break_criterion as a parameter, since it is
 381       `constant', but takes up stack space.
 382
 383 */
 384
 385
 386 static SCM break_criterion;
 387 void
 388 set_break_subsititution (SCM criterion)
 389 {
 390   break_criterion = criterion;
 391 }
 392
 393
 394 /*
 395   TODO: check wether we can do this in-place; now we generate a lot of
 396   garbage.
 397  */
 398 SCM
 399 do_break_substitution (SCM src)
 400 {
 401  again:
 402
 403   if (Grob *sc = unsmob_grob (src))
 404     {
 405       if (SCM_INUMP (break_criterion))
 406         {
 407           Item * i = dynamic_cast<Item*> (sc);
 408           Direction d = to_dir (break_criterion);
 409           if (i && i->break_status_dir () != d)
 410             {
 411               Item *br = i->find_prebroken_piece (d);
 412               return (br) ? br->self_scm () : SCM_UNDEFINED;
 413             }
 414         }
 415       else
 416         {
 417           System * line
 418             = dynamic_cast<System*> (unsmob_grob (break_criterion));
 419           if (sc->line_l () != line)
 420             {
 421               sc = sc->find_broken_piece (line);
 422
 423             }
 424
 425           /* now: !sc || (sc && sc->line_l () == line) */
 426           if (!sc)
 427             return SCM_UNDEFINED;
 428
 429           /* now: sc && sc->line_l () == line */
 430           if (!line)
 431             return sc->self_scm();
 432           /*
 433             This was introduced in 1.3.49 as a measure to prevent
 434             programming errors. It looks expensive (?).
 435
 436             TODO:
 437
 438             benchmark , document when (what kind of programming
 439             errors) this happens.
 440           */
 441           if (sc->common_refpoint (line, X_AXIS)
 442                && sc->common_refpoint (line, Y_AXIS))
 443             {
 444               return sc->self_scm ();
 445             }
 446           return SCM_UNDEFINED;
 447         }
 448     }
 449   else if (ly_pair_p (src))
 450     {
 451       /*
 452         UGH! breaks on circular lists.
 453       */
 454       SCM newcar = do_break_substitution (ly_car (src));
 455       SCM oldcdr = ly_cdr (src);
 456
 457       if (newcar == SCM_UNDEFINED
 458           && (gh_pair_p (oldcdr) || oldcdr == SCM_EOL))
 459         {
 460           /*
 461             This is tail-recursion, ie.
 462
 463             return do_break_substution (cdr);
 464
 465             We don't want to rely on the compiler to do this.  Without
 466             tail-recursion, this easily crashes with a stack overflow.  */
 467           src =  oldcdr;
 468           goto again;
 469         }
 470
 471       return scm_cons (newcar, do_break_substitution (oldcdr));
 472     }
 473   else
 474     return src;
 475
 476   return src;
 477 }
 478
 479 void
 480 Grob::handle_broken_dependencies ()
 481 {
 482   Spanner * s= dynamic_cast<Spanner*> (this);
 483   if (original_l_ && s)
 484     return;
 485
 486   if (s)
 487     {
 488       for (int i = 0;  i< s->broken_into_l_arr_ .size (); i++)
 489         {
 490           Grob * sc = s->broken_into_l_arr_[i];
 491           System * l = sc->line_l ();
 492
 493           set_break_subsititution (l ? l->self_scm () : SCM_UNDEFINED);
 494           sc->mutable_property_alist_ =
 495             do_break_substitution (mutable_property_alist_);
 496
 497         }
 498     }
 499
 500
 501   System *line = line_l ();
 502
 503   if (line && common_refpoint (line, X_AXIS) && common_refpoint (line, Y_AXIS))
 504     {
 505       set_break_subsititution (line ? line->self_scm () : SCM_UNDEFINED);
 506       mutable_property_alist_ = do_break_substitution (mutable_property_alist_);
 507     }
 508   else if (dynamic_cast <System*> (this))
 509     {
 510       set_break_subsititution (SCM_UNDEFINED);
 511       mutable_property_alist_ = do_break_substitution (mutable_property_alist_);
 512     }
 513   else
 514     {
 515       /*
 516         This element is `invalid'; it has been removed from all
 517         dependencies, so let's junk the element itself.
 518
 519         do not do this for System, since that would remove
 520         references to the originals of score-grobs, which get then GC'd
 521  (a bad thing.)
 522       */
 523       suicide ();
 524     }
 525 }
 526
 527 /*
 528  Note that we still want references to this element to be
 529  rearranged, and not silently thrown away, so we keep pointers
 530  like {broken_into_{drul,array}, original}
 531 */
 532 void
 533 Grob::suicide ()
 534 {
 535   mutable_property_alist_ = SCM_EOL;
 536   immutable_property_alist_ = SCM_EOL;
 537
 538   set_extent (SCM_EOL, Y_AXIS);
 539   set_extent (SCM_EOL, X_AXIS);
 540
 541   for (int a= X_AXIS; a <= Y_AXIS; a++)
 542     {
 543       dim_cache_[a].offset_callbacks_ = SCM_EOL;
 544       dim_cache_[a].offsets_left_ = 0;
 545     }
 546 }
 547
 548 void
 549 Grob::handle_prebroken_dependencies ()
 550 {
 551 }
 552
 553 Grob*
 554 Grob::find_broken_piece (System*) const
 555 {
 556   return 0;
 557 }
 558
 559 /*
 560   translate in one direction
 561 */
 562 void
 563 Grob::translate_axis (Real y, Axis a)
 564 {
 565   if (isinf (y) || isnan (y))
 566     programming_error (_ (INFINITY_MSG));
 567   else
 568     {
 569       dim_cache_[a].offset_ += y;
 570     }
 571 }
 572
 573
 574 /*
 575   Find the offset relative to D.  If   D equals THIS, then it is 0.
 576   Otherwise, it recursively defd as
 577
 578   OFFSET_ + PARENT_L_->relative_coordinate (D)
 579 */
 580 Real
 581 Grob::relative_coordinate (Grob const*refp, Axis a) const
 582 {
 583   if (refp == this)
 584     return 0.0;
 585
 586   /*
 587     We catch PARENT_L_ == nil case with this, but we crash if we did
 588     not ask for the absolute coordinate (ie. REFP == nil.)
 589
 590    */
 591   if (refp == dim_cache_[a].parent_l_)
 592     return get_offset (a);
 593   else
 594     return get_offset (a) + dim_cache_[a].parent_l_->relative_coordinate (refp, a);
 595 }
 596
 597
 598
 599 /*
 600   Invoke callbacks to get offset relative to parent.
 601 */
 602 Real
 603 Grob::get_offset (Axis a) const
 604 {
 605   Grob *me = (Grob*) this;
 606   while (dim_cache_[a].offsets_left_)
 607     {
 608       int l = --me->dim_cache_[a].offsets_left_;
 609       SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_,  gh_int2scm (l));
 610       SCM retval = gh_call2 (cb, self_scm (), gh_int2scm (a));
 611
 612       Real r =  gh_scm2double (retval);
 613       if (isinf (r) || isnan (r))
 614         {
 615           programming_error (INFINITY_MSG);
 616           r = 0.0;
 617         }
 618       me->dim_cache_[a].offset_ +=r;
 619     }
 620   return dim_cache_[a].offset_;
 621 }
 622
 623
 624 MAKE_SCHEME_CALLBACK (Grob,point_dimension_callback,2);
 625 SCM
 626 Grob::point_dimension_callback (SCM , SCM)
 627 {
 628   return ly_interval2scm (Interval (0,0));
 629 }
 630
 631 bool
 632 Grob::empty_b (Axis a)const
 633 {
 634   return ! (gh_pair_p (dim_cache_[a].dimension_) ||
 635             gh_procedure_p (dim_cache_[a].dimension_));
 636 }
 637
 638 Interval
 639 Grob::extent (Grob * refp, Axis a) const
 640 {
 641   Real x = relative_coordinate (refp, a);
 642
 643
 644   Dimension_cache * d = (Dimension_cache *)&dim_cache_[a];
 645   Interval ext ;
 646   if (gh_pair_p (d->dimension_))
 647     ;
 648   else if (gh_procedure_p (d->dimension_))
 649     {
 650       /*
 651         FIXME: add doco on types, and should typecheck maybe?
 652        */
 653       d->dimension_= gh_call2 (d->dimension_, self_scm (), gh_int2scm (a));
 654     }
 655   else
 656     return ext;
 657
 658   if (!gh_pair_p (d->dimension_))
 659     return ext;
 660
 661   ext = ly_scm2interval (d->dimension_);
 662
 663   SCM extra = get_grob_property (a == X_AXIS
 664                                 ? "extra-extent-X"
 665                                 : "extra-extent-Y");
 666
 667   /*
 668     signs ?
 669    */
 670   if (gh_pair_p (extra))
 671     {
 672       ext[BIGGER] +=  gh_scm2double (ly_cdr (extra));
 673       ext[SMALLER] +=   gh_scm2double (ly_car (extra));
 674     }
 675
 676   extra = get_grob_property (a == X_AXIS
 677                                 ? "minimum-extent-X"
 678                                 : "minimum-extent-Y");
 679   if (gh_pair_p (extra))
 680     {
 681       ext.unite (Interval (gh_scm2double (ly_car (extra)),
 682                            gh_scm2double (ly_cdr (extra))));
 683     }
 684
 685   ext.translate (x);
 686
 687   return ext;
 688 }
 689
 690 /*
 691   Find the group-element which has both #this# and #s#
 692 */
 693 Grob *
 694 Grob::common_refpoint (Grob const* s, Axis a) const
 695 {
 696   /*
 697     I don't like the quadratic aspect of this code, but I see no other
 698     way. The largest chain of parents might be 10 high or so, so
 699     it shouldn't be a real issue. */
 700   for (Grob const *c = this; c; c = c->dim_cache_[a].parent_l_)
 701     for (Grob const * d = s; d; d = d->dim_cache_[a].parent_l_)
 702       if (d == c)
 703         return (Grob*)d;
 704
 705   return 0;
 706 }
 707
 708
 709 Grob *
 710 common_refpoint_of_list (SCM elist, Grob *common, Axis a)
 711 {
 712   for (; gh_pair_p (elist); elist = ly_cdr (elist))
 713     {
 714       Grob * s = unsmob_grob (ly_car (elist));
 715       if (!s)
 716         continue;
 717       if (common)
 718         common = common->common_refpoint (s, a);
 719       else
 720         common = s;
 721     }
 722
 723   return common;
 724 }
 725
 726
 727
 728 Grob *
 729 common_refpoint_of_array (Link_array<Grob> const &arr, Grob *common, Axis a)
 730 {
 731   for (int i = arr.size() ; i--; )
 732     {
 733       Grob * s = arr[i];
 734       if (!s)
 735         continue;
 736
 737       if (common)
 738         common = common->common_refpoint (s, a);
 739       else
 740         common = s;
 741     }
 742
 743   return common;
 744 }
 745
 746 String
 747 Grob::name () const
 748 {
 749   SCM meta = get_grob_property ("meta");
 750   SCM nm = scm_assoc (ly_symbol2scm ("name"), meta);
 751   nm = (gh_pair_p (nm)) ? ly_cdr (nm) : SCM_EOL;
 752   return  gh_symbol_p (nm) ? ly_symbol2string (nm) :  classname (this);
 753 }
 754
 755 void
 756 Grob::add_offset_callback (SCM cb, Axis a)
 757 {
 758   if (!has_offset_callback_b (cb, a))
 759   {
 760     dim_cache_[a].offset_callbacks_ = gh_cons (cb, dim_cache_[a].offset_callbacks_);
 761     dim_cache_[a].offsets_left_ ++;
 762   }
 763 }
 764
 765 bool
 766 Grob::has_extent_callback_b (SCM cb, Axis a)const
 767 {
 768   return scm_equal_p (cb, dim_cache_[a].dimension_) == SCM_BOOL_T;
 769 }
 770
 771
 772 bool
 773 Grob::has_offset_callback_b (SCM cb, Axis a)const
 774 {
 775   return scm_memq (cb, dim_cache_[a].offset_callbacks_) != SCM_BOOL_F;
 776 }
 777
 778 void
 779 Grob::set_extent (SCM dc, Axis a)
 780 {
 781   dim_cache_[a].dimension_ =dc;
 782 }
 783
 784 void
 785 Grob::set_parent (Grob *g, Axis a)
 786 {
 787   dim_cache_[a].parent_l_ = g;
 788 }
 789
 790 MAKE_SCHEME_CALLBACK (Grob,fixup_refpoint,1);
 791 SCM
 792 Grob::fixup_refpoint (SCM smob)
 793 {
 794   Grob *me = unsmob_grob (smob);
 795   for (int a = X_AXIS; a < NO_AXES; a ++)
 796     {
 797       Axis ax = (Axis)a;
 798       Grob * parent = me->get_parent (ax);
 799
 800       if (!parent)
 801         continue;
 802
 803       if (parent->line_l () != me->line_l () && me->line_l ())
 804         {
 805           Grob * newparent = parent->find_broken_piece (me->line_l ());
 806           me->set_parent (newparent, ax);
 807         }
 808
 809       if (Item * i  = dynamic_cast<Item*> (me))
 810         {
 811           Item *parenti = dynamic_cast<Item*> (parent);
 812
 813           if (parenti && i)
 814             {
 815               Direction  my_dir = i->break_status_dir () ;
 816               if (my_dir!= parenti->break_status_dir ())
 817                 {
 818                   Item *newparent =  parenti->find_prebroken_piece (my_dir);
 819                   me->set_parent (newparent, ax);
 820                 }
 821             }
 822         }
 823     }
 824   return smob;
 825 }
 826
 827 void
 828 Grob::warning (String s)const
 829 {
 830   SCM cause = self_scm();
 831   while (cause != SCM_EOL && !unsmob_music (cause))
 832     {
 833       Grob * g = unsmob_grob (cause);
 834       cause = g->get_grob_property ("cause");
 835     }
 836
 837   if (Music *m = unsmob_music (cause))
 838     {
 839       m->origin()->warning (s);
 840     }
 841   else
 842     ::warning (s);
 843 }
 844
 845 void
 846 Grob::programming_error (String s)const
 847 {
 848   s = "Programming error: "  + s;
 849   warning (s);
 850 }
 851
 852
 853 /****************************************************
 854   SMOB funcs
 855  ****************************************************/
 856
 857
 858
 859 IMPLEMENT_SMOBS (Grob);
 860 IMPLEMENT_DEFAULT_EQUAL_P (Grob);
 861
 862 SCM
 863 Grob::mark_smob (SCM ses)
 864 {
 865   Grob * s = (Grob*) SCM_CELL_WORD_1 (ses);
 866   scm_gc_mark (s->immutable_property_alist_);
 867   scm_gc_mark (s->mutable_property_alist_);
 868
 869   for (int a =0 ; a < 2; a++)
 870     {
 871       scm_gc_mark (s->dim_cache_[a].offset_callbacks_);
 872       scm_gc_mark (s->dim_cache_[a].dimension_);
 873       Grob *p = s->get_parent (Y_AXIS);
 874       if (p)
 875         scm_gc_mark (p->self_scm ());
 876     }
 877
 878   if (s->original_l_)
 879     scm_gc_mark (s->original_l_->self_scm ());
 880
 881   return s->do_derived_mark ();
 882 }
 883
 884 int
 885 Grob::print_smob (SCM s, SCM port, scm_print_state *)
 886 {
 887   Grob *sc = (Grob *) ly_cdr (s);
 888
 889   scm_puts ("#<Grob ", port);
 890   scm_puts ((char *)sc->name ().ch_C (), port);
 891
 892   /*
 893     don't try to print properties, that is too much hassle.
 894    */
 895   scm_puts (" >", port);
 896   return 1;
 897 }
 898
 899 SCM
 900 Grob::do_derived_mark ()
 901 {
 902   return SCM_EOL;
 903 }
 904
 905 LY_DEFINE(ly_set_grob_property,"ly-set-grob-property", 3, 0, 0,
 906 (SCM grob, SCM sym, SCM val),
 907 "
 908 Set @var{sym} in grob @var{grob} to value @var{val}")
 909 {
 910   Grob * sc = unsmob_grob (grob);
 911   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 912   SCM_ASSERT_TYPE(gh_symbol_p(sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 913
 914   if (!type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")))
 915     error ("typecheck failed");
 916
 917   sc->internal_set_grob_property (sym, val);
 918   return SCM_UNSPECIFIED;
 919 }
 920
 921 LY_DEFINE(ly_get_grob_property,
 922           "ly-get-grob-property", 2, 0, 0, (SCM grob, SCM sym),
 923           "  Get the value of a value in grob @var{g} of property @var{sym}. It
 924 will return @code{'()} (end-of-list) if @var{g} doesn't have @var{sym} set.
 925 ")
 926 {
 927   Grob * sc = unsmob_grob (grob);
 928   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 929   SCM_ASSERT_TYPE(gh_symbol_p(sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 930
 931   return sc->internal_get_grob_property (sym);
 932 }
 933
 934
 935 void
 936 Grob::discretionary_processing ()
 937 {
 938 }
 939
 940
 941 LY_DEFINE(spanner_get_bound, "ly-get-spanner-bound", 2 , 0, 0,
 942           (SCM slur, SCM dir),
 943           "Get one of the bounds of @var{spanner}. @var{dir} may be @code{-1} for
 944 left, and @code{1} for right.
 945 ")
 946 {
 947   Spanner * sl = dynamic_cast<Spanner*> (unsmob_grob (slur));
 948   SCM_ASSERT_TYPE(sl, slur, SCM_ARG1, __FUNCTION__, "spanner grob");
 949   SCM_ASSERT_TYPE(ly_dir_p (dir), slur, SCM_ARG2, __FUNCTION__, "dir");
 950   return sl->get_bound (to_dir (dir))->self_scm ();
 951 }
 952
 953 LY_DEFINE(ly_get_paper_var,"ly-get-paper-variable", 2, 0, 0,
 954   (SCM grob, SCM sym),
 955   "Get a variable from the \\paper block.")
 956 {
 957   Grob * sc = unsmob_grob (grob);
 958   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 959   SCM_ASSERT_TYPE(gh_symbol_p(sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 960
 961   return sc->paper_l() ->get_scmvar_scm (sym);
 962 }
 963
 964
 965
 966 LY_DEFINE(ly_get_extent, "ly-get-extent", 3, 0, 0,
 967           (SCM grob, SCM refp, SCM axis),
 968           "Get the extent in @var{axis} direction of @var{grob} relative to the
 969 grob @var{refp}")
 970 {
 971   Grob * sc = unsmob_grob (grob);
 972   Grob * ref = unsmob_grob (refp);
 973   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 974   SCM_ASSERT_TYPE(ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 975
 976   SCM_ASSERT_TYPE(ly_axis_p(axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 977
 978   return ly_interval2scm ( sc->extent (ref, Axis (gh_scm2int (axis))));
 979 }
 980
 981 LY_DEFINE (ly_get_parent,   "ly-get-parent", 2, 0, 0, (SCM grob, SCM axis),
 982            "Get the parent of @var{grob}.  @var{axis} can be 0 for the X-axis, 1
 983 for the Y-axis.")
 984 {
 985   Grob * sc = unsmob_grob (grob);
 986   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 987   SCM_ASSERT_TYPE(ly_axis_p(axis), axis, SCM_ARG2, __FUNCTION__, "axis");
 988
 989   return sc->get_parent (Axis (gh_scm2int (axis)))->self_scm();
 990 }
 991
 992
 993 bool
 994 Grob::internal_has_interface (SCM k)
 995 {
 996   SCM ifs = get_grob_property ("interfaces");
 997
 998   return scm_memq (k, ifs) != SCM_BOOL_F;
 999 }
1000
1001 IMPLEMENT_TYPE_P (Grob, "ly-grob?");
1002
1003 ADD_INTERFACE (Grob, "grob-interface",
1004   "All grobs support this",
1005   "X-offset-callbacks Y-offset-callbacks X-extent-callback molecule cause
1006 Y-extent-callback molecule-callback extra-offset
1007 spacing-procedure
1008 staff-symbol interfaces dependencies extra-extent-X causes meta
1009 layer before-line-breaking-callback after-line-breaking-callback extra-extent-Y minimum-extent-X minimum-extent-Y transparent");
1010