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