lily/nested-property.cc

   1 #include "context.hh"
   2 #include "grob.hh"
   3
   4 /*
   5   Drop symbol from the list alist..alist_end.
   6  */
   7 SCM
   8 evict_from_alist (SCM symbol, SCM alist, SCM alist_end)
   9 {
  10   SCM new_alist = SCM_EOL;
  11   SCM *tail = &new_alist;
  12
  13   while (alist != alist_end)
  14     {
  15       if (ly_is_equal (scm_caar (alist), symbol))
  16         {
  17           alist = scm_cdr (alist);
  18           break;
  19         }
  20
  21       *tail = scm_cons (scm_car (alist), SCM_EOL);
  22       tail = SCM_CDRLOC (*tail);
  23       alist = scm_cdr (alist);
  24     }
  25
  26   *tail = alist;
  27   return new_alist;
  28 }
  29
  30 /*
  31   PROP_PATH should be big-to-small ordering
  32  */
  33 SCM
  34 nested_property_alist (SCM alist, SCM prop_path, SCM value)
  35 {
  36   SCM new_value = SCM_BOOL_F;
  37   if (scm_is_pair (scm_cdr (prop_path)))
  38     {
  39       SCM sub_alist = ly_assoc_get (scm_car (prop_path), alist, SCM_EOL);
  40       new_value = nested_property_alist (sub_alist, scm_cdr (prop_path), value);
  41     }
  42   else
  43     {
  44       new_value = value;
  45     }
  46
  47   return scm_acons (scm_car (prop_path), new_value, alist);
  48 }
  49
  50 /*
  51   Recursively purge alist of prop_path:
  52
  53   revert ((sym, val) : L, [sym]) = L
  54   revert ((sym, val) : L, sym : props) =
  55     (sym, revert (val, rest-props)) ++ L
  56   revert ((sym, val) : L, p ++ rest-props) =
  57     (sym, val) : revert (L, p ++ rest-props)
  58
  59  */
  60 SCM
  61 nested_property_revert_alist (SCM alist, SCM prop_path)
  62 {
  63   assert (scm_is_pair (prop_path));
  64
  65   SCM wanted_sym = scm_car (prop_path);
  66
  67   SCM new_list = SCM_EOL;
  68   SCM *tail = &new_list;
  69   for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
  70     {
  71       SCM sub_sym = scm_caar (s);
  72       SCM old_val = scm_cdar (s);
  73
  74       if (sub_sym == wanted_sym)
  75         {
  76           if (scm_is_pair (scm_cdr (prop_path)))
  77             {
  78               SCM new_val = nested_property_revert_alist (old_val, scm_cdr (prop_path));
  79
  80               /* nothing changed: drop newly constructed list. */
  81               if (old_val == new_val)
  82                 return alist;
  83
  84               *tail = scm_acons (sub_sym, new_val, SCM_EOL);
  85               tail = SCM_CDRLOC (*tail);
  86             }
  87           else
  88             {
  89               /* old value is dropped. */
  90             }
  91
  92           *tail = scm_cdr (s);
  93           return new_list;
  94         }
  95
  96       *tail = scm_acons (sub_sym, old_val, SCM_EOL);
  97       tail = SCM_CDRLOC (*tail);
  98     }
  99
 100   /* Wanted symbol not found: drop newly constructed list. */
 101   return alist;
 102 }
 103
 104 void
 105 set_nested_property (Grob *me, SCM big_to_small, SCM value)
 106 {
 107   SCM alist = me->get_property (scm_car (big_to_small));
 108
 109   alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
 110
 111   me->set_property (scm_car (big_to_small), alist);
 112 }