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   SCM prev = SCM_EOL;
  35   if (scm_is_symbol (prop) && scm_is_symbol (eltprop))
  36     {
  37       if (val != SCM_UNDEFINED)
  38         {
  39           Context *where = trg->where_defined (prop, &prev);
  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
  54           if (!scm_is_pair (prev))
  55             {
  56               programming_error ("Grob definition should be cons");
  57               return;
  58             }
  59
  60           SCM prev_alist = scm_car (prev);
  61
  62           if (scm_is_pair (prev_alist) || prev_alist == SCM_EOL)
  63             {
  64               bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?"));
  65
  66               /*
  67                 tack onto alist:
  68               */
  69               if (ok)
  70                 scm_set_car_x (prev, scm_acons (eltprop, val, prev_alist));
  71             }
  72           else
  73             {
  74               // warning here.
  75             }
  76         }
  77       else if (trg->where_defined (prop, &prev) == trg)
  78         {
  79           SCM prev_alist = scm_car (prev);
  80           SCM daddy = scm_cdr (prev);
  81
  82           SCM new_alist = SCM_EOL;
  83           SCM *tail = &new_alist;
  84
  85           while (prev_alist != daddy)
  86             {
  87               if (ly_is_equal (scm_caar (prev_alist), eltprop))
  88                 {
  89                   prev_alist = scm_cdr (prev_alist);
  90                   break;
  91                 }
  92
  93               *tail = scm_cons (scm_car (prev_alist), SCM_EOL);
  94               tail = SCM_CDRLOC (*tail);
  95               prev_alist = scm_cdr (prev_alist);
  96             }
  97
  98           if (new_alist == SCM_EOL && prev_alist == daddy)
  99             trg->unset_property (prop);
 100           else
 101             {
 102               *tail = prev_alist;
 103               trg->internal_set_property (prop, scm_cons (new_alist, daddy));
 104             }
 105         }
 106     }
 107   else
 108     {
 109       warning (_ ("need symbol arguments for \\override and \\revert"));
 110       if (do_internal_type_checking_global)
 111         assert (false);
 112     }
 113 }
 114
 115 /*
 116   PRE_INIT_OPS is in the order specified, and hence must be reversed.
 117 */
 118 void
 119 apply_property_operations (Context *tg, SCM pre_init_ops)
 120 {
 121   SCM correct_order = scm_reverse (pre_init_ops);
 122   for (SCM s = correct_order; scm_is_pair (s); s = scm_cdr (s))
 123     {
 124       SCM entry = scm_car (s);
 125       SCM type = scm_car (entry);
 126       entry = scm_cdr (entry);
 127
 128       if (type == ly_symbol2scm ("push") || type == ly_symbol2scm ("poppush"))
 129         {
 130           SCM val = scm_cddr (entry);
 131           val = scm_is_pair (val) ? scm_car (val) : SCM_UNDEFINED;
 132
 133           execute_pushpop_property (tg, scm_car (entry), scm_cadr (entry), val);
 134         }
 135       else if (type == ly_symbol2scm ("assign"))
 136         tg->internal_set_property (scm_car (entry), scm_cadr (entry));
 137     }
 138 }
 139
 140 /*
 141   Return the object alist for SYM, checking if its base in enclosing
 142   contexts has changed. The alist is updated if necessary.
 143 */
 144 SCM
 145 updated_grob_properties (Context *tg, SCM sym)
 146 {
 147   assert (scm_is_symbol (sym));
 148
 149   SCM props;
 150   tg = tg->where_defined (sym, &props);
 151   if (!tg)
 152     return SCM_EOL;
 153
 154   SCM daddy_props
 155     = (tg->get_parent_context ())
 156     ? updated_grob_properties (tg->get_parent_context (), sym)
 157     : SCM_EOL;
 158
 159   if (!scm_is_pair (props))
 160     {
 161       programming_error ("grob props not a pair?");
 162       return SCM_EOL;
 163     }
 164
 165   SCM based_on = scm_cdr (props);
 166   if (based_on == daddy_props)
 167     {
 168       return scm_car (props);
 169     }
 170   else
 171     {
 172       SCM copy = daddy_props;
 173       SCM *tail = &copy;
 174       SCM p = scm_car (props);
 175       while (p != based_on)
 176         {
 177           *tail = scm_cons (scm_car (p), daddy_props);
 178           tail = SCM_CDRLOC (*tail);
 179           p = scm_cdr (p);
 180         }
 181
 182       scm_set_car_x (props, copy);
 183       scm_set_cdr_x (props, daddy_props);
 184
 185       return copy;
 186     }
 187 }
 188
 189 Grob *
 190 make_grob_from_properties (Engraver *tr, SCM symbol, SCM cause, char const *name)
 191 {
 192   Context *context = tr->context ();
 193
 194   SCM props = updated_grob_properties (context, symbol);
 195
 196   Object_key const *key = context->get_grob_key (name);
 197   Grob *grob = 0;
 198
 199   SCM handle = scm_sloppy_assq (ly_symbol2scm ("meta"), props);
 200   SCM klass = scm_cdr (scm_sloppy_assq (ly_symbol2scm ("class"), scm_cdr (handle)));
 201
 202   if (klass == ly_symbol2scm ("Item"))
 203     grob = new Item (props, key);
 204   else if (klass == ly_symbol2scm ("Spanner"))
 205     grob = new Spanner (props, key);
 206   else if (klass == ly_symbol2scm ("Paper_column"))
 207     grob = new Paper_column (props, key);
 208
 209   assert (grob);
 210   dynamic_cast<Engraver *> (tr)->announce_grob (grob, cause);
 211
 212   return grob;
 213 }
 214
 215 Item *
 216 make_item_from_properties (Engraver *tr, SCM x, SCM cause, char const *name)
 217 {
 218   Item *it = dynamic_cast<Item *> (make_grob_from_properties (tr, x, cause, name));
 219   assert (it);
 220   return it;
 221 }
 222
 223 Paper_column *
 224 make_paper_column_from_properties (Engraver *tr, SCM x, char const *name)
 225 {
 226   return dynamic_cast<Paper_column *> (make_grob_from_properties (tr, x, SCM_EOL, name));
 227 }
 228
 229 Spanner *
 230 make_spanner_from_properties (Engraver *tr, SCM x, SCM cause, char const *name)
 231 {
 232   Spanner *sp = dynamic_cast<Spanner *> (make_grob_from_properties (tr, x, cause, name));
 233   assert (sp);
 234   return sp;
 235 }