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         {
 137           tg->internal_set_property (scm_car (entry), scm_cadr (entry));
 138         }
 139     }
 140 }
 141
 142 /*
 143   Return the object alist for SYM, checking if its base in enclosing
 144   contexts has changed. The alist is updated if necessary.
 145 */
 146 SCM
 147 updated_grob_properties (Context *tg, SCM sym)
 148 {
 149   assert (scm_is_symbol (sym));
 150
 151   SCM props;
 152   tg = tg->where_defined (sym, &props);
 153   if (!tg)
 154     return SCM_EOL;
 155
 156   SCM daddy_props
 157     = (tg->get_parent_context ())
 158     ? updated_grob_properties (tg->get_parent_context (), sym)
 159     : SCM_EOL;
 160
 161   if (!scm_is_pair (props))
 162     {
 163       programming_error ("grob props not a pair?");
 164       return SCM_EOL;
 165     }
 166
 167   SCM based_on = scm_cdr (props);
 168   if (based_on == daddy_props)
 169     {
 170       return scm_car (props);
 171     }
 172   else
 173     {
 174       SCM copy = daddy_props;
 175       SCM *tail = &copy;
 176       SCM p = scm_car (props);
 177       while (p != based_on)
 178         {
 179           *tail = scm_cons (scm_car (p), daddy_props);
 180           tail = SCM_CDRLOC (*tail);
 181           p = scm_cdr (p);
 182         }
 183
 184       scm_set_car_x (props, copy);
 185       scm_set_cdr_x (props, daddy_props);
 186
 187       return copy;
 188     }
 189 }
 190
 191 Grob *
 192 make_grob_from_properties (Engraver *tr, SCM symbol, SCM cause, const char *name)
 193 {
 194   Context *context = tr->context ();
 195
 196   SCM props = updated_grob_properties (context, symbol);
 197
 198   Object_key const *key = context->get_grob_key (name);
 199   Grob *grob = 0;
 200
 201   SCM handle = scm_sloppy_assq (ly_symbol2scm ("meta"), props);
 202   SCM klass = scm_cdr (scm_sloppy_assq (ly_symbol2scm ("class"), scm_cdr (handle)));
 203
 204   if (klass == ly_symbol2scm ("Item"))
 205     grob = new Item (props, key);
 206   else if (klass == ly_symbol2scm ("Spanner"))
 207     grob = new Spanner (props, key);
 208   else if (klass == ly_symbol2scm ("Paper_column"))
 209     grob = new Paper_column (props, key);
 210
 211   assert (grob);
 212   dynamic_cast<Engraver *> (tr)->announce_grob (grob, cause);
 213
 214   return grob;
 215 }
 216
 217 Item *
 218 make_item_from_properties (Engraver *tr, SCM x, SCM cause, const char *name)
 219 {
 220   Item *it = dynamic_cast<Item*> (make_grob_from_properties (tr, x, cause, name));
 221   assert (it);
 222   return it;
 223 }
 224
 225 Paper_column *
 226 make_paper_column_from_properties (Engraver *tr, SCM x, const char *name)
 227 {
 228   return dynamic_cast<Paper_column*> (make_grob_from_properties (tr, x, SCM_EOL, name));
 229 }
 230
 231
 232 Spanner *
 233 make_spanner_from_properties (Engraver *tr, SCM x, SCM cause, const char *name)
 234 {
 235   Spanner* sp = dynamic_cast<Spanner*> (make_grob_from_properties (tr, x, cause, name));
 236   assert (sp);
 237   return sp;
 238 }