lily/context-property.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
   5
   6   LilyPond is free software: you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation, either version 3 of the License, or
   9   (at your option) any later version.
  10
  11   LilyPond is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 */
  19
  20 #include "context.hh"
  21 #include "engraver.hh"
  22 #include "global-context.hh"
  23 #include "grob-properties.hh"
  24 #include "international.hh"
  25 #include "item.hh"
  26 #include "main.hh"
  27 #include "smobs.hh"
  28 #include "spanner.hh"
  29 #include "unpure-pure-container.hh"
  30 #include "warn.hh"
  31
  32 /*
  33   like execute_general_pushpop_property(), but typecheck
  34   grob_property_path and context_property.
  35 */
  36 void
  37 general_pushpop_property (Context *context,
  38                           SCM context_property,
  39                           SCM grob_property_path,
  40                           SCM new_value)
  41 {
  42   if (!scm_is_symbol (context_property)
  43       || !scm_is_symbol (scm_car (grob_property_path)))
  44     {
  45       warning (_ ("need symbol arguments for \\override and \\revert"));
  46       if (do_internal_type_checking_global)
  47         assert (false);
  48     }
  49
  50   Grob_property_info (context, context_property).pushpop
  51     (grob_property_path, new_value);
  52 }
  53
  54 bool
  55 typecheck_grob (SCM symbol, SCM value)
  56 {
  57   if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (value))
  58     return typecheck_grob (symbol, upc->unpure_part ())
  59       && typecheck_grob (symbol, upc->pure_part ());
  60   return ly_is_procedure (value)
  61     || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?"));
  62 }
  63
  64 class Grob_properties : public Simple_smob<Grob_properties>
  65 {
  66 public:
  67   SCM mark_smob () const;
  68   static const char type_p_name_[];
  69 private:
  70   friend class Grob_property_info;
  71   friend SCM ly_make_grob_properties (SCM);
  72   // alist_ may contain unexpanded nested overrides
  73   SCM alist_;
  74   // based_on_ is the cooked_ value from the next higher context that
  75   // alist_ is based on
  76   SCM based_on_;
  77   // cooked_ is a version of alist_ where nested overrides have been
  78   // expanded
  79   SCM cooked_;
  80   // cooked_from_ is the value of alist_ from which the expansion has
  81   // been done
  82   SCM cooked_from_;
  83   // nested_ is a count of nested overrides in alist_ Or rather: of
  84   // entries that must not appear in the cooked list and are
  85   // identified by having a "key" that is not a symbol.  Temporary
  86   // overrides and reverts also meet that description and have a
  87   // nominal key of #t/#f and a value of the original cons cell.
  88   int nested_;
  89
  90   Grob_properties (SCM alist, SCM based_on) :
  91     alist_ (alist), based_on_ (based_on),
  92     // if the constructor was called with lists possibly containing
  93     // partial overrides, we would need to initialize with based_on in
  94     // order to trigger an initial update.  But this should never
  95     // happen, so we initialize straight with alist.
  96     cooked_ (alist), cooked_from_ (alist), nested_ (0) { }
  97 };
  98
  99 const char Grob_properties::type_p_name_[] = "ly:grob-properties?";
 100
 101 SCM
 102 Grob_properties::mark_smob () const
 103 {
 104   scm_gc_mark (alist_);
 105   scm_gc_mark (based_on_);
 106   scm_gc_mark (cooked_);
 107   return cooked_from_;
 108 }
 109
 110 LY_DEFINE (ly_make_grob_properties, "ly:make-grob-properties",
 111            1, 0, 0, (SCM alist),
 112            "This packages the given property list @var{alist} in"
 113            " a grob property container stored in a context property"
 114            " with the name of a grob.")
 115 {
 116   LY_ASSERT_TYPE (ly_is_list, alist, 1);
 117   return Grob_properties (alist, SCM_EOL).smobbed_copy ();
 118 }
 119
 120
 121 Grob_property_info
 122 Grob_property_info::find ()
 123 {
 124   if (props_)
 125     return *this;
 126   SCM res = SCM_UNDEFINED;
 127   if (Context *c = context_->where_defined (symbol_, &res))
 128     if (c != context_)
 129       return Grob_property_info (c, symbol_, unsmob<Grob_properties> (res));
 130   props_  = unsmob<Grob_properties> (res);
 131   return *this;
 132 }
 133
 134 bool
 135 Grob_property_info::check ()
 136 {
 137   if (props_)
 138     return true;
 139   SCM res = SCM_UNDEFINED;
 140   if (context_->here_defined (symbol_, &res))
 141     props_ = unsmob<Grob_properties> (res);
 142   return props_;
 143 }
 144
 145 bool
 146 Grob_property_info::create ()
 147 {
 148   // Using scm_hashq_create_handle_x would seem like the one-lookup
 149   // way to create a handle if it does not exist yet.  However, we
 150   // need to check that there is a corresponding grob in this
 151   // particular output first, and we have to do this in the global
 152   // context.  By far the most frequent case will be that a
 153   // Grob_properties for this context already exists, so we optimize
 154   // for that and only check the global handle when the local
 155   // context is pristine.
 156   if (check ())
 157     return true;
 158   SCM current_context_val = SCM_EOL;
 159   Context *g = context_->get_global_context ();
 160   if (!g)
 161     return false; // Context is probably dead
 162
 163   /*
 164     Don't mess with MIDI.
 165   */
 166   if (g == context_
 167       || !g->here_defined (symbol_, &current_context_val))
 168     return false;
 169
 170   Grob_properties *def = unsmob<Grob_properties> (current_context_val);
 171
 172   if (!def)
 173     {
 174       programming_error ("Grob definition expected");
 175       return false;
 176     }
 177
 178   // We create the new Grob_properties from the default definition
 179   // since this is what we have available right now.  It may or may
 180   // not be accurate since we don't take into account any
 181   // prospective overrides in intermediate contexts.  If there are
 182   // any, they will be factored in when `updated' is being called.
 183   SCM props = Grob_properties (def->alist_, def->alist_).smobbed_copy ();
 184   context_->set_property (symbol_, props);
 185   props_ = unsmob<Grob_properties> (props);
 186   return props_;
 187 }
 188
 189 /*
 190   Grob descriptions (ie. alists with layout properties) are
 191   represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
 192   alist defined in a parent context. BASED-ON should always be a tail
 193   of ALIST.
 194
 195   Push a single entry from a
 196   translator property list by name of PROP.  GROB_PROPERTY_PATH
 197   indicates nested alists, eg. '(beamed-stem-lengths details)
 198
 199   Return value can be passed to matched_pop and will only cancel the
 200   same override then.
 201 */
 202 SCM
 203 Grob_property_info::push (SCM grob_property_path, SCM new_value)
 204 {
 205   /*
 206     Don't mess with MIDI.
 207   */
 208   if (!create ())
 209     return SCM_EOL;
 210
 211   SCM symbol = scm_car (grob_property_path);
 212   SCM rest = scm_cdr (grob_property_path);
 213   if (scm_is_pair (rest))
 214     {
 215       // poor man's typechecking
 216       if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) {
 217         SCM cell = scm_cons (grob_property_path, new_value);
 218         props_->alist_ = scm_cons (cell, props_->alist_);
 219         props_->nested_++;
 220         return cell;
 221       }
 222       return SCM_EOL;
 223     }
 224
 225   /* it's tempting to replace the head of the list if it's the same
 226    property. However, we have to keep this info around, in case we have to
 227    \revert back to it.
 228   */
 229
 230   if (typecheck_grob (symbol, new_value))
 231     {
 232       SCM cell = scm_cons (symbol, new_value);
 233       props_->alist_ = scm_cons (cell, props_->alist_);
 234       return cell;
 235     }
 236   return SCM_EOL;
 237 }
 238
 239 // Used for \once \override, returns a token for matched_pop
 240 SCM
 241 Grob_property_info::temporary_override (SCM grob_property_path, SCM new_value)
 242 {
 243   SCM cell = push (grob_property_path, new_value);
 244   if (!scm_is_pair (cell))
 245     return cell;
 246   if (scm_is_symbol (scm_car (cell)))
 247     props_->nested_++;
 248   cell = scm_cons (SCM_BOOL_T, cell);
 249   props_->alist_ = scm_cons (cell, scm_cdr (props_->alist_));
 250   return cell;
 251 }
 252
 253 // Used for \once \revert, returns a token for matched_pop
 254 SCM
 255 Grob_property_info::temporary_revert (SCM grob_property_path)
 256 {
 257   if (!check ())
 258     return SCM_EOL;
 259
 260   SCM current_alist = props_->alist_;
 261   SCM daddy = props_->based_on_;
 262   SCM tail = SCM_EOL;
 263
 264   if (!scm_is_pair (grob_property_path)
 265       || !scm_is_symbol (scm_car (grob_property_path)))
 266     {
 267       programming_error ("Grob property path should be list of symbols.");
 268       return SCM_EOL;
 269     }
 270
 271   if (scm_is_pair (scm_cdr (grob_property_path)))
 272     {
 273       tail = assoc_tail (grob_property_path, current_alist, daddy);
 274       if (scm_is_false (tail))
 275         return SCM_EOL;
 276     }
 277   else
 278     {
 279       tail = assq_tail (scm_car (grob_property_path), current_alist, daddy);
 280       if (scm_is_false (tail))
 281         return SCM_EOL;
 282       ++props_->nested_;
 283     }
 284
 285   SCM cell = scm_cons (SCM_BOOL_F, scm_car (tail));
 286   props_->alist_ = partial_list_copy (current_alist, tail,
 287                                       scm_cons (cell, scm_cdr (tail)));
 288   return cell;
 289 }
 290
 291
 292 void
 293 Grob_property_info::matched_pop (SCM cell)
 294 {
 295   if (!scm_is_pair (cell))
 296     return;
 297   if (!check ())
 298     return;
 299   SCM current_alist = props_->alist_;
 300   SCM daddy = props_->based_on_;
 301   for (SCM p = current_alist; !scm_is_eq (p, daddy); p = scm_cdr (p))
 302     {
 303       if (scm_is_eq (scm_car (p), cell))
 304         {
 305           SCM key = scm_car (cell);
 306           if (scm_is_false (key))
 307             {
 308               // temporary revert, reactivate
 309               cell = scm_cdr (cell);
 310               if (scm_is_symbol (scm_car (cell)))
 311                 props_->nested_--;
 312               props_->alist_ = partial_list_copy (current_alist, p,
 313                                                   scm_cons (cell, scm_cdr (p)));
 314               return;
 315             }
 316           if (!scm_is_symbol (key))
 317             props_->nested_--;
 318           props_->alist_ = partial_list_copy (current_alist, p, scm_cdr (p));
 319           return;
 320         }
 321     }
 322   return;
 323 }
 324
 325 /*
 326   Revert the property given by property_path.
 327 */
 328 void
 329 Grob_property_info::pop (SCM grob_property_path)
 330 {
 331   if (!check ())
 332     return;
 333
 334   SCM current_alist = props_->alist_;
 335   SCM daddy = props_->based_on_;
 336
 337   if (!scm_is_pair (grob_property_path)
 338       || !scm_is_symbol (scm_car (grob_property_path)))
 339     {
 340       programming_error ("Grob property path should be list of symbols.");
 341       return;
 342     }
 343
 344   if (scm_is_pair (scm_cdr (grob_property_path)))
 345     {
 346       SCM old_alist = current_alist;
 347       current_alist = evict_from_alist (grob_property_path, current_alist, daddy);
 348       if (scm_is_eq (old_alist, current_alist))
 349         return;
 350       props_->nested_--;
 351     }
 352   else
 353     current_alist = evict_from_alist (scm_car (grob_property_path),
 354                                       current_alist, daddy);
 355
 356   if (scm_is_eq (current_alist, daddy))
 357     {
 358       assert (props_->nested_ == 0);
 359       props_ = 0;
 360       context_->unset_property (symbol_);
 361       return;
 362     }
 363   props_->alist_ = current_alist;
 364 }
 365 /*
 366   Convenience: a push/pop grob property using a single grob_property
 367   as argument.
 368 */
 369 void
 370 execute_pushpop_property (Context *context,
 371                           SCM grob,
 372                           SCM grob_property,
 373                           SCM new_value)
 374 {
 375   Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value);
 376 }
 377
 378 /*
 379   PRE_INIT_OPS is in the order specified, and hence must be reversed.
 380 */
 381 void
 382 apply_property_operations (Context *tg, SCM pre_init_ops)
 383 {
 384   for (SCM s = pre_init_ops; scm_is_pair (s); s = scm_cdr (s))
 385     {
 386       SCM entry = scm_car (s);
 387       SCM type = scm_car (entry);
 388       entry = scm_cdr (entry);
 389
 390       if (scm_is_eq (type, ly_symbol2scm ("push")))
 391         {
 392           SCM context_prop = scm_car (entry);
 393           SCM val = scm_cadr (entry);
 394           SCM grob_prop_path = scm_cddr (entry);
 395           Grob_property_info (tg, context_prop).push (grob_prop_path, val);
 396         }
 397       else if (scm_is_eq (type, ly_symbol2scm ("pop")))
 398         {
 399           SCM context_prop = scm_car (entry);
 400           SCM grob_prop_path = scm_cdr (entry);
 401           Grob_property_info (tg, context_prop).pop (grob_prop_path);
 402         }
 403       else if (scm_is_eq (type, ly_symbol2scm ("assign")))
 404         tg->set_property (scm_car (entry), scm_cadr (entry));
 405       else if (scm_is_eq (type, ly_symbol2scm ("apply")))
 406         scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry));
 407       else if (scm_is_eq (type, ly_symbol2scm ("unset")))
 408         tg->unset_property (scm_car (entry));
 409     }
 410 }
 411
 412 /*
 413   Return the object alist for SYM, checking if its base in enclosing
 414   contexts has changed. The alist is updated if necessary.
 415 */
 416 SCM Grob_property_info::updated ()
 417 {
 418   assert (scm_is_symbol (symbol_));
 419
 420   Grob_property_info where = find ();
 421
 422   if (!where)
 423     return SCM_EOL;
 424
 425   Context *dad = where.context_->get_parent_context ();
 426
 427   SCM daddy_props
 428     = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL;
 429
 430   SCM based_on = where.props_->based_on_;
 431   SCM alist = where.props_->alist_;
 432   if (!scm_is_eq (based_on, daddy_props))
 433     {
 434       where.props_->based_on_ = daddy_props;
 435       alist = partial_list_copy (alist, based_on, daddy_props);
 436       where.props_->alist_ = alist;
 437     }
 438   if (scm_is_eq (where.props_->cooked_from_, alist))
 439     return where.props_->cooked_;
 440   where.props_->cooked_from_ = alist;
 441   where.props_->cooked_ = nalist_to_alist (alist, where.props_->nested_);
 442   return where.props_->cooked_;
 443 }