]> git.donarmstrong.com Git - lilypond.git/commitdiff
Add basic scheme programmable engravers.
authorHan-Wen Nienhuys <hanwen@xs4all.nl>
Thu, 31 Dec 2009 04:49:04 +0000 (02:49 -0200)
committerHan-Wen Nienhuys <hanwen@xs4all.nl>
Sat, 9 Jan 2010 03:38:01 +0000 (01:38 -0200)
* input/regression/scheme-engraver.ly shows a basic example.

* extend \consists syntax to accept an alist of callables.

* add Scheme_engraver which is the C++ glue to the Scheme callables.

* Make get_listener_ in translator_listener_record also pass the
  listened class, so we can use generic infrastructure for hooking
  scheme functions to event listeners.

* add scheme bindings:

  - ly:translator-context
  - ly:context-moment
  - ly:engraver-make-grob

* Remove Translator::must_be_last_.  Use virtual method must_be_last
  () const instead.

17 files changed:
input/regression/scheme-engraver.ly [new file with mode: 0644]
lily/axis-group-engraver.cc
lily/context-def.cc
lily/context-scheme.cc
lily/engraver-scheme.cc [new file with mode: 0644]
lily/engraver.cc
lily/include/axis-group-engraver.hh
lily/include/engraver.hh
lily/include/lily-proto.hh
lily/include/scheme-engraver.hh [new file with mode: 0644]
lily/include/translator.hh
lily/include/translator.icc
lily/parser.yy
lily/scheme-engraver.cc [new file with mode: 0644]
lily/translator-group.cc
lily/translator-scheme.cc
lily/translator.cc

diff --git a/input/regression/scheme-engraver.ly b/input/regression/scheme-engraver.ly
new file mode 100644 (file)
index 0000000..ee7f3ea
--- /dev/null
@@ -0,0 +1,76 @@
+\header {
+
+  texidoc = "\\consists can take a scheme alist as arguments, which
+  should be functions, which will be invoked as engraver functions."
+
+}
+
+\version "2.13.9"
+
+\layout {
+  \context {
+    \Voice
+    \consists
+    #(list
+      (cons 'initialize
+       (lambda (trans)
+       (display (list "initialize"
+                 (ly:context-current-moment
+                  (ly:translator-context trans)) "\n"))))
+      (cons 'start-translation-timestep
+       (lambda (trans)
+       (display (list "start-trans"
+                 (ly:context-current-moment
+                  (ly:translator-context trans)) "\n"))))
+      (cons 'listeners
+       (list
+       (cons 'rest-event (lambda (engraver event)
+                          (let*
+                           ((x (ly:engraver-make-grob engraver 'TextScript event)))
+                           (display (list "caught event" event "\ncreate:\n" x "\n"))
+                           (ly:grob-set-property! x 'text "hi"))
+                          ))
+       ))
+      (cons 'acknowledgers
+       (list
+       (cons 'note-head-interface
+        (lambda (engraver grob source-engraver)
+         (display (list "saw head: " grob " coming from " source-engraver))
+         ))
+       ))
+      (cons 'end-acknowledgers
+       (list
+       (cons 'beam-interface
+        (lambda (engraver grob source-engraver)
+         (display (list "saw end of beam: " grob " coming from " source-engraver))
+         ))
+       ))
+      (cons 'process-music
+       (lambda (trans)
+       (display (list "process-music"
+                 (ly:context-current-moment
+                  (ly:translator-context trans)) "\n"))))
+      (cons 'process-acknowledged
+       (lambda (trans)
+       (display (list "process-acknowledged"
+                 (ly:context-current-moment
+                  (ly:translator-context trans)) "\n"))))
+      (cons 'start-translation-timestep
+       (lambda (trans)
+       (display (list "stop-trans"
+                 (ly:context-current-moment
+                  (ly:translator-context trans)) "\n"))))
+      (cons 'finalize
+       (lambda (trans)
+       (display (list "finalize"
+                 (ly:context-current-moment
+                  (ly:translator-context trans)) "\n"))))
+    )
+
+               }}
+
+
+\relative {
+  c8[ r c]
+
+}
index 2fb6b0c17b715abc0836eec38f2c3fb69a28efd0..aa02845d5c2d3b2f30233eff5aa19076deb4866a 100644 (file)
 
 Axis_group_engraver::Axis_group_engraver ()
 {
-  must_be_last_ = true;
   staffline_ = 0;
 }
 
+bool
+Axis_group_engraver::must_be_last () const
+{
+  return true;
+}
+
 void
 Axis_group_engraver::process_music ()
 {
index 83da70df60b5c7f5f5f4754f6ad355cad9e02cff..227bc8b3e9ca5c2df6d18e1917c4b8593c9dff66 100644 (file)
@@ -136,11 +136,7 @@ Context_def::add_context_mod (SCM mod)
   else if (ly_symbol2scm ("consists") == tag
           || ly_symbol2scm ("remove") == tag)
     {
-      if (!get_translator (sym))
-       warning (_f ("program has no such type: `%s'",
-                    ly_symbol2string (sym).c_str ()));
-      else
-       translator_mods_ = scm_cons (scm_list_2 (tag, sym), translator_mods_);
+      translator_mods_ = scm_cons (scm_list_2 (tag, sym), translator_mods_);
     }
   else if (ly_symbol2scm ("accepts") == tag
           || ly_symbol2scm ("denies") == tag)
index 5bc3d1d2c55f861f81da8eef36c914f9c653d33a..9e1b4c4f7a3f073a2fecf9aca115fe9d9e103fc6 100644 (file)
 #include "context-def.hh"
 #include "dispatcher.hh"
 
+LY_DEFINE (ly_context_current_moment,
+          "ly:context-current-moment",
+          1, 0, 0, (SCM context),
+          "Return the current moment of @var{context}.")
+{
+  Context *tr = unsmob_context (context);
+
+  LY_ASSERT_SMOB (Context, context, 1);
+
+  return tr->now_mom ().smobbed_copy ();
+}
+
 LY_DEFINE (ly_context_id, "ly:context-id",
           1, 0, 0, (SCM context),
           "Return the ID string of @var{context},"
diff --git a/lily/engraver-scheme.cc b/lily/engraver-scheme.cc
new file mode 100644 (file)
index 0000000..00fc5e1
--- /dev/null
@@ -0,0 +1,40 @@
+/*
+  This file is part of LilyPond, the GNU music typesetter.
+
+  Copyright (C) 1997--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+  LilyPond is free software: you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation, either version 3 of the License, or
+  (at your option) any later version.
+
+  LilyPond is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
+*/
+
+#include "engraver.hh"
+#include "grob.hh"
+
+LY_DEFINE (ly_engraver_make_grob, "ly:engraver-make-grob",
+          3, 0, 0, (SCM engraver, SCM grob_name, SCM cause),
+          "Creates a grob originating from given engraver instance, "
+          "with give @code{grob_name}, a symbol.  "
+          "@code{cause} should either be another grob "
+          "or a music event.")
+{
+  LY_ASSERT_TYPE (unsmob_engraver, engraver, 1);
+  LY_ASSERT_TYPE (ly_is_symbol, grob_name, 2);
+  LY_ASSERT_TYPE (ly_is_grob_cause, cause, 3);
+
+  Grob *g = unsmob_engraver (engraver)->
+    internal_make_grob(grob_name, cause,
+                      ly_symbol2string (grob_name).c_str (),
+                      "scheme", 0, "scheme");
+  return g->self_scm ();
+}
+
index 1b83b07a85ce638cab4ff0c448318779c01dbde5..9e6b23118cecef61641807e6b18c6b2312f1b894 100644 (file)
@@ -70,9 +70,8 @@ Engraver::announce_grob (Grob *e, SCM cause)
 
 
 /*
-  CAUSE is the object (typically a Music object)  that
-  was the reason for making E.
-*/
+  CAUSE is the object (typically a grob or stream-event object) that
+  was the reason for ending E.  */
 void
 Engraver::announce_end_grob (Grob *e, SCM cause)
 {
@@ -175,13 +174,26 @@ Engraver::internal_make_column (SCM x, char const *name,
 }
 
 Spanner *
-Engraver::internal_make_spanner (SCM x, SCM cause, char const *name, char const *file, int line, char const *fun)
+Engraver::internal_make_spanner (SCM x, SCM cause, char const *name,
+                                char const *file, int line, char const *fun)
 {
   Spanner *sp = dynamic_cast<Spanner *> (internal_make_grob (x, cause, name, file, line, fun));
   assert (sp);
   return sp;
 }
 
+Engraver*
+unsmob_engraver (SCM eng)
+{
+  return dynamic_cast<Engraver*> (unsmob_translator (eng));
+}
+
+bool
+ly_is_grob_cause (SCM obj)
+{
+  return unsmob_grob (obj) || unsmob_stream_event (obj);
+}
+
 #include "translator.icc"
 
 ADD_TRANSLATOR (Engraver,
@@ -198,3 +210,4 @@ ADD_TRANSLATOR (Engraver,
                ""
                );
 
+
index 68595e0c74aa678f312e80ae2ed64961ac79c0ba..d10f864be1dd4d3f166ea524093568b2fd2f6773 100644 (file)
@@ -37,6 +37,8 @@ protected:
   void process_acknowledged ();
   virtual Spanner *get_spanner ();
   virtual void add_element (Grob *);
+  virtual bool must_be_last () const;
+  
 public:
   TRANSLATOR_DECLARATIONS (Axis_group_engraver);
 };
index 2254ff524829bec3b517b211acab6ebc140b1fd7..d4797b8f9e54ba6da2fc7a8fd3fd503cf0944abf 100644 (file)
@@ -31,7 +31,7 @@ class Engraver : public Translator
 {
   Grob *internal_make_grob (SCM sym, SCM cause, char const *name,
                            char const *f, int l, char const *fun);
-
+  friend SCM ly_engraver_make_grob (SCM, SCM, SCM);
   friend class Engraver_group;
 protected:
   /*
@@ -69,5 +69,7 @@ public:
 #define make_spanner(x, cause) internal_make_spanner (ly_symbol2scm (x), cause, x, __FILE__, __LINE__, __FUNCTION__)
 #define make_paper_column(x) internal_make_column (ly_symbol2scm (x), x, __FILE__, __LINE__, __FUNCTION__)
 
+Engraver* unsmob_engraver (SCM eng);
+bool ly_is_grob_cause (SCM obj);
 
 #endif // ENGRAVER_HH
index 138328a26be31495a20a83292c8a3f4705c93fd2..19aef0a27aace4b9cfb57822c4220f296647146c 100644 (file)
@@ -152,6 +152,7 @@ class Relative_octave_music;
 class Repeated_music;
 class Scale;
 class Scheme_hash_table;
+class Scheme_engraver;
 class Score;
 class Score_context;
 class Score_engraver;
diff --git a/lily/include/scheme-engraver.hh b/lily/include/scheme-engraver.hh
new file mode 100644 (file)
index 0000000..73eff6d
--- /dev/null
@@ -0,0 +1,79 @@
+/* 
+  scheme-engraver.hh -- declare Scheme_engraver
+  
+  source file of the GNU LilyPond music typesetter
+  
+  Copyright (c) 2009 Han-Wen Nienhuys <hanwen@lilypond.org>
+
+  LilyPond is free software: you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation, either version 3 of the License, or
+  (at your option) any later version.
+
+  LilyPond is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.  
+  
+*/
+
+#ifndef SCHEME_ENGRAVER_HH
+#define SCHEME_ENGRAVER_HH
+
+#include "engraver.hh"
+
+class Scheme_engraver : public Engraver {
+public:
+  void init_from_scheme (SCM definition);
+  TRANSLATOR_DECLARATIONS_NO_LISTENER (Scheme_engraver);
+  
+  static Listener get_listener (void *generic_arg, SCM event);
+  
+protected:
+  ~Scheme_engraver ();
+  
+  void stop_translation_timestep ();
+  void start_translation_timestep ();
+  void process_music ();
+  void process_acknowledged ();
+
+  virtual void initialize ();
+  virtual void finalize ();
+  virtual void derived_mark () const;
+  virtual translator_listener_record *get_listener_list () const;
+  virtual bool must_be_last () const;
+
+private:
+  void acknowledge_grob_by_hash (Grob_info info, SCM iface_function_hash);
+  void init_acknowledgers (SCM alist, SCM *hash);
+
+  DECLARE_ACKNOWLEDGER (grob);
+  DECLARE_END_ACKNOWLEDGER (grob);
+
+  bool must_be_last_;
+  
+  SCM acknowledge_grob_function_;
+  SCM stop_translation_timestep_function_;
+  SCM start_translation_timestep_function_;
+  SCM process_music_function_;
+  SCM process_acknowledged_function_;
+  SCM initialize_function_;
+  SCM finalize_function_;
+
+  // hashq table of interface-symbol -> scheme-function
+  SCM interface_acknowledger_hash_;
+  SCM interface_end_acknowledger_hash_;
+
+  // Alist of listened-symbol . scheme-function
+  SCM listeners_alist_;
+
+  // We dont use this, but need it for the documentation boilerplate.
+  static translator_listener_record *listener_list_;
+  translator_listener_record *per_instance_listeners_;
+};
+
+#endif /* SCHEME_ENGRAVER_HH */
+
index ea5f07269a6d3c84e51cb1df0830c622377e528f..a8e3f1d51373f53c99cbd33e9e5bda5256025abd 100644 (file)
@@ -32,6 +32,11 @@ struct Acknowledge_information
 {
   SCM symbol_;
   Engraver_void_function_engraver_grob_info function_;
+
+  Acknowledge_information () {
+    symbol_ = SCM_EOL;
+    function_ = 0;
+  }
 };
 
 
@@ -41,14 +46,21 @@ struct Acknowledge_information
   listeners to a context.
 */
 typedef struct translator_listener_record {
-  Listener (*get_listener_) (void *);
+  Listener (*get_listener_) (void *, SCM event_class);
   SCM event_class_;
   struct translator_listener_record *next_;
+
+  translator_listener_record () {
+    next_ = 0;
+    event_class_ = SCM_EOL;
+    get_listener_ = 0;
+  }
+    
 } translator_listener_record;
 
-#define TRANSLATOR_DECLARATIONS(NAME)                                  \
+
+#define TRANSLATOR_DECLARATIONS_NO_LISTENER(NAME)                       \
 private:                                                               \
-  static translator_listener_record *listener_list_;                   \
   public:                                                              \
   NAME ();                                                             \
   VIRTUAL_COPY_CONSTRUCTOR (Translator, NAME);                         \
@@ -57,6 +69,8 @@ private:                                                              \
   virtual void fetch_precomputable_methods (Translator_void_method_ptr methods[]); \
   virtual SCM static_translator_description () const;                  \
   virtual SCM translator_description () const;                         \
+  static Engraver_void_function_engraver_grob_info static_get_acknowledger (SCM sym); \
+  static Engraver_void_function_engraver_grob_info static_get_end_acknowledger(SCM); \
   virtual Engraver_void_function_engraver_grob_info get_acknowledger (SCM sym) \
   {                                                                    \
     return static_get_acknowledger (sym);                              \
@@ -65,8 +79,12 @@ private:                                                             \
   {                                                                    \
     return static_get_end_acknowledger (sym);                          \
   } \
-  static Engraver_void_function_engraver_grob_info static_get_acknowledger (SCM sym); \
-  static Engraver_void_function_engraver_grob_info static_get_end_acknowledger(SCM); \
+  /* end #define */
+
+#define TRANSLATOR_DECLARATIONS(NAME)                                  \
+  TRANSLATOR_DECLARATIONS_NO_LISTENER(NAME)                            \
+private:                                                               \
+  static translator_listener_record *listener_list_;                   \
 public:                                                                        \
   virtual translator_listener_record *get_listener_list () const       \
   {                                                                    \
@@ -80,7 +98,7 @@ inline void listen_ ## m (Stream_event *);            \
 /* Should be private */                                        \
 static void _internal_declare_ ## m ();                        \
 private:                                               \
-static Listener _get_ ## m ## _listener (void *);      \
+ static Listener _get_ ## m ## _listener (void *, SCM);        \
 DECLARE_LISTENER (_listen_scm_ ## m);
 
 #define DECLARE_ACKNOWLEDGER(x) public : void acknowledge_ ## x (Grob_info); protected:
@@ -102,12 +120,7 @@ class Translator
 {
   void init ();
 
-protected:
-  bool must_be_last_;
-
 public:
-  bool must_be_last () const;
-
   Context *context () const { return daddy_context_; }
 
   Translator (Translator const &);
@@ -117,11 +130,12 @@ public:
   virtual Output_def *get_output_def () const;
   virtual Translator_group *get_daddy_translator ()const;
   virtual Moment now_mom () const;
+  virtual bool must_be_last () const;
 
   virtual void initialize ();
   virtual void finalize ();
 
-  /*should maybe be virtual*/
+  /* should maybe be virtual */
   void connect_to_context (Context *c);
   void disconnect_from_context (Context *c);
 
@@ -140,7 +154,10 @@ protected:                 // should be private.
   Context *daddy_context_;
   void protect_event (SCM ev);
   virtual void derived_mark () const;
-  static void add_translator_listener (translator_listener_record **listener_list, translator_listener_record *r, Listener (*get_listener) (void *), const char *ev_class);
+  static void add_translator_listener (translator_listener_record **listener_list,
+                                      translator_listener_record *r,
+                                      Listener (*get_listener) (void *, SCM),
+                                      const char *ev_class);
   SCM static_translator_description (const char *grobs, 
                                     const char *desc,
                                     translator_listener_record *listener_list,
@@ -149,6 +166,7 @@ protected:                  // should be private.
 
   friend class Translator_group;
 };
+
 void add_translator (Translator *trans);
 
 Translator *get_translator (SCM s);
@@ -164,4 +182,5 @@ extern bool internal_event_assignment (Stream_event **old_ev, Stream_event *new_
 #define ASSIGN_EVENT_ONCE(o,n) internal_event_assignment (&o, n, __FUNCTION__)
 
 
+
 #endif // TRANSLATOR_HH
index 8d96eb20f0232beaa427f47d4a72e569b1658b00..73f8f7bab377707a640ee7b8c49d200980abcbf6 100644 (file)
@@ -32,7 +32,6 @@
    A macro to automate administration of translators.
 */
 #define ADD_THIS_TRANSLATOR(T)                                         \
-  translator_listener_record *T::listener_list_;                       \
   SCM T::static_description_ = SCM_EOL;                                        \
   static void _ ## T ## _adder ()                                      \
   {                                                                    \
   {                                                                    \
     return static_description_;                                                \
   }                                                                    \
-  ADD_GLOBAL_CTOR (_ ## T ## _adder);
+  ADD_GLOBAL_CTOR (_ ## T ## _adder); \
+  /* end define */
 
-#define ADD_TRANSLATOR(classname, desc, grobs, read, write)            \
+#define DEFINE_TRANSLATOR_LISTENER_LIST(T) \
+  translator_listener_record *T::listener_list_;       \
+  /* end define */
+
+#define DEFINE_ACKNOWLEDGERS(classname) \
   Drul_array< vector<Acknowledge_information> > classname::acknowledge_static_array_drul_;     \
-  IMPLEMENT_FETCH_PRECOMPUTABLE_METHODS (classname);                   \
-  ADD_THIS_TRANSLATOR (classname);                                     \
   Engraver_void_function_engraver_grob_info                            \
   classname::static_get_acknowledger (SCM sym)                         \
   {                                                                    \
   {                                                                    \
     return generic_get_acknowledger (sym, &acknowledge_static_array_drul_[STOP]);      \
   }                                                                    \
+  /* end define */
+
+#define DEFINE_TRANSLATOR_DOC(classname, desc, grobs, read, write)             \
   SCM                                                                  \
   classname::static_translator_description () const                    \
   {                                                                    \
     return Translator::static_translator_description (grobs, desc, listener_list_, read, write); \
   }
 
+#define ADD_TRANSLATOR(classname, desc, grobs, read, write)            \
+  IMPLEMENT_FETCH_PRECOMPUTABLE_METHODS (classname);                   \
+  ADD_THIS_TRANSLATOR (classname);                                     \
+  DEFINE_TRANSLATOR_DOC(classname, desc, grobs, read, write)           \
+  DEFINE_ACKNOWLEDGERS(classname) \
+  DEFINE_TRANSLATOR_LISTENER_LIST(classname) \
+  
 #define IMPLEMENT_FETCH_PRECOMPUTABLE_METHODS(T)                       \
   void                                                                 \
   T::fetch_precomputable_methods (Translator_void_method_ptr ptrs[])   \
@@ -130,9 +142,10 @@ cl :: _internal_declare_ ## m ()                   \
 ADD_SCM_INIT_FUNC (cl ## _declare_event_ ## m, cl::_internal_declare_ ## m);   \
                                                        \
 Listener                                               \
-cl :: _get_ ## m ## _listener (void *me)               \
+ cl :: _get_ ## m ## _listener (void *me, SCM unused)   \
 {                                                      \
   cl *obj = (cl *) me;                                 \
+  (void) unused; \
   return obj->GET_LISTENER (_listen_scm_ ## m);                \
 }                                                      \
                                                        \
index d2f3a8c4dc9e9f0eae7f1512c673fbeabadcdf6d..a4ac1ec0356ce3bf1afd3a0a813035b1870ded98 100644 (file)
@@ -1316,6 +1316,17 @@ context_mod:
        | context_def_mod STRING {
                $$ = scm_list_2 ($1, $2);
        }
+       | context_def_mod embedded_scm {
+          if (ly_symbol2scm ("consists") != $1)
+          {
+            $$ = SCM_EOL;
+             PARSER->parser_error (@1, _ ("only \\consists takes non-string argument."));
+          }
+          else
+          {
+            $$ = scm_list_2 ($1, $2);
+          }
+       }
        ;
 
 context_prop_spec:
diff --git a/lily/scheme-engraver.cc b/lily/scheme-engraver.cc
new file mode 100644 (file)
index 0000000..129362e
--- /dev/null
@@ -0,0 +1,256 @@
+/* 
+  scheme-engraver.cc -- implement Scheme_engraver
+  
+  source file of the GNU LilyPond music typesetter
+  
+  Copyright (c) 2009 Han-Wen Nienhuys <hanwen@lilypond.org>
+
+  LilyPond is free software: you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation, either version 3 of the License, or
+  (at your option) any later version.
+
+  LilyPond is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.  
+*/
+
+#include "scheme-engraver.hh"
+
+#include "grob.hh"
+
+#include "translator.icc"
+
+Scheme_engraver::Scheme_engraver ()
+{
+  stop_translation_timestep_function_ = SCM_EOL;
+  start_translation_timestep_function_ = SCM_EOL;
+  process_music_function_ = SCM_EOL;
+  process_acknowledged_function_ = SCM_EOL;
+  initialize_function_ = SCM_EOL;
+  finalize_function_ = SCM_EOL;
+  listeners_alist_ = SCM_EOL;
+
+  interface_acknowledger_hash_ = SCM_EOL;
+  interface_end_acknowledger_hash_ = SCM_EOL;
+
+  must_be_last_ = false;
+  per_instance_listeners_ = 0;
+}
+
+Scheme_engraver::~Scheme_engraver ()
+{
+  translator_listener_record *next = 0;
+  for (translator_listener_record *r = per_instance_listeners_;
+       r; r = next)
+    {
+      next = r->next_;
+      delete r;
+    }
+}
+
+// Extracts the value if callable, if not return #f.
+static SCM
+callable (SCM symbol, SCM defn)
+{
+  SCM val = ly_assoc_get (symbol, defn, SCM_BOOL_F);
+  return ly_is_procedure (val) ? val : SCM_BOOL_F;
+}
+
+bool
+Scheme_engraver::must_be_last () const
+{
+  return must_be_last_;
+}
+
+void
+Scheme_engraver::init_from_scheme (SCM definition)
+{
+  start_translation_timestep_function_ = callable (ly_symbol2scm ("start-translation-timestep"),
+                                                  definition);
+  stop_translation_timestep_function_ = callable (ly_symbol2scm ("stop-translation-timestep"),
+                                                 definition);
+  process_music_function_ = callable (ly_symbol2scm ("process-music"), definition);
+  process_acknowledged_function_ = callable (ly_symbol2scm ("process-acknowledged"),
+                                            definition);
+  initialize_function_ = callable (ly_symbol2scm ("initialize"), definition);
+  finalize_function_ = callable (ly_symbol2scm ("finalize"), definition);
+
+  SCM listeners = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL);
+
+  listeners_alist_ = SCM_EOL;
+
+  must_be_last_ = to_boolean (ly_assoc_get (ly_symbol2scm ("must-be-last"),
+                                           definition,
+                                           SCM_BOOL_F));
+                               
+  translator_listener_record **tail = &per_instance_listeners_;
+  for (SCM p = listeners; scm_is_pair (p); p = scm_cdr (p))
+    {
+      SCM event_class = scm_caar (p);
+      SCM proc = scm_cdar (p);
+
+      if (!(ly_is_procedure (proc) && ly_is_symbol (event_class)))
+       continue;
+
+      // We should check the arity of the function?
+      
+      // Record for later lookup.
+      listeners_alist_ = scm_acons (event_class, proc, listeners_alist_);
+
+      translator_listener_record *rec = new translator_listener_record;
+      *tail = rec;
+      rec->event_class_ = event_class;
+      rec->get_listener_ = &Scheme_engraver::get_listener;
+      tail = &rec->next_;
+    }
+
+  init_acknowledgers (ly_assoc_get(ly_symbol2scm ("acknowledgers"),
+                                  definition, SCM_EOL),
+                     &interface_acknowledger_hash_);
+  
+  init_acknowledgers (ly_assoc_get(ly_symbol2scm ("end-acknowledgers"),
+                                  definition, SCM_EOL),
+                     &interface_end_acknowledger_hash_);
+
+  // TODO: hook up description, props read/written, grobs created
+  // etc. to provide automatic documentation.
+}
+
+void
+Scheme_engraver::init_acknowledgers (SCM alist,
+                                    SCM *hash)
+{  
+  *hash = scm_c_make_hash_table(7);
+  for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
+    {
+      SCM iface = scm_caar (p);
+      SCM proc = scm_cdar (p);
+
+      if (!(ly_is_procedure (proc) && ly_is_symbol (iface)))
+       continue;
+
+      scm_hashq_set_x (*hash, iface, proc);
+    }
+}
+
+// This is the easy way to do it, at the cost of too many invocations
+// of Scheme_engraver::acknowledge_grob.  The clever dispatching of
+// acknowledgers is hardwired to have 1 method per engraver per
+// grob-type, which doesn't work for this case. 
+void
+Scheme_engraver::acknowledge_grob (Grob_info info)
+{
+  acknowledge_grob_by_hash (info, interface_acknowledger_hash_);
+}
+
+void
+Scheme_engraver::acknowledge_end_grob (Grob_info info)
+{
+  acknowledge_grob_by_hash (info, interface_end_acknowledger_hash_);
+}
+
+void
+Scheme_engraver::acknowledge_grob_by_hash (Grob_info info,
+                                          SCM iface_function_hash)
+{
+  SCM meta = info.grob ()->internal_get_property (ly_symbol2scm ("meta"));
+  SCM ifaces = scm_cdr (scm_assoc (ly_symbol2scm ("interfaces"), meta));
+  for (SCM s = ifaces; scm_is_pair (s); s = scm_cdr (s))
+    {
+      SCM func = scm_hashq_ref (iface_function_hash,
+                               scm_car (s), SCM_BOOL_F);
+
+      if (ly_is_procedure (func))
+       scm_call_3 (func, self_scm (), info.grob ()->self_scm (),
+                   info.origin_translator ()->self_scm ());
+    }
+}
+
+static
+void call_listen_closure (void *target, SCM ev)
+{
+  SCM cl = (SCM) target;
+  SCM func = scm_car (cl);
+  SCM engraver = scm_cdr (cl);
+  scm_call_2 (func, engraver, ev);
+}
+
+static
+void mark_listen_closure (void *target)
+{
+  scm_gc_mark ((SCM)target);
+}
+
+Listener_function_table listen_closure = {
+  call_listen_closure, mark_listen_closure
+};
+
+/* static */
+Listener
+Scheme_engraver::get_listener (void *arg, SCM name)
+{
+  Scheme_engraver *me = (Scheme_engraver*) arg;
+  SCM func = ly_assoc_get (name, me->listeners_alist_, SCM_BOOL_F);
+  assert (ly_is_procedure (func));
+
+  SCM closure = scm_cons (func, me->self_scm());
+  return Listener((void*)closure, &listen_closure);
+}
+
+translator_listener_record *
+Scheme_engraver::get_listener_list () const                            
+{                                                                      
+  return per_instance_listeners_;
+}
+
+#define DISPATCH(what)                                 \
+  void                                                 \
+  Scheme_engraver::what ()                             \
+  {                                                    \
+    if (what ## _function_ != SCM_BOOL_F)              \
+      scm_call_1 (what ## _function_, self_scm ());    \
+  }
+
+DISPATCH(start_translation_timestep);
+DISPATCH(stop_translation_timestep);
+DISPATCH(initialize);
+DISPATCH(finalize);
+DISPATCH(process_music);
+DISPATCH(process_acknowledged);
+
+void
+Scheme_engraver::derived_mark () const
+{
+  scm_gc_mark (start_translation_timestep_function_);
+  scm_gc_mark (stop_translation_timestep_function_);
+  scm_gc_mark (initialize_function_);
+  scm_gc_mark (finalize_function_);
+  scm_gc_mark (process_music_function_);
+  scm_gc_mark (process_acknowledged_function_);
+  scm_gc_mark (listeners_alist_);    
+  scm_gc_mark (interface_acknowledger_hash_);    
+  scm_gc_mark (interface_end_acknowledger_hash_);    
+} 
+
+ADD_ACKNOWLEDGER (Scheme_engraver, grob);
+ADD_END_ACKNOWLEDGER (Scheme_engraver, grob);
+
+ADD_TRANSLATOR (Scheme_engraver,
+               /* doc */
+               "Implement engravers in Scheme.  Interprets arguments to @code{\\consists} "
+               "as callbacks. ",
+
+               /* create */
+               "",
+
+               /* read */
+               "",
+
+               /* write */
+               ""
+               );
index 9399dc3bc262b9f0d1b3f5f811b949e8ec4e7770..8100a4de17592ce660ffa8d45a8635112a81ef55 100644 (file)
 #include "music.hh"
 #include "output-def.hh"
 #include "performer-group.hh"
+#include "scheme-engraver.hh"
 #include "scm-hash.hh"
 #include "warn.hh"
 
-
 void
 translator_each (SCM list, Translator_method method)
 {
@@ -152,15 +152,29 @@ Translator_group::create_child_translator (SCM sev)
 
   for (SCM s = trans_names; scm_is_pair (s); s = scm_cdr (s))
     {
-      Translator *type = get_translator (scm_car (s));
+      SCM definition = scm_car (s);
+
+      Translator *type = 0;
+      Translator *instance = type;
+      if (ly_is_symbol (definition))
+       {
+         type = get_translator (definition);
+         instance = type->clone ();
+       }
+      else if (ly_is_pair (definition))
+       {
+         type = get_translator (ly_symbol2scm ("Scheme_engraver"));
+         instance = type->clone ();
+         dynamic_cast<Scheme_engraver*> (instance)->init_from_scheme (definition);
+       }
+        
       if (!type)
        warning (_f ("cannot find: `%s'", ly_symbol2string (scm_car (s)).c_str ()));
       else
        {
-         Translator *tr = type->clone ();
-         SCM str = tr->self_scm ();
+         SCM str = instance->self_scm ();
 
-         if (tr->must_be_last ())
+         if (instance->must_be_last ())
            {
              SCM cons = scm_cons (str, SCM_EOL);
              if (scm_is_pair (trans_list))
@@ -171,13 +185,13 @@ Translator_group::create_child_translator (SCM sev)
          else
            trans_list = scm_cons (str, trans_list);
 
-         tr->daddy_context_ = new_context;
-         tr->unprotect ();
+         instance->daddy_context_ = new_context;
+         instance->unprotect ();
        }
     }
 
   /* Filter unwanted translator types. Required to make
-     \with {\consists "..."} work. */
+     \with { \consists "..." } work. */
   if (dynamic_cast<Engraver_group *> (g))
     g->simple_trans_list_ = filter_performers (trans_list);
   else if (dynamic_cast<Performer_group *> (g))
index d5615dc03c5406c7c0eee2c4cf7a62a2a5fad098..a24dc868346fcb95f2f5797fec108479dd6fddb1 100644 (file)
@@ -17,6 +17,7 @@
   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 */
 
+#include "context.hh"
 #include "context-def.hh"
 #include "translator-group.hh"
 #include "moment.hh"
@@ -41,3 +42,14 @@ LY_DEFINE (ly_translator_description, "ly:translator-description",
   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}.")
+{
+  LY_ASSERT_SMOB (Translator, trans, 1);
+  Translator *tr = unsmob_translator (trans);
+
+  Context *c = tr->context ();
+  return c ? c->self_scm () : SCM_BOOL_F;
+}
index da3aa8c1afe65a387aad61bec7054ac078c79739..399ecce602e57f3323bc3ebf0cf1072337c5bc41 100644 (file)
@@ -36,7 +36,6 @@ Translator::~Translator ()
 void
 Translator::init ()
 {
-  must_be_last_ = false;
   self_scm_ = SCM_EOL;
   daddy_context_ = 0;
   smobify_self ();
@@ -59,8 +58,8 @@ Translator::Translator ()
 
 Translator::Translator (Translator const &src)
 {
+  (void) src;
   init ();
-  must_be_last_ = src.must_be_last_;
 }
 
 Moment
@@ -121,15 +120,17 @@ Translator::finalize ()
 void
 Translator::connect_to_context (Context *c)
 {
-  for (translator_listener_record *r = get_listener_list (); r; r=r->next_)
-    c->events_below ()->add_listener (r->get_listener_ (this), r->event_class_);
+  for (translator_listener_record *r = get_listener_list (); r; r = r->next_)
+    c->events_below ()->add_listener (r->get_listener_ (this, r->event_class_),
+                                     r->event_class_);
 }
 
 void
 Translator::disconnect_from_context (Context *c)
 {
-  for (translator_listener_record *r = get_listener_list (); r; r=r->next_)
-    c->events_below ()->remove_listener (r->get_listener_ (this), r->event_class_);
+  for (translator_listener_record *r = get_listener_list (); r; r = r->next_)
+    c->events_below ()->remove_listener (r->get_listener_ (this, r->event_class_),
+                                        r->event_class_);
 }
 
 static SCM listened_event_class_table;
@@ -177,7 +178,7 @@ add_listened_event_class (SCM sym)
 void
 Translator::add_translator_listener (translator_listener_record **listener_list,
                                     translator_listener_record *r,
-                                    Listener (*get_listener) (void *), 
+                                    Listener (*get_listener) (void *, SCM), 
                                     const char *ev_class)
 {
   /* ev_class is the C++ identifier name. Convert to scm symbol */
@@ -258,7 +259,7 @@ IMPLEMENT_TYPE_P (Translator, "ly:translator?");
 bool
 Translator::must_be_last () const
 {
-  return must_be_last_;
+  return false;
 }
 
 void