lily/context-property.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2004--2011 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 "international.hh"
  23 #include "item.hh"
  24 #include "main.hh"
  25 #include "simple-closure.hh"
  26 #include "spanner.hh"
  27 #include "warn.hh"
  28
  29 /*
  30   like execute_general_pushpop_property(), but typecheck
  31   grob_property_path and context_property.
  32 */
  33 void
  34 general_pushpop_property (Context *context,
  35                           SCM context_property,
  36                           SCM grob_property_path,
  37                           SCM new_value)
  38 {
  39   if (!scm_is_symbol (context_property)
  40       || !scm_is_symbol (scm_car (grob_property_path)))
  41     {
  42       warning (_ ("need symbol arguments for \\override and \\revert"));
  43       if (do_internal_type_checking_global)
  44         assert (false);
  45     }
  46
  47   sloppy_general_pushpop_property (context, context_property,
  48                                    grob_property_path, new_value);
  49 }
  50
  51 /*
  52   Grob descriptions (ie. alists with layout properties) are
  53   represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
  54   alist defined in a parent context. BASED-ON should always be a tail
  55   of ALIST.
  56
  57   Push or pop (depending on value of VAL) a single entry from a
  58   translator property list by name of PROP.  GROB_PROPERTY_PATH
  59   indicates nested alists, eg. '(beamed-stem-lengths details)
  60 */
  61 void
  62 execute_override_property (Context *context,
  63                            SCM context_property,
  64                            SCM grob_property_path,
  65                            SCM new_value)
  66 {
  67   SCM current_context_val = SCM_EOL;
  68
  69   Context *where = context->where_defined (context_property,
  70                                            &current_context_val);
  71
  72   /*
  73     Don't mess with MIDI.
  74   */
  75   if (!where)
  76     return;
  77
  78   if (where != context)
  79     {
  80       SCM base = updated_grob_properties (context, context_property);
  81       current_context_val = scm_cons (base, base);
  82       context->set_property (context_property, current_context_val);
  83     }
  84
  85   if (!scm_is_pair (current_context_val))
  86     {
  87       programming_error ("Grob definition should be cons");
  88       return;
  89     }
  90
  91   SCM target_alist = scm_car (current_context_val);
  92
  93   /*
  94     If the car is a list, the property path comes from a nested override
  95     using list syntax inside a \context block
  96   */
  97   if (scm_is_pair (scm_car (grob_property_path)))
  98     grob_property_path = scm_car (grob_property_path);
  99
 100   SCM symbol = scm_car (grob_property_path);
 101   if (scm_is_pair (scm_cdr (grob_property_path)))
 102     {
 103       new_value = nested_property_alist (ly_assoc_get (symbol, target_alist,
 104                                                        SCM_EOL),
 105                                          scm_cdr (grob_property_path),
 106                                          new_value);
 107     }
 108
 109   /* it's tempting to replace the head of the list if it's the same
 110    property. However, we have to keep this info around, in case we have to
 111    \revert back to it.
 112   */
 113   target_alist = scm_acons (symbol, new_value, target_alist);
 114
 115   bool ok = true;
 116   if (!ly_is_procedure (new_value)
 117       && !is_simple_closure (new_value))
 118     ok = type_check_assignment (symbol, new_value,
 119                                 ly_symbol2scm ("backend-type?"));
 120
 121   /*
 122     tack onto alist.  We can use set_car, since
 123     updated_grob_properties () in child contexts will check
 124     for changes in the car.
 125   */
 126   if (ok)
 127     {
 128       scm_set_car_x (current_context_val, target_alist);
 129     }
 130 }
 131
 132 /*
 133   do a pop (indicated by new_value==SCM_UNDEFINED) or push
 134  */
 135 void
 136 sloppy_general_pushpop_property (Context *context,
 137                                  SCM context_property,
 138                                  SCM grob_property_path,
 139                                  SCM new_value)
 140 {
 141   if (new_value == SCM_UNDEFINED)
 142     execute_revert_property (context, context_property,
 143                              grob_property_path);
 144   else
 145     execute_override_property (context, context_property,
 146                                grob_property_path,
 147                                new_value);
 148 }
 149
 150 /*
 151   Revert the property given by property_path.
 152 */
 153 void
 154 execute_revert_property (Context *context,
 155                          SCM context_property,
 156                          SCM grob_property_path)
 157 {
 158   SCM current_context_val = SCM_EOL;
 159   if (context->where_defined (context_property, &current_context_val)
 160       == context)
 161     {
 162       SCM current_alist = scm_car (current_context_val);
 163       SCM daddy = scm_cdr (current_context_val);
 164
 165       if (!scm_is_pair (grob_property_path)
 166           || !scm_is_symbol (scm_car (grob_property_path)))
 167         {
 168           programming_error ("Grob property path should be list of symbols.");
 169           return;
 170         }
 171
 172       SCM symbol = scm_car (grob_property_path);
 173       if (scm_is_pair (scm_cdr (grob_property_path)))
 174         {
 175           SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL);
 176           SCM new_val
 177             = nested_property_revert_alist (current_sub_alist,
 178                                             scm_cdr (grob_property_path));
 179
 180           if (scm_is_pair (current_alist)
 181               && scm_caar (current_alist) == symbol
 182               && current_alist != daddy)
 183             current_alist = scm_cdr (current_alist);
 184
 185           current_alist = scm_acons (symbol, new_val, current_alist);
 186           scm_set_car_x (current_context_val, current_alist);
 187         }
 188       else
 189         {
 190           SCM new_alist = evict_from_alist (symbol, current_alist, daddy);
 191
 192           if (new_alist == daddy)
 193             context->unset_property (context_property);
 194           else
 195             context->set_property (context_property,
 196                                    scm_cons (new_alist, daddy));
 197         }
 198     }
 199 }
 200 /*
 201   Convenience: a push/pop grob property using a single grob_property
 202   as argument.
 203 */
 204 void
 205 execute_pushpop_property (Context *context,
 206                           SCM context_property,
 207                           SCM grob_property,
 208                           SCM new_value)
 209 {
 210   general_pushpop_property (context, context_property,
 211                             scm_list_1 (grob_property),
 212                             new_value);
 213 }
 214
 215 /*
 216   PRE_INIT_OPS is in the order specified, and hence must be reversed.
 217 */
 218 void
 219 apply_property_operations (Context *tg, SCM pre_init_ops)
 220 {
 221   SCM correct_order = scm_reverse (pre_init_ops);
 222   for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s))
 223     {
 224       SCM entry = scm_car (s);
 225       SCM type = scm_car (entry);
 226       entry = scm_cdr (entry);
 227
 228       if (type == ly_symbol2scm ("push"))
 229         {
 230           SCM context_prop = scm_car (entry);
 231           SCM val = scm_cadr (entry);
 232           SCM grob_prop_path = scm_cddr (entry);
 233           sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val);
 234         }
 235       else if (type == ly_symbol2scm ("pop"))
 236         {
 237           SCM context_prop = scm_car (entry);
 238           SCM val = SCM_UNDEFINED;
 239           SCM grob_prop_path = scm_cdr (entry);
 240           sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val);
 241         }
 242       else if (type == ly_symbol2scm ("assign"))
 243         tg->set_property (scm_car (entry), scm_cadr (entry));
 244     }
 245 }
 246
 247 /*
 248   Return the object alist for SYM, checking if its base in enclosing
 249   contexts has changed. The alist is updated if necessary.
 250 */
 251 SCM
 252 updated_grob_properties (Context *tg, SCM sym)
 253 {
 254   assert (scm_is_symbol (sym));
 255
 256   SCM props;
 257   tg = tg->where_defined (sym, &props);
 258   if (!tg)
 259     return SCM_EOL;
 260
 261   SCM daddy_props
 262     = (tg->get_parent_context ())
 263       ? updated_grob_properties (tg->get_parent_context (), sym)
 264       : SCM_EOL;
 265
 266   if (!scm_is_pair (props))
 267     {
 268       programming_error ("grob props not a pair?");
 269       return SCM_EOL;
 270     }
 271
 272   SCM based_on = scm_cdr (props);
 273   if (based_on == daddy_props)
 274     return scm_car (props);
 275   else
 276     {
 277       SCM copy = daddy_props;
 278       SCM *tail = &copy;
 279       SCM p = scm_car (props);
 280       while (p != based_on)
 281         {
 282           *tail = scm_cons (scm_car (p), daddy_props);
 283           tail = SCM_CDRLOC (*tail);
 284           p = scm_cdr (p);
 285         }
 286
 287       scm_set_car_x (props, copy);
 288       scm_set_cdr_x (props, daddy_props);
 289
 290       return copy;
 291     }
 292 }