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