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