1 /*
2   This file is part of LilyPond, the GNU music typesetter.
3 
4   Copyright (C) 1998--2020 Jan Nieuwenhuizen <janneke@gnu.org>
5   Han-Wen Nienhuys <hanwen@xs4all.nl>
6 
7   LilyPond is free software: you can redistribute it and/or modify
8   it under the terms of the GNU General Public License as published by
9   the Free Software Foundation, either version 3 of the License, or
10   (at your option) any later version.
11 
12   LilyPond is distributed in the hope that it will be useful,
13   but WITHOUT ANY WARRANTY; without even the implied warranty of
14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15   GNU General Public License for more details.
16 
17   You should have received a copy of the GNU General Public License
18   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
19 */
20 
21 #include "context.hh"
22 #include "context-def.hh"
23 #include "dispatcher.hh"
24 #include "grob-properties.hh"
25 
26 LY_DEFINE (ly_context_current_moment,
27            "ly:context-current-moment",
28            1, 0, 0, (SCM context),
29            "Return the current moment of @var{context}.")
30 {
31   Context *tr = unsmob<Context> (context);
32 
33   LY_ASSERT_SMOB (Context, context, 1);
34 
35   return tr->now_mom ().smobbed_copy ();
36 }
37 
38 LY_DEFINE (ly_context_id, "ly:context-id",
39            1, 0, 0, (SCM context),
40            "Return the ID string of @var{context},"
41            " i.e., for @code{\\context Voice = \"one\" @dots{}}"
42            " return the string @code{one}.")
43 {
44   Context *tr = unsmob<Context> (context);
45 
46   LY_ASSERT_SMOB (Context, context, 1);
47 
48   return ly_string2scm (tr->id_string ());
49 }
50 
51 LY_DEFINE (ly_context_name, "ly:context-name",
52            1, 0, 0, (SCM context),
53            "Return the name of @var{context},"
54            " i.e., for @code{\\context Voice = \"one\" @dots{}}"
55            " return the symbol @code{Voice}.")
56 {
57   LY_ASSERT_SMOB (Context, context, 1);
58 
59   Context *tr = unsmob<Context> (context);
60 
61   return ly_symbol2scm (tr->context_name ().c_str ());
62 }
63 
64 LY_DEFINE (ly_context_grob_definition, "ly:context-grob-definition",
65            2, 0, 0, (SCM context, SCM name),
66            "Return the definition of @var{name} (a symbol) within"
67            " @var{context} as an alist.")
68 {
69   Context *tr = unsmob<Context> (context);
70 
71   LY_ASSERT_SMOB (Context, context, 1);
72   LY_ASSERT_TYPE (ly_is_symbol, name, 2);
73 
74   return Grob_property_info (tr, name).updated ();
75 }
76 
77 LY_DEFINE (ly_context_pushpop_property, "ly:context-pushpop-property",
78            3, 1, 0, (SCM context, SCM grob, SCM eltprop, SCM val),
79            "Do @code{\\temporary \\override} or @code{\\revert} operation"
80            " in @var{context}.  The grob definition @var{grob} is extended"
81            " with @var{eltprop} (if @var{val} is specified) or reverted"
82            " (if unspecified).")
83 {
84   Context *tg = unsmob<Context> (context);
85 
86   LY_ASSERT_SMOB (Context, context, 1);
87   LY_ASSERT_TYPE (ly_is_symbol, grob, 2);
88   LY_ASSERT_TYPE (ly_is_symbol, eltprop, 3);
89 
90   execute_pushpop_property (tg, grob, eltprop, val);
91 
92   return SCM_UNSPECIFIED;
93 }
94 
95 LY_DEFINE (ly_context_matched_pop_property, "ly:context-matched-pop-property",
96            3, 0, 0, (SCM context, SCM grob, SCM cell),
97            "This undoes a particular @code{\\override},"
98            " @code{\\once \\override} or @code{\\once \\revert}"
99            " when given the specific alist pair to undo.")
100 {
101   Context *tg = LY_ASSERT_SMOB (Context, context, 1);
102   LY_ASSERT_TYPE (ly_is_symbol, grob, 2);
103   Grob_property_info (tg, grob).matched_pop (cell);
104   return SCM_UNSPECIFIED;
105 }
106 
107 LY_DEFINE (ly_context_property, "ly:context-property",
108            2, 1, 0, (SCM context, SCM sym, SCM def),
109            "Return the value for property @var{sym} in @var{context}."
110            " If @var{def} is given, and property value is @code{'()},"
111            " return @var{def}.")
112 {
113   LY_ASSERT_SMOB (Context, context, 1);
114   LY_ASSERT_TYPE (ly_is_symbol, sym, 2);
115 
116   Context *t = unsmob<Context> (context);
117   SCM result = get_property (t, sym);
118   return !SCM_UNBNDP (def) && scm_is_null (result) ? def : result;
119 }
120 
121 LY_DEFINE (ly_context_set_property_x, "ly:context-set-property!",
122            3, 0, 0, (SCM context, SCM name, SCM val),
123            "Set value of property @var{name} in context @var{context}"
124            " to @var{val}.")
125 {
126   LY_ASSERT_SMOB (Context, context, 1);
127   LY_ASSERT_TYPE (ly_is_symbol, name, 2);
128 
129   Context *tr = unsmob<Context> (context);
130 
131   set_property (tr, name, val);
132 
133   return SCM_UNSPECIFIED;
134 }
135 
136 LY_DEFINE (ly_context_property_where_defined, "ly:context-property-where-defined",
137            2, 0, 0, (SCM context, SCM name),
138            "Return the context above @var{context}"
139            " where @var{name} is defined.")
140 {
141   LY_ASSERT_SMOB (Context, context, 1);
142   LY_ASSERT_TYPE (ly_is_symbol, name, 2);
143 
144   Context *tr = unsmob<Context> (context);
145 
146   SCM val;
147   tr = tr->where_defined (name, &val);
148   if (tr)
149     return tr->self_scm ();
150 
151   return SCM_EOL;
152 }
153 
154 LY_DEFINE (ly_context_unset_property, "ly:context-unset-property", 2, 0, 0,
155            (SCM context, SCM name),
156            "Unset value of property @var{name} in context @var{context}.")
157 {
158   LY_ASSERT_SMOB (Context, context, 1);
159   LY_ASSERT_TYPE (ly_is_symbol, name, 2);
160   Context *tr = unsmob<Context> (context);
161 
162   tr->unset_property (name);
163   return SCM_UNSPECIFIED;
164 }
165 
166 LY_DEFINE (ly_context_parent, "ly:context-parent",
167            1, 0, 0, (SCM context),
168            "Return the parent of @var{context}, @code{#f} if none.")
169 {
170   LY_ASSERT_SMOB (Context, context, 1);
171   Context *tr = unsmob<Context> (context);
172 
173   tr = tr->get_parent ();
174   if (tr)
175     return tr->self_scm ();
176   else
177     return SCM_BOOL_F;
178 }
179 
180 /* FIXME: todo: should support translator IDs, and creation? */
181 LY_DEFINE (ly_context_find, "ly:context-find",
182            2, 0, 0, (SCM context, SCM name),
183            "Find a parent of @var{context} that has name or alias @var{name}."
184            "  Return @code{#f} if not found.")
185 {
186   LY_ASSERT_SMOB (Context, context, 1);
187   LY_ASSERT_TYPE (ly_is_symbol, name, 2);
188   Context *tr = unsmob<Context> (context);
189   tr = find_context_above (tr, name);
190   return tr ? tr->self_scm () : SCM_BOOL_F;
191 }
192 
193 LY_DEFINE (ly_context_now, "ly:context-now",
194            1, 0, 0, (SCM context),
195            "Return @code{now-moment} of context @var{context}.")
196 {
197   LY_ASSERT_SMOB (Context, context, 1);
198   Context *ctx = unsmob<Context> (context);
199   return ctx->now_mom ().smobbed_copy ();
200 }
201 
202 LY_DEFINE (ly_context_event_source, "ly:context-event-source",
203            1, 0, 0, (SCM context),
204            "Return @code{event-source} of context @var{context}.")
205 {
206   LY_ASSERT_SMOB (Context, context, 1);
207   Context *ctx = unsmob<Context> (context);
208   return ctx->event_source ()->self_scm ();
209 }
210 
211 LY_DEFINE (ly_context_events_below, "ly:context-events-below",
212            1, 0, 0, (SCM context),
213            "Return a @code{stream-distributor} that distributes all events"
214            " from @var{context} and all its subcontexts.")
215 {
216   LY_ASSERT_SMOB (Context, context, 1);
217   Context *ctx = unsmob<Context> (context);
218   return ctx->events_below ()->self_scm ();
219 }
220