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 SCM
 394 do_break_substitution (SCM src)
 395 {
 396  again:
 397
 398   if (Grob *sc = unsmob_grob (src))
 399     {
 400       if (SCM_INUMP (break_criterion))
 401         {
 402           Item * i = dynamic_cast<Item*> (sc);
 403           Direction d = to_dir (break_criterion);
 404           if (i && i->break_status_dir () != d)
 405             {
 406               Item *br = i->find_prebroken_piece (d);
 407               return (br) ? br->self_scm () : SCM_UNDEFINED;
 408             }
 409         }
 410       else
 411         {
 412           System * line
 413             = dynamic_cast<System*> (unsmob_grob (break_criterion));
 414           if (sc->line_l () != line)
 415             {
 416               sc = sc->find_broken_piece (line);
 417
 418             }
 419
 420           /* now: !sc || (sc && sc->line_l () == line) */
 421           if (!sc)
 422             return SCM_UNDEFINED;
 423
 424           /* now: sc && sc->line_l () == line */
 425           if (!line)
 426             return sc->self_scm();
 427           /*
 428             This was introduced in 1.3.49 as a measure to prevent
 429             programming errors. It looks expensive (?).
 430
 431             TODO:
 432
 433             benchmark , document when (what kind of programming
 434             errors) this happens.
 435           */
 436           if (sc->common_refpoint (line, X_AXIS)
 437                && sc->common_refpoint (line, Y_AXIS))
 438             {
 439               return sc->self_scm ();
 440             }
 441           return SCM_UNDEFINED;
 442         }
 443     }
 444   else if (ly_pair_p (src))
 445     {
 446       /*
 447         UGH! breaks on circular lists.
 448       */
 449       SCM newcar = do_break_substitution (ly_car (src));
 450       SCM oldcdr = ly_cdr (src);
 451
 452       if (newcar == SCM_UNDEFINED
 453           && (gh_pair_p (oldcdr) || oldcdr == SCM_EOL))
 454         {
 455           /*
 456             This is tail-recursion, ie.
 457
 458             return do_break_substution (cdr);
 459
 460             We don't want to rely on the compiler to do this.  Without
 461             tail-recursion, this easily crashes with a stack overflow.  */
 462           src =  oldcdr;
 463           goto again;
 464         }
 465
 466       return scm_cons (newcar, do_break_substitution (oldcdr));
 467     }
 468   else
 469     return src;
 470
 471   return src;
 472 }
 473
 474 void
 475 Grob::handle_broken_dependencies ()
 476 {
 477   Spanner * s= dynamic_cast<Spanner*> (this);
 478   if (original_l_ && s)
 479     return;
 480
 481   if (s)
 482     {
 483       for (int i = 0;  i< s->broken_into_l_arr_ .size (); i++)
 484         {
 485           Grob * sc = s->broken_into_l_arr_[i];
 486           System * l = sc->line_l ();
 487
 488           set_break_subsititution (l ? l->self_scm () : SCM_UNDEFINED);
 489           sc->mutable_property_alist_ =
 490             do_break_substitution (mutable_property_alist_);
 491
 492         }
 493     }
 494
 495
 496   System *line = line_l ();
 497
 498   if (line && common_refpoint (line, X_AXIS) && common_refpoint (line, Y_AXIS))
 499     {
 500       set_break_subsititution (line ? line->self_scm () : SCM_UNDEFINED);
 501       mutable_property_alist_ = do_break_substitution (mutable_property_alist_);
 502     }
 503   else if (dynamic_cast <System*> (this))
 504     {
 505       set_break_subsititution (SCM_UNDEFINED);
 506       mutable_property_alist_ = do_break_substitution (mutable_property_alist_);
 507     }
 508   else
 509     {
 510       /*
 511         This element is `invalid'; it has been removed from all
 512         dependencies, so let's junk the element itself.
 513
 514         do not do this for System, since that would remove
 515         references to the originals of score-grobs, which get then GC'd
 516  (a bad thing.)
 517       */
 518       suicide ();
 519     }
 520 }
 521
 522 /*
 523  Note that we still want references to this element to be
 524  rearranged, and not silently thrown away, so we keep pointers
 525  like {broken_into_{drul,array}, original}
 526 */
 527 void
 528 Grob::suicide ()
 529 {
 530   mutable_property_alist_ = SCM_EOL;
 531   immutable_property_alist_ = SCM_EOL;
 532
 533   set_extent (SCM_EOL, Y_AXIS);
 534   set_extent (SCM_EOL, X_AXIS);
 535
 536   for (int a= X_AXIS; a <= Y_AXIS; a++)
 537     {
 538       dim_cache_[a].offset_callbacks_ = SCM_EOL;
 539       dim_cache_[a].offsets_left_ = 0;
 540     }
 541 }
 542
 543 void
 544 Grob::handle_prebroken_dependencies ()
 545 {
 546 }
 547
 548 Grob*
 549 Grob::find_broken_piece (System*) const
 550 {
 551   return 0;
 552 }
 553
 554 /*
 555   translate in one direction
 556 */
 557 void
 558 Grob::translate_axis (Real y, Axis a)
 559 {
 560   if (isinf (y) || isnan (y))
 561     programming_error (_ (INFINITY_MSG));
 562   else
 563     {
 564       dim_cache_[a].offset_ += y;
 565     }
 566 }
 567
 568
 569 /*
 570   Find the offset relative to D.  If   D equals THIS, then it is 0.
 571   Otherwise, it recursively defd as
 572
 573   OFFSET_ + PARENT_L_->relative_coordinate (D)
 574 */
 575 Real
 576 Grob::relative_coordinate (Grob const*refp, Axis a) const
 577 {
 578   if (refp == this)
 579     return 0.0;
 580
 581   /*
 582     We catch PARENT_L_ == nil case with this, but we crash if we did
 583     not ask for the absolute coordinate (ie. REFP == nil.)
 584
 585    */
 586   if (refp == dim_cache_[a].parent_l_)
 587     return get_offset (a);
 588   else
 589     return get_offset (a) + dim_cache_[a].parent_l_->relative_coordinate (refp, a);
 590 }
 591
 592
 593
 594 /*
 595   Invoke callbacks to get offset relative to parent.
 596 */
 597 Real
 598 Grob::get_offset (Axis a) const
 599 {
 600   Grob *me = (Grob*) this;
 601   while (dim_cache_[a].offsets_left_)
 602     {
 603       int l = --me->dim_cache_[a].offsets_left_;
 604       SCM cb = scm_list_ref (dim_cache_[a].offset_callbacks_,  gh_int2scm (l));
 605       SCM retval = gh_call2 (cb, self_scm (), gh_int2scm (a));
 606
 607       Real r =  gh_scm2double (retval);
 608       if (isinf (r) || isnan (r))
 609         {
 610           programming_error (INFINITY_MSG);
 611           r = 0.0;
 612         }
 613       me->dim_cache_[a].offset_ +=r;
 614     }
 615   return dim_cache_[a].offset_;
 616 }
 617
 618
 619 MAKE_SCHEME_CALLBACK (Grob,point_dimension_callback,2);
 620 SCM
 621 Grob::point_dimension_callback (SCM , SCM)
 622 {
 623   return ly_interval2scm (Interval (0,0));
 624 }
 625
 626 bool
 627 Grob::empty_b (Axis a)const
 628 {
 629   return ! (gh_pair_p (dim_cache_[a].dimension_) ||
 630             gh_procedure_p (dim_cache_[a].dimension_));
 631 }
 632
 633 Interval
 634 Grob::extent (Grob * refp, Axis a) const
 635 {
 636   Real x = relative_coordinate (refp, a);
 637
 638
 639   Dimension_cache * d = (Dimension_cache *)&dim_cache_[a];
 640   Interval ext ;
 641   if (gh_pair_p (d->dimension_))
 642     ;
 643   else if (gh_procedure_p (d->dimension_))
 644     {
 645       /*
 646         FIXME: add doco on types, and should typecheck maybe?
 647        */
 648       d->dimension_= gh_call2 (d->dimension_, self_scm (), gh_int2scm (a));
 649     }
 650   else
 651     return ext;
 652
 653   if (!gh_pair_p (d->dimension_))
 654     return ext;
 655
 656   ext = ly_scm2interval (d->dimension_);
 657
 658   SCM extra = get_grob_property (a == X_AXIS
 659                                 ? "extra-extent-X"
 660                                 : "extra-extent-Y");
 661
 662   /*
 663     signs ?
 664    */
 665   if (gh_pair_p (extra))
 666     {
 667       ext[BIGGER] +=  gh_scm2double (ly_cdr (extra));
 668       ext[SMALLER] +=   gh_scm2double (ly_car (extra));
 669     }
 670
 671   extra = get_grob_property (a == X_AXIS
 672                                 ? "minimum-extent-X"
 673                                 : "minimum-extent-Y");
 674   if (gh_pair_p (extra))
 675     {
 676       ext.unite (Interval (gh_scm2double (ly_car (extra)),
 677                            gh_scm2double (ly_cdr (extra))));
 678     }
 679
 680   ext.translate (x);
 681
 682   return ext;
 683 }
 684
 685 /*
 686   Find the group-element which has both #this# and #s#
 687 */
 688 Grob *
 689 Grob::common_refpoint (Grob const* s, Axis a) const
 690 {
 691   /*
 692     I don't like the quadratic aspect of this code, but I see no other
 693     way. The largest chain of parents might be 10 high or so, so
 694     it shouldn't be a real issue. */
 695   for (Grob const *c = this; c; c = c->dim_cache_[a].parent_l_)
 696     for (Grob const * d = s; d; d = d->dim_cache_[a].parent_l_)
 697       if (d == c)
 698         return (Grob*)d;
 699
 700   return 0;
 701 }
 702
 703
 704 Grob *
 705 common_refpoint_of_list (SCM elist, Grob *common, Axis a)
 706 {
 707   for (; gh_pair_p (elist); elist = ly_cdr (elist))
 708     {
 709       Grob * s = unsmob_grob (ly_car (elist));
 710       if (!s)
 711         continue;
 712       if (common)
 713         common = common->common_refpoint (s, a);
 714       else
 715         common = s;
 716     }
 717
 718   return common;
 719 }
 720
 721
 722
 723 Grob *
 724 common_refpoint_of_array (Link_array<Grob> const &arr, Grob *common, Axis a)
 725 {
 726   for (int i = arr.size() ; i--; )
 727     {
 728       Grob * s = arr[i];
 729       if (!s)
 730         continue;
 731
 732       if (common)
 733         common = common->common_refpoint (s, a);
 734       else
 735         common = s;
 736     }
 737
 738   return common;
 739 }
 740
 741 String
 742 Grob::name () const
 743 {
 744   SCM meta = get_grob_property ("meta");
 745   SCM nm = scm_assoc (ly_symbol2scm ("name"), meta);
 746   nm = (gh_pair_p (nm)) ? ly_cdr (nm) : SCM_EOL;
 747   return  gh_symbol_p (nm) ? ly_symbol2string (nm) :  classname (this);
 748 }
 749
 750 void
 751 Grob::add_offset_callback (SCM cb, Axis a)
 752 {
 753   if (!has_offset_callback_b (cb, a))
 754   {
 755     dim_cache_[a].offset_callbacks_ = gh_cons (cb, dim_cache_[a].offset_callbacks_);
 756     dim_cache_[a].offsets_left_ ++;
 757   }
 758 }
 759
 760 bool
 761 Grob::has_extent_callback_b (SCM cb, Axis a)const
 762 {
 763   return scm_equal_p (cb, dim_cache_[a].dimension_) == SCM_BOOL_T;
 764 }
 765
 766
 767 bool
 768 Grob::has_offset_callback_b (SCM cb, Axis a)const
 769 {
 770   return scm_memq (cb, dim_cache_[a].offset_callbacks_) != SCM_BOOL_F;
 771 }
 772
 773 void
 774 Grob::set_extent (SCM dc, Axis a)
 775 {
 776   dim_cache_[a].dimension_ =dc;
 777 }
 778
 779 void
 780 Grob::set_parent (Grob *g, Axis a)
 781 {
 782   dim_cache_[a].parent_l_ = g;
 783 }
 784
 785 MAKE_SCHEME_CALLBACK (Grob,fixup_refpoint,1);
 786 SCM
 787 Grob::fixup_refpoint (SCM smob)
 788 {
 789   Grob *me = unsmob_grob (smob);
 790   for (int a = X_AXIS; a < NO_AXES; a ++)
 791     {
 792       Axis ax = (Axis)a;
 793       Grob * parent = me->get_parent (ax);
 794
 795       if (!parent)
 796         continue;
 797
 798       if (parent->line_l () != me->line_l () && me->line_l ())
 799         {
 800           Grob * newparent = parent->find_broken_piece (me->line_l ());
 801           me->set_parent (newparent, ax);
 802         }
 803
 804       if (Item * i  = dynamic_cast<Item*> (me))
 805         {
 806           Item *parenti = dynamic_cast<Item*> (parent);
 807
 808           if (parenti && i)
 809             {
 810               Direction  my_dir = i->break_status_dir () ;
 811               if (my_dir!= parenti->break_status_dir ())
 812                 {
 813                   Item *newparent =  parenti->find_prebroken_piece (my_dir);
 814                   me->set_parent (newparent, ax);
 815                 }
 816             }
 817         }
 818     }
 819   return smob;
 820 }
 821
 822 void
 823 Grob::warning (String s)const
 824 {
 825   SCM cause = self_scm();
 826   while (cause != SCM_EOL && !unsmob_music (cause))
 827     {
 828       Grob * g = unsmob_grob (cause);
 829       cause = g->get_grob_property ("cause");
 830     }
 831
 832   if (Music *m = unsmob_music (cause))
 833     {
 834       m->origin()->warning (s);
 835     }
 836   else
 837     ::warning (s);
 838 }
 839
 840 void
 841 Grob::programming_error (String s)const
 842 {
 843   s = "Programming error: "  + s;
 844   warning (s);
 845 }
 846
 847
 848 /****************************************************
 849   SMOB funcs
 850  ****************************************************/
 851
 852
 853
 854 IMPLEMENT_SMOBS (Grob);
 855 IMPLEMENT_DEFAULT_EQUAL_P (Grob);
 856
 857 SCM
 858 Grob::mark_smob (SCM ses)
 859 {
 860   Grob * s = (Grob*) SCM_CELL_WORD_1 (ses);
 861   scm_gc_mark (s->immutable_property_alist_);
 862   scm_gc_mark (s->mutable_property_alist_);
 863
 864   for (int a =0 ; a < 2; a++)
 865     {
 866       scm_gc_mark (s->dim_cache_[a].offset_callbacks_);
 867       scm_gc_mark (s->dim_cache_[a].dimension_);
 868       Grob *p = s->get_parent (Y_AXIS);
 869       if (p)
 870         scm_gc_mark (p->self_scm ());
 871     }
 872
 873   if (s->original_l_)
 874     scm_gc_mark (s->original_l_->self_scm ());
 875
 876   return s->do_derived_mark ();
 877 }
 878
 879 int
 880 Grob::print_smob (SCM s, SCM port, scm_print_state *)
 881 {
 882   Grob *sc = (Grob *) ly_cdr (s);
 883
 884   scm_puts ("#<Grob ", port);
 885   scm_puts ((char *)sc->name ().ch_C (), port);
 886
 887   /*
 888     don't try to print properties, that is too much hassle.
 889    */
 890   scm_puts (" >", port);
 891   return 1;
 892 }
 893
 894 SCM
 895 Grob::do_derived_mark ()
 896 {
 897   return SCM_EOL;
 898 }
 899
 900 LY_DEFINE(ly_set_grob_property,"ly-set-grob-property", 3, 0, 0,
 901 (SCM grob, SCM sym, SCM val),
 902 "
 903 Set @var{sym} in grob @var{grob} to value @var{val}")
 904 {
 905   Grob * sc = unsmob_grob (grob);
 906   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 907   SCM_ASSERT_TYPE(gh_symbol_p(sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 908
 909   if (!type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")))
 910     error ("typecheck failed");
 911
 912   sc->internal_set_grob_property (sym, val);
 913   return SCM_UNSPECIFIED;
 914 }
 915
 916 LY_DEFINE(ly_get_grob_property,
 917           "ly-get-grob-property", 2, 0, 0, (SCM grob, SCM sym),
 918           "  Get the value of a value in grob @var{g} of property @var{sym}. It
 919 will return @code{'()} (end-of-list) if @var{g} doesn't have @var{sym} set.
 920 ")
 921 {
 922   Grob * sc = unsmob_grob (grob);
 923   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 924   SCM_ASSERT_TYPE(gh_symbol_p(sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 925
 926   return sc->internal_get_grob_property (sym);
 927 }
 928
 929
 930 void
 931 Grob::discretionary_processing ()
 932 {
 933 }
 934
 935
 936 LY_DEFINE(spanner_get_bound, "ly-get-spanner-bound", 2 , 0, 0,
 937           (SCM slur, SCM dir),
 938           "Get one of the bounds of @var{spanner}. @var{dir} may be @code{-1} for
 939 left, and @code{1} for right.
 940 ")
 941 {
 942   Spanner * sl = dynamic_cast<Spanner*> (unsmob_grob (slur));
 943   SCM_ASSERT_TYPE(sl, slur, SCM_ARG1, __FUNCTION__, "spanner grob");
 944   SCM_ASSERT_TYPE(ly_dir_p (dir), slur, SCM_ARG2, __FUNCTION__, "dir");
 945   return sl->get_bound (to_dir (dir))->self_scm ();
 946 }
 947
 948 LY_DEFINE(ly_get_paper_var,"ly-get-paper-variable", 2, 0, 0,
 949   (SCM grob, SCM sym),
 950   "Get a variable from the \\paper block.")
 951 {
 952   Grob * sc = unsmob_grob (grob);
 953   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 954   SCM_ASSERT_TYPE(gh_symbol_p(sym), sym, SCM_ARG2, __FUNCTION__, "symbol");
 955
 956   return sc->paper_l() ->get_scmvar_scm (sym);
 957 }
 958
 959
 960
 961 LY_DEFINE(ly_get_extent, "ly-get-extent", 3, 0, 0,
 962           (SCM grob, SCM refp, SCM axis),
 963           "Get the extent in @var{axis} direction of @var{grob} relative to the
 964 grob @var{refp}")
 965 {
 966   Grob * sc = unsmob_grob (grob);
 967   Grob * ref = unsmob_grob (refp);
 968   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 969   SCM_ASSERT_TYPE(ref, refp, SCM_ARG2, __FUNCTION__, "grob");
 970
 971   SCM_ASSERT_TYPE(ly_axis_p(axis), axis, SCM_ARG3, __FUNCTION__, "axis");
 972
 973   return ly_interval2scm ( sc->extent (ref, Axis (gh_scm2int (axis))));
 974 }
 975
 976 LY_DEFINE (ly_get_parent,   "ly-get-parent", 2, 0, 0, (SCM grob, SCM axis),
 977            "Get the parent of @var{grob}.  @var{axis} can be 0 for the X-axis, 1
 978 for the Y-axis.")
 979 {
 980   Grob * sc = unsmob_grob (grob);
 981   SCM_ASSERT_TYPE(sc, grob, SCM_ARG1, __FUNCTION__, "grob");
 982   SCM_ASSERT_TYPE(ly_axis_p(axis), axis, SCM_ARG2, __FUNCTION__, "axis");
 983
 984   return sc->get_parent (Axis (gh_scm2int (axis)))->self_scm();
 985 }
 986
 987
 988 bool
 989 Grob::internal_has_interface (SCM k)
 990 {
 991   SCM ifs = get_grob_property ("interfaces");
 992
 993   return scm_memq (k, ifs) != SCM_BOOL_F;
 994 }
 995
 996 IMPLEMENT_TYPE_P (Grob, "ly-grob?");
 997
 998 ADD_INTERFACE (Grob, "grob-interface",
 999   "All grobs support this",
1000   "X-offset-callbacks Y-offset-callbacks X-extent-callback molecule cause
1001 Y-extent-callback molecule-callback extra-offset
1002 spacing-procedure
1003 staff-symbol interfaces dependencies extra-extent-X causes meta
1004 layer before-line-breaking-callback after-line-breaking-callback extra-extent-Y minimum-extent-X minimum-extent-Y transparent");
1005