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