lily/translator-property.cc

   1 /*
   2    translator-property.cc --  implement manipulation of
   3
   4    immutable Grob property lists.
   5
   6    source file of the GNU LilyPond music typesetter
   7
   8    (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
   9  */
  10
  11 #include "main.hh"
  12 #include "context.hh"
  13 #include "warn.hh"
  14 #include "item.hh"
  15 #include "spanner.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 /*
  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
  31 void
  32 execute_pushpop_property (Context * trg,
  33                           SCM prop, SCM eltprop, SCM val)
  34 {
  35   if (gh_symbol_p (prop) && gh_symbol_p (eltprop))
  36     {
  37       if (val != SCM_UNDEFINED)
  38         {
  39           SCM prev = SCM_EOL;
  40           Context * where = trg->where_defined (prop);
  41
  42           /*
  43             Don't mess with MIDI.
  44            */
  45           if (!where)
  46             return ;
  47
  48           if (where != trg)
  49             {
  50               SCM base = updated_grob_properties (trg, prop);
  51               prev = gh_cons (base, base);
  52               trg->internal_set_property (prop, prev);
  53             }
  54           else
  55             prev = trg->internal_get_property (prop);
  56
  57           if (!gh_pair_p (prev))
  58             {
  59               programming_error ("Grob definition should be cons.");
  60               return ;
  61             }
  62
  63           SCM prev_alist = gh_car (prev);
  64
  65           if (gh_pair_p (prev_alist) || prev_alist == SCM_EOL)
  66             {
  67               bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?"));
  68
  69               /*
  70                tack onto alist:
  71               */
  72               if (ok)
  73                 gh_set_car_x (prev, scm_acons (eltprop, val, prev_alist));
  74             }
  75           else
  76             {
  77               // warning here.
  78             }
  79         }
  80       else if (trg->where_defined (prop) == trg)
  81         {
  82           SCM prev = trg->internal_get_property (prop);
  83           SCM prev_alist = gh_car (prev);
  84           SCM daddy = gh_cdr (prev);
  85
  86           SCM new_alist = SCM_EOL;
  87           SCM *tail = &new_alist;
  88
  89           while (prev_alist != daddy)
  90             {
  91               if (gh_equal_p (gh_caar (prev_alist), eltprop))
  92                 {
  93                   prev_alist = gh_cdr (prev_alist);
  94                   break ;
  95                 }
  96
  97
  98               *tail = gh_cons (gh_car (prev_alist), SCM_EOL);
  99               tail = SCM_CDRLOC (*tail);
 100               prev_alist = gh_cdr (prev_alist);
 101             }
 102
 103           if (new_alist == SCM_EOL && prev_alist == daddy)
 104             trg->unset_property (prop);
 105           else
 106             {
 107               *tail = prev_alist;
 108               trg->internal_set_property (prop, gh_cons (new_alist, daddy));
 109             }
 110         }
 111     }
 112   else
 113     {
 114       warning ("Need symbol arguments for \\override and \\revert");
 115       if (internal_type_checking_global_b)
 116         assert (false);
 117     }
 118 }
 119
 120 /*
 121   PRE_INIT_OPS is in the order specified, and hence must be reversed.
 122  */
 123 void
 124 apply_property_operations (Context *tg, SCM pre_init_ops)
 125 {
 126   SCM correct_order = scm_reverse (pre_init_ops);
 127   for (SCM s = correct_order; gh_pair_p (s); s = ly_cdr (s))
 128     {
 129       SCM entry = ly_car (s);
 130       SCM type = ly_car (entry);
 131       entry = ly_cdr (entry);
 132
 133       if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush"))
 134         {
 135           SCM val = ly_cddr (entry);
 136           val = gh_pair_p (val) ? ly_car (val) : SCM_UNDEFINED;
 137
 138           execute_pushpop_property (tg, ly_car (entry), ly_cadr (entry), val);
 139         }
 140       else if (type == ly_symbol2scm ("assign"))
 141         {
 142           tg->internal_set_property (ly_car (entry), ly_cadr (entry));
 143         }
 144     }
 145 }
 146
 147 /*
 148   Return the object alist for SYM, checking if its base in enclosing
 149   contexts has changed. The alist is updated if necessary.
 150    */
 151 SCM
 152 updated_grob_properties (Context * tg, SCM sym)
 153 {
 154   assert (gh_symbol_p (sym));
 155
 156   tg = tg->where_defined (sym);
 157   if (!tg)
 158     return SCM_EOL;
 159
 160   SCM daddy_props
 161     = (tg->daddy_context_)
 162     ? updated_grob_properties (tg->daddy_context_, sym)
 163     : SCM_EOL;
 164
 165   SCM props  = tg->internal_get_property (sym);
 166
 167   if (!gh_pair_p (props))
 168     {
 169       programming_error ("grob props not a pair?");
 170       return SCM_EOL;
 171     }
 172
 173   SCM based_on = gh_cdr (props);
 174   if (based_on == daddy_props)
 175     {
 176       return gh_car (props);
 177     }
 178   else
 179     {
 180       SCM copy = daddy_props;
 181       SCM * tail = &copy;
 182       SCM p = gh_car (props);
 183       while  (p != based_on)
 184         {
 185           *tail = gh_cons (gh_car (p), daddy_props);
 186           tail = SCM_CDRLOC (*tail);
 187           p = SCM_CDR (p);
 188         }
 189
 190       scm_set_car_x (props, copy);
 191       scm_set_cdr_x (props, daddy_props);
 192
 193       return copy;
 194     }
 195 }
 196
 197 Item*
 198 make_item_from_properties (Context * tg, SCM x)
 199 {
 200   SCM props = updated_grob_properties (tg, x);
 201   return new Item (props);
 202 }
 203
 204 Spanner*
 205 make_spanner_from_properties (Context *tg, SCM x)
 206 {
 207   SCM props = updated_grob_properties (tg, x);
 208   return new Spanner (props);
 209 }
 210