* lily/include/lily-guile.hh: many new ly_ functions. Thanks to
[lilypond.git] / lily / context-scheme.cc
blobaa914c68a4311ccc1c5b425d3a6669fdf64691f4
1 /*
2 context-scheme.cc --
4 source file of the GNU LilyPond music typesetter
6 (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
7 Han-Wen Nienhuys <hanwen@cs.uu.nl>
8 */
10 #include "context.hh"
11 #include "context-def.hh"
13 LY_DEFINE (ly_context_id, "ly:context-id",
14 1, 0, 0, (SCM context),
15 "Return the id string of @var{context}, "
16 "i.e. for @code{\\context Voice = one .. } "
17 "return the string @code{one}.")
19 Context *tr = unsmob_context (context);
20 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context");
22 return scm_makfrom0str (tr->id_string_. to_str0 ());
25 LY_DEFINE (ly_context_name, "ly:context-name",
26 1, 0, 0, (SCM context),
27 "Return the name of @var{context}, "
28 "i.e. for @code{\\context Voice = one .. } "
29 "return the symbol @code{Voice}.")
31 Context *tr = unsmob_context (context);
32 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context");
33 return unsmob_context_def (tr->definition_)->get_context_name ();
36 LY_DEFINE (ly_context_pushpop_property, "ly:context-pushpop-property",
37 3, 1, 0, (SCM context, SCM grob, SCM eltprop, SCM val),
38 "Do a single @code{\\override} or @code{\\revert} operation "
39 "in @var{context}. The grob definition @code{grob} is extended "
40 "with @code{eltprop} (if @var{val} is specified) "
41 "or reverted (if unspecified).")
43 Context *tg = unsmob_context (context);
44 SCM_ASSERT_TYPE (tg, context, SCM_ARG1, __FUNCTION__, "context");
45 SCM_ASSERT_TYPE (ly_symbol_p (grob), grob, SCM_ARG2, __FUNCTION__, "symbol");
46 SCM_ASSERT_TYPE (ly_symbol_p (eltprop), eltprop, SCM_ARG3, __FUNCTION__, "symbol");
48 execute_pushpop_property (tg, grob, eltprop, val);
50 return SCM_UNDEFINED;
53 LY_DEFINE (ly_context_property, "ly:context-property",
54 2, 0, 0, (SCM c, SCM name),
55 "Return the value of @var{name} from context @var{c}")
57 Context *t = unsmob_context (c);
58 Context * tr= (t);
59 SCM_ASSERT_TYPE (tr, c, SCM_ARG1, __FUNCTION__, "Translator group");
60 SCM_ASSERT_TYPE (ly_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
62 return tr->internal_get_property (name);
65 LY_DEFINE (ly_context_set_property, "ly:context-set-property!",
66 3, 0, 0, (SCM context, SCM name, SCM val),
67 "Set value of property @var{name} in context @var{context} "
68 "to @var{val}.")
70 Context *tr = unsmob_context (context);
71 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context");
72 SCM_ASSERT_TYPE (ly_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
74 tr->internal_set_property (name, val);
76 return SCM_UNSPECIFIED;
79 LY_DEFINE (ly_context_property_where_defined, "ly:context-property-where-defined",
80 2, 0, 0, (SCM context, SCM name),
81 "Return the context above @var{context} "
82 "where @var{name} is defined.")
84 Context *tr = unsmob_context (context);
85 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context");
86 SCM_ASSERT_TYPE (ly_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
88 tr = tr->where_defined (name);
89 if (tr)
90 return tr->self_scm ();
92 return SCM_EOL;
95 LY_DEFINE (ly_unset_context_property, "ly:context-unset-property", 2, 0, 0,
96 (SCM context, SCM name),
97 "Unset value of property @var{name} in context @var{context}.")
99 Context *tr = unsmob_context (context);
100 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context");
101 SCM_ASSERT_TYPE (ly_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
103 tr->unset_property (name);
104 return SCM_UNSPECIFIED;
107 LY_DEFINE (ly_context_parent, "ly:context-parent",
108 1, 0, 0, (SCM context),
109 "Return the parent of @var{context}, @code{#f} if none.")
111 Context *tr = unsmob_context (context);
112 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context");
114 tr = tr->daddy_context_ ;
115 if (tr)
116 return tr->self_scm ();
117 else
118 return SCM_BOOL_F;
121 /* FIXME: todo: should support translator IDs, and creation? */
122 LY_DEFINE (ly_context_find, "ly:context-find",
123 2, 0, 0, (SCM context, SCM name),
124 "Find a parent of @var{context} that has name or alias @var{name}. "
125 "Return @code{#f} if not found.")
127 Context *tr = unsmob_context (context);
128 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "context");
129 SCM_ASSERT_TYPE (ly_symbol_p (name), name, SCM_ARG2, __FUNCTION__, "symbol");
131 while (tr)
133 if (tr->is_alias (name))
134 return tr->self_scm ();
135 tr = tr->daddy_context_ ;
138 return SCM_BOOL_F;
141 #if 0
143 What is this used for? Should remove? --hwn
145 LY_DEFINE (ly_context_properties, "ly:context-properties",
146 1, 0, 0, (SCM context),
147 "Return all properties of @var{context} in an alist.")
149 Context *tr = unsmob_context (context);
150 SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context");
151 return tr->properties_as_alist ();
153 #endif