2 translator-scheme.cc -- implement Scheme context functions
4 source file of the GNU LilyPond music typesetter
6 (c) 2002--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "translator.hh"
11 #include "context-def.hh"
13 #include "translator-group.hh"
14 #include "lily-guile.hh"
16 LY_DEFINE(ly_get_context_property,
17 "ly:get-context-property", 2, 0, 0,
18 (SCM context, SCM name),
19 "retrieve the value of @var{name} from context @var{context}")
21 Translator *t = unsmob_translator (context);
22 Translator_group* tr= dynamic_cast<Translator_group*> (t);
23 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group");
24 SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
26 return tr->internal_get_property (name);
30 LY_DEFINE(ly_set_context_property,
31 "ly:set-context-property!", 3, 0, 0,
32 (SCM context, SCM name, SCM val),
33 "set value of property @var{name} in context @var{context} to @var{val}.")
35 Translator *t = unsmob_translator (context);
36 Translator_group* tr= dynamic_cast<Translator_group*> (t);
38 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
39 SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
41 tr->internal_set_property (name, val);
43 return SCM_UNSPECIFIED;
47 LY_DEFINE(ly_context_property_where_defined,
48 "ly:context-property-where-defined", 2, 0, 0,
49 (SCM context, SCM name),
50 "Return the context above @var{context} where @var{name} is defined.")
52 Translator *t = unsmob_translator (context);
53 Translator_group* tr = dynamic_cast<Translator_group*> (t);
54 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
55 SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
58 tr = tr->where_defined (name);
61 return tr->self_scm();
66 LY_DEFINE(ly_unset_context_property,
67 "ly:unset-context-property", 2, 0, 0,
68 (SCM context, SCM name),
69 "Unset value of property @var{name} in context @var{context}.")
71 Translator *t = unsmob_translator (context);
72 Translator_group* tr = dynamic_cast<Translator_group*> (t);
73 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
74 SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
76 tr->unset_property (name);
78 return SCM_UNSPECIFIED;
83 LY_DEFINE(ly_context_parent,
84 "ly:context-parent", 1, 0, 0,
86 "Return the parent of @var{context}, #f if none.")
88 Translator *t = unsmob_translator (context);
89 Translator_group* tr= dynamic_cast<Translator_group*> (t);
91 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
93 tr = tr->daddy_trans_ ;
95 return tr->self_scm();
101 Todo: should support translator IDs, and creation?
103 LY_DEFINE(ly_translator_find,
104 "ly:translator-find", 2, 0,0,
105 (SCM context, SCM name),
106 "Find a parent of @var{context} that has name or alias @var{name}. "
107 "Return @code{#f} if not found." )
109 Translator_group* tr= dynamic_cast<Translator_group*> ( unsmob_translator (context));
111 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "context");
112 SCM_ASSERT_TYPE(gh_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
116 if (tr->is_alias (name))
117 return tr->self_scm();
118 tr = tr->daddy_trans_ ;
125 LY_DEFINE(ly_context_properties,
126 "ly:context-properties", 1, 0, 0,
128 "Return all properties of @var{context} in an alist.")
130 Translator *t = unsmob_translator (context);
131 Translator_group* tr= dynamic_cast<Translator_group*> (t);
133 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
135 return tr->properties_as_alist ();
140 LY_DEFINE(ly_translator_name,
141 "ly:translator-name", 1,0,0, (SCM trans),
142 "Return the type name of the translator object @var{trans}. The name is a symbol.")
144 Translator * tr = unsmob_translator (trans);
145 SCM_ASSERT_TYPE(tr, trans, SCM_ARG1, __FUNCTION__, "Translator");
147 char const* nm = classname (tr);
148 return ly_symbol2scm (nm);
152 LY_DEFINE(ly_context_id,
153 "ly:context-id", 1,0,0, (SCM context),
154 "Return the id string of @var{context}, i.e. for @code{\\context Voice "
155 "= one .. } it will return the string @code{one}.")
157 Translator_group* tr = dynamic_cast<Translator_group*> (unsmob_translator (context));
158 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
160 return scm_makfrom0str (tr->id_string_. to_str0 ());
164 LY_DEFINE(ly_context_name,
165 "ly:context-name", 1,0,0, (SCM context),
166 "Return the name of @var{context}, i.e. for @code{\\context Voice "
167 "= one .. } it will return the symbol @code{Voice}.")
169 Translator_group* tr = dynamic_cast<Translator_group*> (unsmob_translator (context));
170 SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Context");
172 return unsmob_context_def (tr->definition_)->get_context_name ();
176 LY_DEFINE(ly_translator_description,
177 "ly:translator-description",
179 "Return an alist of properties of translator @var{me}.")
181 Translator *tr =unsmob_translator (me);
182 SCM_ASSERT_TYPE (tr, me, SCM_ARG1, __FUNCTION__, "Context");
184 return tr->translator_description ();
188 LY_DEFINE(ly_context_pushpop_property,
189 "ly:context-pushpop-property", 3, 1, 0,
190 (SCM context, SCM grob, SCM eltprop, SCM val),
191 "Do a single @code{\\override} or @code{\\revert} operation "
192 "in @var{context}. The grob definition @code{grob} is extended with "
193 "@code{eltprop} (if @var{val} is specified) "
194 "or reverted (if unspecified).")
196 Translator_group *tg = dynamic_cast<Translator_group*> (unsmob_translator (context));
198 SCM_ASSERT_TYPE(tg, context, SCM_ARG1, __FUNCTION__, "context");
199 SCM_ASSERT_TYPE(gh_symbol_p (grob), grob, SCM_ARG2, __FUNCTION__, "symbol");
200 SCM_ASSERT_TYPE(gh_symbol_p (eltprop), eltprop, SCM_ARG3, __FUNCTION__, "symbol");
202 tg->execute_pushpop_property (grob, eltprop, val);
204 return SCM_UNDEFINED;
207 LY_DEFINE(ly_context_p,
208 "ly:context?", 1, 0, 0,
210 "Type predicate: is @var{x} a context?")
212 Translator_group *tg = dynamic_cast<Translator_group*> (unsmob_translator (x));
214 return SCM_BOOL (tg);
219 Translator::print_smob (SCM s, SCM port, scm_print_state *)
221 Translator *sc = (Translator *) ly_cdr (s);
223 scm_puts ("#<Translator ", port);
224 if (Context_def *d=unsmob_context_def (sc->definition_))
226 scm_display (d->get_context_name (), port);
229 scm_display (ly_translator_name (s), port);
231 if (Translator_group *td=dynamic_cast<Translator_group*> (sc))
233 scm_puts ("=", port);
234 scm_puts (td->id_string_.to_str0 (), port);
237 scm_display (sc->simple_trans_list_, port);
240 don't try to print properties, that is too much hassle.
242 scm_puts (" >", port);