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   assert(scm_is_pair (prop_path));
  65
  66   SCM wanted_sym = scm_car (prop_path);
  67
  68   SCM new_list = SCM_EOL;
  69   SCM *tail = &new_list;
  70   for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
  71     {
  72       SCM sub_sym = scm_caar (s);
  73       SCM old_val = scm_cdar (s);
  74
  75       if (sub_sym == wanted_sym)
  76         {
  77           if (scm_is_pair (scm_cdr (prop_path)))
  78             {
  79               SCM new_val = nested_property_revert_alist (old_val, scm_cdr (prop_path));
  80
  81               /* nothing changed: drop newly constructed list. */
  82               if (old_val == new_val)
  83                 return alist;
  84
  85               *tail = scm_acons (sub_sym, new_val, SCM_EOL);
  86               tail = SCM_CDRLOC(*tail);
  87             }
  88           else
  89             {
  90               /* old value is dropped. */
  91             }
  92
  93           *tail = scm_cdr (s);
  94           return new_list;
  95         }
  96
  97       *tail = scm_acons (sub_sym, old_val, SCM_EOL);
  98       tail = SCM_CDRLOC (*tail);
  99     }
 100
 101   /* Wanted symbol not found: drop newly constructed list. */
 102   return alist;
 103 }
 104
 105
 106 void
 107 set_nested_property (Grob *me, SCM big_to_small, SCM value)
 108 {
 109   SCM alist = me->get_property (scm_car (big_to_small));
 110
 111   alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
 112
 113   me->set_property (scm_car (big_to_small), alist);
 114 }
 115