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