lily/scheme-engraver.cc

   1 /*
   2   scheme-engraver.cc -- implement Scheme_engraver
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   Copyright (c) 2009--2015 Han-Wen Nienhuys <hanwen@lilypond.org>
   7
   8   LilyPond is free software: you can redistribute it and/or modify
   9   it under the terms of the GNU General Public License as published by
  10   the Free Software Foundation, either version 3 of the License, or
  11   (at your option) any later version.
  12
  13   LilyPond is distributed in the hope that it will be useful,
  14   but WITHOUT ANY WARRANTY; without even the implied warranty of
  15   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16   GNU General Public License for more details.
  17
  18   You should have received a copy of the GNU General Public License
  19   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  20 */
  21
  22 #include "scheme-engraver.hh"
  23
  24 #include "grob.hh"
  25
  26 #include "translator.icc"
  27
  28 #include "scm-hash.hh"
  29
  30 Scheme_engraver::Scheme_engraver (SCM definition)
  31 {
  32   stop_translation_timestep_function_ = SCM_EOL;
  33   start_translation_timestep_function_ = SCM_EOL;
  34   process_music_function_ = SCM_EOL;
  35   process_acknowledged_function_ = SCM_EOL;
  36   initialize_function_ = SCM_EOL;
  37   finalize_function_ = SCM_EOL;
  38
  39   interface_acknowledger_hash_ = SCM_EOL;
  40   interface_end_acknowledger_hash_ = SCM_EOL;
  41
  42   must_be_last_ = false;
  43   per_instance_listeners_ = SCM_EOL;
  44
  45   init_from_scheme (definition);
  46 }
  47
  48 Scheme_engraver::~Scheme_engraver ()
  49 {
  50 }
  51
  52 // Extracts the value if callable, if not return #f.
  53 static SCM
  54 callable (SCM symbol, SCM defn)
  55 {
  56   SCM val = ly_assoc_get (symbol, defn, SCM_BOOL_F);
  57   return ly_is_procedure (val) ? val : SCM_BOOL_F;
  58 }
  59
  60 bool
  61 Scheme_engraver::must_be_last () const
  62 {
  63   return must_be_last_;
  64 }
  65
  66 void
  67 Scheme_engraver::init_from_scheme (SCM definition)
  68 {
  69   start_translation_timestep_function_ = callable (ly_symbol2scm ("start-translation-timestep"),
  70                                                    definition);
  71   stop_translation_timestep_function_ = callable (ly_symbol2scm ("stop-translation-timestep"),
  72                                                   definition);
  73   process_music_function_ = callable (ly_symbol2scm ("process-music"), definition);
  74   process_acknowledged_function_ = callable (ly_symbol2scm ("process-acknowledged"),
  75                                              definition);
  76   initialize_function_ = callable (ly_symbol2scm ("initialize"), definition);
  77   finalize_function_ = callable (ly_symbol2scm ("finalize"), definition);
  78
  79   SCM listeners = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL);
  80
  81   per_instance_listeners_ = SCM_EOL;
  82
  83   must_be_last_ = to_boolean (ly_assoc_get (ly_symbol2scm ("must-be-last"),
  84                                             definition,
  85                                             SCM_BOOL_F));
  86
  87   for (SCM p = listeners; scm_is_pair (p); p = scm_cdr (p))
  88     {
  89       SCM event_class = scm_caar (p);
  90       SCM proc = scm_cdar (p);
  91
  92       if (!(ly_is_procedure (proc) && ly_is_symbol (event_class)))
  93         continue;
  94
  95       // We should check the arity of the function?
  96
  97       // Record for later lookup.
  98       per_instance_listeners_ = scm_acons (event_class, proc, per_instance_listeners_);
  99     }
 100
 101   init_acknowledgers (ly_assoc_get (ly_symbol2scm ("acknowledgers"),
 102                                     definition, SCM_EOL),
 103                       &interface_acknowledger_hash_);
 104
 105   init_acknowledgers (ly_assoc_get (ly_symbol2scm ("end-acknowledgers"),
 106                                     definition, SCM_EOL),
 107                       &interface_end_acknowledger_hash_);
 108
 109   // TODO: hook up description, props read/written, grobs created
 110   // etc. to provide automatic documentation.
 111 }
 112
 113 void
 114 Scheme_engraver::init_acknowledgers (SCM alist,
 115                                      SCM *hash)
 116 {
 117   *hash = Scheme_hash_table::make_smob ();
 118   for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
 119     {
 120       SCM iface = scm_caar (p);
 121       SCM proc = scm_cdar (p);
 122
 123       if (!(ly_is_procedure (proc) && ly_is_symbol (iface)))
 124         continue;
 125
 126       unsmob<Scheme_hash_table>(*hash)->set (iface, proc);
 127     }
 128 }
 129
 130 SCM
 131 Scheme_engraver::get_listener_list () const
 132 {
 133   return per_instance_listeners_;
 134 }
 135
 136 #define DISPATCH(what)                                  \
 137   void                                                  \
 138   Scheme_engraver::what ()                              \
 139   {                                                     \
 140     if (what ## _function_ != SCM_BOOL_F)               \
 141       scm_call_1 (what ## _function_, self_scm ());     \
 142   }
 143
 144 DISPATCH (start_translation_timestep);
 145 DISPATCH (stop_translation_timestep);
 146 DISPATCH (initialize);
 147 DISPATCH (finalize);
 148 DISPATCH (process_music);
 149 DISPATCH (process_acknowledged);
 150
 151 void
 152 Scheme_engraver::derived_mark () const
 153 {
 154   scm_gc_mark (start_translation_timestep_function_);
 155   scm_gc_mark (stop_translation_timestep_function_);
 156   scm_gc_mark (initialize_function_);
 157   scm_gc_mark (finalize_function_);
 158   scm_gc_mark (process_music_function_);
 159   scm_gc_mark (process_acknowledged_function_);
 160   scm_gc_mark (per_instance_listeners_);
 161   scm_gc_mark (interface_acknowledger_hash_);
 162   scm_gc_mark (interface_end_acknowledger_hash_);
 163 }
 164
 165 ADD_TRANSLATOR_FAMILY (Scheme_engraver);