lily/context-property.cc

   1 /*
   2   context-property.cc -- implement manipulation of immutable Grob
   3   property lists.
   4
   5   source file of the GNU LilyPond music typesetter
   6
   7   (c) 2004--2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
   8 */
   9
  10 #include "context.hh"
  11 #include "engraver.hh"
  12 #include "item.hh"
  13 #include "main.hh"
  14 #include "spanner.hh"
  15 #include "warn.hh"
  16 #include "paper-column.hh"
  17
  18 /*
  19   Grob descriptions (ie. alists with layout properties) are
  20   represented as a (ALIST . BASED-ON) pair, where BASED-ON is the
  21   alist defined in a parent context. BASED-ON should always be a tail
  22   of ALIST.
  23 */
  24
  25 /*
  26   Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL)
  27   entry from a translator property list by name of PROP
  28 */
  29
  30 void
  31 execute_pushpop_property (Context *trg,
  32                           SCM prop, SCM eltprop, SCM val)
  33 {
  34   if (scm_is_symbol (prop) && scm_is_symbol (eltprop))
  35     {
  36       if (val != SCM_UNDEFINED)
  37         {
  38           SCM prev = SCM_EOL;
  39           Context *where = trg->where_defined (prop);
  40
  41           /*
  42             Don't mess with MIDI.
  43           */
  44           if (!where)
  45             return;
  46
  47           if (where != trg)
  48             {
  49               SCM base = updated_grob_properties (trg, prop);
  50               prev = scm_cons (base, base);
  51               trg->internal_set_property (prop, prev);
  52             }
  53           else
  54             prev = trg->internal_get_property (prop);
  55
  56           if (!scm_is_pair (prev))
  57             {
  58               programming_error ("Grob definition should be cons");
  59               return;
  60             }
  61
  62           SCM prev_alist = scm_car (prev);
  63
  64           if (scm_is_pair (prev_alist) || prev_alist == SCM_EOL)
  65             {
  66               bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?"));
  67
  68               /*
  69                 tack onto alist:
  70               */
  71               if (ok)
  72                 scm_set_car_x (prev, scm_acons (eltprop, val, prev_alist));
  73             }
  74           else
  75             {
  76               // warning here.
  77             }
  78         }
  79       else if (trg->where_defined (prop) == trg)
  80         {
  81           SCM prev = trg->internal_get_property (prop);
  82           SCM prev_alist = scm_car (prev);
  83           SCM daddy = scm_cdr (prev);
  84
  85           SCM new_alist = SCM_EOL;
  86           SCM *tail = &new_alist;
  87
  88           while (prev_alist != daddy)
  89             {
  90               if (ly_is_equal (scm_caar (prev_alist), eltprop))
  91                 {
  92                   prev_alist = scm_cdr (prev_alist);
  93                   break;
  94                 }
  95
  96               *tail = scm_cons (scm_car (prev_alist), SCM_EOL);
  97               tail = SCM_CDRLOC (*tail);
  98               prev_alist = scm_cdr (prev_alist);
  99             }
 100
 101           if (new_alist == SCM_EOL && prev_alist == daddy)
 102             trg->unset_property (prop);
 103           else
 104             {
 105               *tail = prev_alist;
 106               trg->internal_set_property (prop, scm_cons (new_alist, daddy));
 107             }
 108         }
 109     }
 110   else
 111     {
 112       warning (_ ("need symbol arguments for \\override and \\revert"));
 113       if (do_internal_type_checking_global)
 114         assert (false);
 115     }
 116 }
 117
 118 /*
 119   PRE_INIT_OPS is in the order specified, and hence must be reversed.
 120 */
 121 void
 122 apply_property_operations (Context *tg, SCM pre_init_ops)
 123 {
 124   SCM correct_order = scm_reverse (pre_init_ops);
 125   for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s))
 126     {
 127       SCM entry = scm_car (s);
 128       SCM type = scm_car (entry);
 129       entry = scm_cdr (entry);
 130
 131       if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush"))
 132         {
 133           SCM val = scm_cddr (entry);
 134           val = scm_is_pair (val) ? scm_car (val) : SCM_UNDEFINED;
 135
 136           execute_pushpop_property (tg, scm_car (entry), scm_cadr (entry), val);
 137         }
 138       else if (type == ly_symbol2scm ("assign"))
 139         {
 140           tg->internal_set_property (scm_car (entry), scm_cadr (entry));
 141         }
 142     }
 143 }
 144
 145 /*
 146   Return the object alist for SYM, checking if its base in enclosing
 147   contexts has changed. The alist is updated if necessary.
 148 */
 149 SCM
 150 updated_grob_properties (Context *tg, SCM sym)
 151 {
 152   assert (scm_is_symbol (sym));
 153
 154   tg = tg->where_defined (sym);
 155   if (!tg)
 156     return SCM_EOL;
 157
 158   SCM daddy_props
 159     = (tg->get_parent_context ())
 160     ? updated_grob_properties (tg->get_parent_context (), sym)
 161     : SCM_EOL;
 162
 163   SCM props = tg->internal_get_property (sym);
 164
 165   if (!scm_is_pair (props))
 166     {
 167       programming_error ("grob props not a pair?");
 168       return SCM_EOL;
 169     }
 170
 171   SCM based_on = scm_cdr (props);
 172   if (based_on == daddy_props)
 173     {
 174       return scm_car (props);
 175     }
 176   else
 177     {
 178       SCM copy = daddy_props;
 179       SCM *tail = &copy;
 180       SCM p = scm_car (props);
 181       while (p != based_on)
 182         {
 183           *tail = scm_cons (scm_car (p), daddy_props);
 184           tail = SCM_CDRLOC (*tail);
 185           p = scm_cdr (p);
 186         }
 187
 188       scm_set_car_x (props, copy);
 189       scm_set_cdr_x (props, daddy_props);
 190
 191       return copy;
 192     }
 193 }
 194
 195 Grob *
 196 make_grob_from_properties (Engraver *tr, SCM symbol, SCM cause, const char *name)
 197 {
 198   Context *context = tr->context ();
 199
 200   SCM props = updated_grob_properties (context, symbol);
 201
 202   Object_key const *key = context->get_grob_key (name);
 203   Grob *grob = 0;
 204
 205   SCM handle = scm_sloppy_assq (ly_symbol2scm ("meta"), props);
 206   SCM klass = scm_cdr (scm_sloppy_assq (ly_symbol2scm ("class"), scm_cdr (handle)));
 207
 208   if (klass == ly_symbol2scm ("Item"))
 209     grob = new Item (props, key);
 210   else if (klass == ly_symbol2scm ("Spanner"))
 211     grob = new Spanner (props, key);
 212   else if (klass == ly_symbol2scm ("Paper_column"))
 213     grob = new Paper_column (props, key);
 214
 215   assert (grob);
 216   dynamic_cast<Engraver *> (tr)->announce_grob (grob, cause);
 217
 218   return grob;
 219 }
 220
 221 Item *
 222 make_item_from_properties (Engraver *tr, SCM x, SCM cause, const char *name)
 223 {
 224   Item *it = dynamic_cast<Item*> (make_grob_from_properties (tr, x, cause, name));
 225   assert (it);
 226   return it;
 227 }
 228
 229 Paper_column *
 230 make_paper_column_from_properties (Engraver *tr, SCM x, const char *name)
 231 {
 232   return dynamic_cast<Paper_column*> (make_grob_from_properties (tr, x, SCM_EOL, name));
 233 }
 234
 235
 236 Spanner *
 237 make_spanner_from_properties (Engraver *tr, SCM x, SCM cause, const char *name)
 238 {
 239   Spanner* sp = dynamic_cast<Spanner*> (make_grob_from_properties (tr, x, cause, name));
 240   assert (sp);
 241   return sp;
 242 }