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 or pop (depending on value of VAL) 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 void
 198 Grob_property_info::push (SCM grob_property_path, SCM new_value)
 199 {
 200   /*
 201     Don't mess with MIDI.
 202   */
 203   if (!create ())
 204     return;
 205
 206   SCM symbol = scm_car (grob_property_path);
 207   SCM rest = scm_cdr (grob_property_path);
 208   if (scm_is_pair (rest))
 209     {
 210       // poor man's typechecking
 211       if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) {
 212         props_->alist_ = scm_acons (grob_property_path, new_value, props_->alist_);
 213         props_->nested_++;
 214       }
 215       return;
 216     }
 217
 218   /* it's tempting to replace the head of the list if it's the same
 219    property. However, we have to keep this info around, in case we have to
 220    \revert back to it.
 221   */
 222
 223   if (typecheck_grob (symbol, new_value))
 224     props_->alist_ = scm_acons (symbol, new_value, props_->alist_);
 225 }
 226
 227 /*
 228   Revert the property given by property_path.
 229 */
 230 void
 231 Grob_property_info::pop (SCM grob_property_path)
 232 {
 233   if (!check ())
 234     return;
 235
 236   SCM current_alist = props_->alist_;
 237   SCM daddy = props_->based_on_;
 238
 239   if (!scm_is_pair (grob_property_path)
 240       || !scm_is_symbol (scm_car (grob_property_path)))
 241     {
 242       programming_error ("Grob property path should be list of symbols.");
 243       return;
 244     }
 245
 246   if (scm_is_pair (scm_cdr (grob_property_path)))
 247     {
 248       SCM old_alist = current_alist;
 249       current_alist = evict_from_alist (grob_property_path, current_alist, daddy);
 250       if (scm_is_eq (old_alist, current_alist))
 251         return;
 252       props_->nested_--;
 253     }
 254   else
 255     current_alist = evict_from_alist (scm_car (grob_property_path),
 256                                       current_alist, daddy);
 257
 258   if (scm_is_eq (current_alist, daddy))
 259     {
 260       assert (props_->nested_ == 0);
 261       props_ = 0;
 262       context_->unset_property (symbol_);
 263       return;
 264     }
 265   props_->alist_ = current_alist;
 266 }
 267 /*
 268   Convenience: a push/pop grob property using a single grob_property
 269   as argument.
 270 */
 271 void
 272 execute_pushpop_property (Context *context,
 273                           SCM grob,
 274                           SCM grob_property,
 275                           SCM new_value)
 276 {
 277   Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value);
 278 }
 279
 280 /*
 281   PRE_INIT_OPS is in the order specified, and hence must be reversed.
 282 */
 283 void
 284 apply_property_operations (Context *tg, SCM pre_init_ops)
 285 {
 286   for (SCM s = pre_init_ops; scm_is_pair (s); s = scm_cdr (s))
 287     {
 288       SCM entry = scm_car (s);
 289       SCM type = scm_car (entry);
 290       entry = scm_cdr (entry);
 291
 292       if (type == ly_symbol2scm ("push"))
 293         {
 294           SCM context_prop = scm_car (entry);
 295           SCM val = scm_cadr (entry);
 296           SCM grob_prop_path = scm_cddr (entry);
 297           Grob_property_info (tg, context_prop).push (grob_prop_path, val);
 298         }
 299       else if (type == ly_symbol2scm ("pop"))
 300         {
 301           SCM context_prop = scm_car (entry);
 302           SCM grob_prop_path = scm_cdr (entry);
 303           Grob_property_info (tg, context_prop).pop (grob_prop_path);
 304         }
 305       else if (type == ly_symbol2scm ("assign"))
 306         tg->set_property (scm_car (entry), scm_cadr (entry));
 307       else if (type == ly_symbol2scm ("apply"))
 308         scm_apply_1 (scm_car (entry), tg->self_scm (), scm_cdr (entry));
 309       else if (type == ly_symbol2scm ("unset"))
 310         tg->unset_property (scm_car (entry));
 311     }
 312 }
 313
 314 /*
 315   Return the object alist for SYM, checking if its base in enclosing
 316   contexts has changed. The alist is updated if necessary.
 317 */
 318 SCM Grob_property_info::updated ()
 319 {
 320   assert (scm_is_symbol (symbol_));
 321
 322   Grob_property_info where = find ();
 323
 324   if (!where)
 325     return SCM_EOL;
 326
 327   Context *dad = where.context_->get_parent_context ();
 328
 329   SCM daddy_props
 330     = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL;
 331
 332   SCM based_on = where.props_->based_on_;
 333   SCM alist = where.props_->alist_;
 334   if (!scm_is_eq (based_on, daddy_props))
 335     {
 336       where.props_->based_on_ = daddy_props;
 337       alist = partial_list_copy (alist, based_on, daddy_props);
 338       where.props_->alist_ = alist;
 339     }
 340   if (scm_is_eq (where.props_->cooked_from_, alist))
 341     return where.props_->cooked_;
 342   where.props_->cooked_from_ = alist;
 343   where.props_->cooked_ = nalist_to_alist (alist, where.props_->nested_);
 344   return where.props_->cooked_;
 345 }