lily/context-property.cc

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