else if (scm_is_eq (tag, ly_symbol2scm ("remove"))
&& (scm_is_pair (arg)
|| ly_is_procedure (arg)
- || get_translator (arg)))
+ || get_translator_creator (arg)))
l1 = scm_delete_x (arg, l1);
}
class Time_signature_performer;
class Timing_translator;
class Translator;
+class Translator_creator;
class Translator_group;
#endif /* LILY_PROTO_HH */
{
public:
TRANSLATOR_FAMILY_DECLARATIONS (Scheme_engraver);
- Scheme_engraver (SCM definition);
+ Scheme_engraver (SCM definition, Context *c);
protected:
~Scheme_engraver ();
}
SCM init_acknowledgers (SCM alist);
- // For now no description. In future, something derived from the
- // definition might make sense.
- SCM translator_description () const { return SCM_EOL; }
bool must_be_last_;
};
#include "std-vector.hh"
#include "protected-scm.hh"
+// The Translator_creator class is only for translators defined in C.
+// Its elements are callable entities taking a context argument and
+// returning a corresponding translator.
+//
+// Other translator-creating entities may be alists and functions returning
+// such alists. Information for those, such as created grobs/properties
+// is attached via object properties.
+
+// Smob rather than Simple_smob since we want an entity for
+// property lookup.
+
+class Translator_creator : public Smob<Translator_creator>
+{
+ Translator_creator (Translator_creator const &); // don't define
+ Translator * (*allocate_)(Context *);
+ template <class T>
+ static Translator *allocate (Context *ctx);
+
+ Translator_creator (Translator * (*allocate)(Context *))
+ : allocate_(allocate)
+ {
+ smobify_self ();
+ }
+public:
+ // This is stupid, but constructors cannot have explicit template
+ // argument lists.
+ template <class T>
+ static Translator_creator *alloc()
+ {
+ return new Translator_creator(&allocate<T>);
+ }
+ SCM call (SCM ctx);
+ LY_DECLARE_SMOB_PROC (&Translator_creator::call, 1, 0, 0);
+};
+
+template <class T> Translator *
+Translator_creator::allocate (Context *ctx)
+{
+ return new T(ctx);
+}
+
#define TRANSLATOR_FAMILY_DECLARATIONS(NAME) \
public: \
- VIRTUAL_COPY_CONSTRUCTOR (Translator, NAME); \
+ DECLARE_CLASSNAME (NAME); \
virtual void fetch_precomputable_methods (SCM methods[]); \
DECLARE_TRANSLATOR_CALLBACKS (NAME); \
TRANSLATOR_INHERIT (Translator); \
public: \
TRANSLATOR_FAMILY_DECLARATIONS (NAME); \
static Drul_array<Protected_scm> acknowledge_static_array_drul_; \
- static SCM static_description_; \
static Protected_scm listener_list_; \
static SCM static_get_acknowledger (SCM sym, Direction start_end); \
virtual SCM get_acknowledger (SCM sym, Direction start_end) \
public: \
NAME (Context *); \
static void boot (); \
- virtual SCM static_translator_description () const; \
- virtual SCM translator_description () const; \
+ static SCM static_translator_description (); \
virtual SCM get_listener_list () const \
{ \
return listener_list_; \
Context *context () const { return daddy_context_; }
+protected:
Translator (Context *);
- Translator (Translator const &);
+private:
+ Translator (Translator const &); // not copyable
+public:
SCM internal_get_property (SCM symbol) const;
Global_context *get_global_context () const;
DECLARE_CLASSNAME (Translator);
- virtual Translator *clone () const = 0;
+
virtual void fetch_precomputable_methods (SCM methods[]) = 0;
virtual SCM get_listener_list () const = 0;
- virtual SCM translator_description () const = 0;
virtual SCM get_acknowledger (SCM sym, Direction start_end) = 0;
protected: // should be private.
virtual void derived_mark () const;
static SCM event_class_symbol (const char *ev_class);
- SCM static_translator_description (const char *grobs,
- const char *desc,
- SCM listener_list,
- const char *read,
- const char *write) const;
+ static SCM
+ static_translator_description (const char *grobs,
+ const char *desc,
+ SCM listener_list,
+ const char *read,
+ const char *write);
friend class Translator_group;
};
-void add_translator (Translator *trans);
-
-Translator *get_translator (SCM s);
-
SCM
generic_get_acknowledger (SCM sym, SCM ack_hash);
+void add_translator_creator (SCM creator, SCM name, SCM description);
+
+SCM get_translator_creator (SCM s);
Moment get_event_length (Stream_event *s, Moment now);
Moment get_event_length (Stream_event *s);
A macro to automate administration of translators.
*/
#define ADD_THIS_TRANSLATOR(T) \
- SCM T::static_description_ = SCM_EOL; \
static void _ ## T ## _adder () \
{ \
T::boot (); \
- T *t = new T(0); \
- T::static_description_ = \
- scm_permanent_object (t->static_translator_description ()); \
- add_translator (t); \
- } \
- SCM T::translator_description () const \
- { \
- return static_description_; \
+ add_translator_creator (Translator_creator::alloc<T>()->unprotect (), \
+ scm_from_ascii_symbol (#T), \
+ T::static_translator_description ()); \
} \
ADD_GLOBAL_CTOR (_ ## T ## _adder); \
/* end define */
-#define DEFINE_TRANSLATOR_LISTENER_LIST(T) \
- Protected_scm T::listener_list_ (SCM_EOL)
+#define DEFINE_TRANSLATOR_LISTENER_LIST(T) \
+ Protected_scm T::listener_list_ (SCM_EOL); \
+ /* end define */
#define DEFINE_ACKNOWLEDGERS(classname) \
Drul_array<Protected_scm> classname::acknowledge_static_array_drul_; \
} \
/* end define */
-#define DEFINE_TRANSLATOR_DOC(classname, desc, grobs, read, write) \
+#define DEFINE_TRANSLATOR_DOC(classname, desc, grobs, read, write) \
SCM \
- classname::static_translator_description () const \
+ classname::static_translator_description () \
{ \
return Translator::static_translator_description (grobs, desc, listener_list_, read, write); \
}
{ \
ptrs[START_TRANSLATION_TIMESTEP] = \
method_finder <&T::start_translation_timestep> (); \
- \
- ptrs[STOP_TRANSLATION_TIMESTEP] = \
+ \
+ ptrs[STOP_TRANSLATION_TIMESTEP] = \
method_finder <&T::stop_translation_timestep> (); \
\
- ptrs[PROCESS_MUSIC] = \
+ ptrs[PROCESS_MUSIC] = \
method_finder <&T::process_music> (); \
- \
- ptrs[PROCESS_ACKNOWLEDGED] = \
+ \
+ ptrs[PROCESS_ACKNOWLEDGED] = \
method_finder <&T::process_acknowledged> (); \
}
/*
Implement the method cl::listen_##m, and make it listen to stream
events of class m.
+
+ At macro call time, neither creator instances (which are anonymous
+ and only accessible via the translator registry) nor translator
+ instances exist, so the only named place where we can store it is in
+ a static member of the translator class.
*/
#define ADD_LISTENER_FOR(cl, m, ev) \
listener_list_ = scm_acons \
ptrs[i] = precomputable_methods_[i];
}
-Scheme_engraver::Scheme_engraver (SCM definition)
- : Engraver (0)
+Scheme_engraver::Scheme_engraver (SCM definition, Context *c)
+ : Engraver (c)
{
precomputable_methods_[START_TRANSLATION_TIMESTEP]
= callable (ly_symbol2scm ("start-translation-timestep"), definition);
along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
*/
+#include "context.hh"
#include "translator.hh"
-
+#include "lily-imports.hh"
#include "international.hh"
#include "scm-hash.hh"
#include "warn.hh"
#include "protected-scm.hh"
-/*
- should delete these after exit.
-*/
+SCM
+Translator_creator::call (SCM ctx)
+{
+ return (allocate_ (LY_ASSERT_SMOB (Context, ctx, 1)))->unprotect ();
+}
Protected_scm global_translator_dict;
+Protected_scm global_translator_dict_rev;
LY_DEFINE (get_all_translators, "ly:get-all-translators", 0, 0, 0, (),
"Return a list of all translator objects that may be"
}
void
-add_translator (Translator *t)
+add_translator_creator (SCM creator, SCM name, SCM description)
{
Scheme_hash_table *dict = unsmob<Scheme_hash_table> (global_translator_dict);
if (!dict)
{
global_translator_dict = Scheme_hash_table::make_smob ();
+ global_translator_dict_rev =
+ scm_make_weak_key_hash_table (scm_from_int (119));
dict = unsmob<Scheme_hash_table> (global_translator_dict);
}
+ dict->set (name, creator);
+ scm_hashq_set_x (global_translator_dict_rev, creator, scm_cons (name, description));
+}
- SCM k = ly_symbol2scm (t->class_name ());
- dict->set (k, t->unprotect ());
+LY_DEFINE (ly_translator_name, "ly:translator-name",
+ 1, 0, 0, (SCM creator),
+ "Return the type name of the translator definition @var{creator}."
+ " The name is a symbol.")
+{
+ SCM res = SCM_UNBNDP (SCM (global_translator_dict_rev)) ? SCM_BOOL_F
+ : scm_hashq_ref (global_translator_dict_rev, creator, SCM_BOOL_F);
+ SCM_ASSERT_TYPE (scm_is_pair (res),
+ creator, SCM_ARG1, __FUNCTION__, "translator definition");
+ return scm_car (res);
+}
+
+LY_DEFINE (ly_translator_description, "ly:translator-description",
+ 1, 0, 0, (SCM creator),
+ "Return an alist of properties of translator definition @var{creator}.")
+{
+ SCM res = SCM_UNBNDP (SCM (global_translator_dict_rev)) ? SCM_BOOL_F
+ : scm_hashq_ref (global_translator_dict_rev, creator, SCM_BOOL_F);
+ SCM_ASSERT_TYPE (scm_is_pair (res),
+ creator, SCM_ARG1, __FUNCTION__, "translator definition");
+ return scm_cdr (res);
+}
+
+LY_DEFINE (ly_register_translator, "ly:register-translator",
+ 2, 1, 0, (SCM creator, SCM name, SCM description),
+ "Register a translator @var{creator} (usually a descriptive"
+ " alist or a function/closure returning one when given a"
+ " context argument) with the given symbol @var{name} and"
+ " the given @var{description} alist.")
+{
+ SCM_ASSERT_TYPE (ly_is_procedure (creator) || scm_is_pair (creator),
+ creator, SCM_ARG1, __FUNCTION__, "translator creator");
+ LY_ASSERT_TYPE (ly_is_symbol, name, 2);
+ if (SCM_UNBNDP (description))
+ description = SCM_EOL;
+ else
+ LY_ASSERT_TYPE (ly_is_list, description, 3);
+ add_translator_creator (creator, name, description);
+ return SCM_UNSPECIFIED;
}
-Translator *
-get_translator (SCM sym)
+SCM
+get_translator_creator (SCM sym)
{
SCM v = SCM_BOOL_F;
Scheme_hash_table *dict = unsmob<Scheme_hash_table> (global_translator_dict);
if (scm_is_false (v))
{
warning (_f ("unknown translator: `%s'", ly_symbol2string (sym).c_str ()));
- return 0;
}
- return unsmob<Translator> (v);
+ return v;
}
for (SCM s = trans_names; scm_is_pair (s); s = scm_cdr (s))
{
- SCM definition = scm_car (s);
- bool is_scheme = false;
-
- Translator *type = 0;
- if (ly_is_symbol (definition))
- type = get_translator (definition);
- else if (ly_is_pair (definition))
- {
- is_scheme = true;
- }
- else if (ly_is_procedure (definition))
+ SCM trans = scm_car (s);
+
+ if (ly_is_symbol (trans))
+ trans = get_translator_creator (trans);
+ if (ly_is_procedure (trans))
+ trans = scm_call_1 (trans, cs);
+ if (scm_is_pair (trans))
+ trans = (new Scheme_engraver (trans, new_context))->unprotect ();
+ Translator *instance = unsmob<Translator> (trans);
+ if (!instance)
{
- // `definition' is a procedure, which takes the context as
- // an argument and evaluates to an a-list scheme engraver
- // definition.
- definition = scm_call_1 (definition, cs);
- is_scheme = true;
+ warning (_f ("cannot find: `%s'", ly_symbol2string (scm_car (s)).c_str ()));
+ continue;
}
- if (!is_scheme && !type)
- warning (_f ("cannot find: `%s'", ly_symbol2string (scm_car (s)).c_str ()));
- else
+ if (instance->must_be_last ())
{
- Translator *instance = is_scheme ? new Scheme_engraver (definition)
- : type->clone ();
-
- SCM str = instance->self_scm ();
-
- if (instance->must_be_last ())
- {
- SCM cons = scm_cons (str, SCM_EOL);
- if (scm_is_pair (trans_list))
- scm_set_cdr_x (scm_last_pair (trans_list), cons);
- else
- trans_list = cons;
- }
+ SCM cons = scm_cons (trans, SCM_EOL);
+ if (scm_is_pair (trans_list))
+ scm_set_cdr_x (scm_last_pair (trans_list), cons);
else
- trans_list = scm_cons (str, trans_list);
-
- instance->daddy_context_ = new_context;
- instance->unprotect ();
+ trans_list = cons;
}
+ else
+ trans_list = scm_cons (trans, trans_list);
+
}
/* Filter unwanted translator types. Required to make
#include "translator-group.hh"
#include "moment.hh"
-LY_DEFINE (ly_translator_name, "ly:translator-name",
- 1, 0, 0, (SCM trans),
- "Return the type name of the translator object @var{trans}."
- " The name is a symbol.")
-{
- LY_ASSERT_SMOB (Translator, trans, 1);
- Translator *tr = unsmob<Translator> (trans);
- char const *nm = tr->class_name ();
- return ly_symbol2scm (nm);
-}
-
-LY_DEFINE (ly_translator_description, "ly:translator-description",
- 1, 0, 0, (SCM me),
- "Return an alist of properties of translator @var{me}.")
-{
- LY_ASSERT_SMOB (Translator, me, 1);
- Translator *tr = unsmob<Translator> (me);
- return tr->translator_description ();
-}
-
LY_DEFINE (ly_translator_context, "ly:translator-context",
1, 0, 0, (SCM trans),
"Return the context of the translator object @var{trans}.")
smobify_self ();
}
-Translator::Translator (Translator const &)
- : Smob<Translator> ()
-{
- smobify_self ();
-}
-
Moment
Translator::now_mom () const
{
const char *desc,
SCM listener_list,
const char *read,
- const char *write) const
+ const char *write)
{
SCM static_properties = SCM_EOL;
projects / lilypond.git / commitdiff