lily/nested-property.cc

   1 #include "context.hh"
   2 #include "grob.hh"
   3
   4
   5 /*
   6   Drop symbol from the list alist..alist_end.
   7  */
   8 SCM
   9 evict_from_alist (SCM symbol, SCM alist, SCM alist_end)
  10 {
  11   SCM new_alist = SCM_EOL;
  12   SCM *tail = &new_alist;
  13
  14   while (alist != alist_end)
  15     {
  16       if (ly_is_equal (scm_caar (alist), symbol))
  17         {
  18           alist = scm_cdr (alist);
  19           break;
  20         }
  21
  22       *tail = scm_cons (scm_car (alist), SCM_EOL);
  23       tail = SCM_CDRLOC (*tail);
  24       alist = scm_cdr (alist);
  25     }
  26
  27   *tail = alist;
  28   return new_alist;
  29 }
  30
  31 /*
  32   PROP_PATH should be big-to-small ordering
  33  */
  34 SCM
  35 nested_property_alist (SCM alist, SCM prop_path, SCM value)
  36 {
  37   SCM new_value = SCM_BOOL_F;
  38   if (scm_is_pair (scm_cdr (prop_path)))
  39     {
  40       SCM sub_alist = ly_assoc_get (scm_car (prop_path), alist, SCM_EOL);
  41       new_value = nested_property_alist (sub_alist, scm_cdr (prop_path), value);
  42     }
  43   else
  44     {
  45       new_value = value;
  46     }
  47
  48   return scm_acons (scm_car (prop_path), new_value, alist);
  49 }
  50
  51 /*
  52   Recursively purge alist of prop_path:
  53
  54   revert ((sym, val) : L, [sym]) = L
  55   revert ((sym, val) : L, sym : props) =
  56     (sym, revert (val, rest-props)) ++ L
  57   revert ((sym, val) : L, p ++ rest-props) =
  58     (sym, val) : revert (L, p ++ rest-props)
  59
  60  */
  61 SCM
  62 nested_property_revert_alist (SCM alist, SCM prop_path)
  63 {
  64   int copy_count = 0;
  65   bool drop = false;
  66   assert(scm_is_pair (prop_path));
  67
  68   SCM wanted_sym = scm_car (prop_path);
  69
  70   SCM new_list = SCM_EOL;
  71   SCM *tail = &new_list;
  72   for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
  73     {
  74       SCM sub_sym = scm_caar (s);
  75       SCM old_val = scm_cdar (s);
  76       drop = false;
  77
  78       if (sub_sym == wanted_sym)
  79         {
  80           if (scm_is_pair (scm_cdr (prop_path)))
  81             {
  82               SCM new_val = nested_property_revert_alist (old_val, scm_cdr (prop_path));
  83
  84               /* nothing changed: drop newly constructed list. */
  85               if (old_val == new_val)
  86                 return alist;
  87
  88               *tail = scm_acons (sub_sym, new_val, SCM_EOL);
  89               tail = SCM_CDRLOC(*tail);
  90               *tail = scm_cdr (s);
  91               return new_list;
  92             }
  93           else
  94             {
  95               /* old value should be dropped only if we have another copy of it in the alist */
  96               copy_count++;
  97               /*
  98                 Only drop the first instance found.
  99                 the overridden value is always the first
 100                 if this was the only copy, we will return
 101                 the original list anyways so it is not relevant
 102                 if we drop this pair
 103               */
 104               if (copy_count == 1)
 105                 drop = true;
 106             }
 107           /* we now iterate over every item */
 108         }
 109       /*
 110         Make a new list with every item
 111         except for the eventual dropped one
 112       */
 113       if (!drop)
 114         {
 115           *tail = scm_acons (sub_sym, old_val, SCM_EOL);
 116           tail = SCM_CDRLOC (*tail);
 117         }
 118     }
 119
 120   /*
 121     If we find more than one copy of the property
 122     push the new list, else it means we are trying to
 123     revert the original value
 124   */
 125   if (copy_count > 1)
 126     return new_list;
 127   else
 128     return alist;
 129 }
 130
 131
 132 void
 133 set_nested_property (Grob *me, SCM big_to_small, SCM value)
 134 {
 135   SCM alist = me->get_property (scm_car (big_to_small));
 136
 137   alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
 138
 139   me->set_property (scm_car (big_to_small), alist);
 140 }
 141