]> git.donarmstrong.com Git - lilypond.git/blob - lily/nested-property.cc
Doc-es: update Vocal.
[lilypond.git] / 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 }