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   initialize_function_ = SCM_EOL;
  33   finalize_function_ = SCM_EOL;
  34
  35   interface_acknowledger_hash_.set (SCM_EOL, SCM_EOL);
  36
  37   must_be_last_ = false;
  38   per_instance_listeners_ = SCM_EOL;
  39   for (int i = 0; i < TRANSLATOR_METHOD_PRECOMPUTE_COUNT; i++)
  40     precomputable_methods_[i] = SCM_UNDEFINED;
  41
  42   init_from_scheme (definition);
  43 }
  44
  45 Scheme_engraver::~Scheme_engraver ()
  46 {
  47 }
  48
  49 // Extracts the value if callable, if not return SCM_UNDEFINED;
  50 static SCM
  51 callable (SCM symbol, SCM defn)
  52 {
  53   SCM val = ly_assoc_get (symbol, defn, SCM_BOOL_F);
  54   return ly_is_procedure (val) ? val : SCM_UNDEFINED;
  55 }
  56
  57 bool
  58 Scheme_engraver::must_be_last () const
  59 {
  60   return must_be_last_;
  61 }
  62
  63 void
  64 Scheme_engraver::fetch_precomputable_methods (SCM ptrs[])
  65 {
  66   for (int i = 0; i < TRANSLATOR_METHOD_PRECOMPUTE_COUNT; i++)
  67     ptrs[i] = precomputable_methods_[i];
  68 }
  69
  70 void
  71 Scheme_engraver::init_from_scheme (SCM definition)
  72 {
  73   precomputable_methods_[START_TRANSLATION_TIMESTEP]
  74     = callable (ly_symbol2scm ("start-translation-timestep"), definition);
  75   precomputable_methods_[STOP_TRANSLATION_TIMESTEP]
  76     = callable (ly_symbol2scm ("stop-translation-timestep"), definition);
  77   precomputable_methods_[PROCESS_MUSIC]
  78     = callable (ly_symbol2scm ("process-music"), definition);
  79   precomputable_methods_[PROCESS_ACKNOWLEDGED]
  80     = callable (ly_symbol2scm ("process-acknowledged"), definition);
  81   initialize_function_ = callable (ly_symbol2scm ("initialize"), definition);
  82   finalize_function_ = callable (ly_symbol2scm ("finalize"), definition);
  83
  84   SCM p = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL);
  85   SCM listeners = SCM_EOL;
  86
  87   must_be_last_ = to_boolean (ly_assoc_get (ly_symbol2scm ("must-be-last"),
  88                                             definition,
  89                                             SCM_BOOL_F));
  90
  91   for (; scm_is_pair (p); p = scm_cdr (p))
  92     {
  93       SCM event_class = scm_caar (p);
  94       SCM proc = scm_cdar (p);
  95
  96       if (!(ly_is_procedure (proc) && ly_is_symbol (event_class)))
  97         continue;
  98
  99       // We should check the arity of the function?
 100
 101       // Record for later lookup.
 102       listeners = scm_acons (event_class, proc, listeners);
 103     }
 104
 105   SCM hash1 =
 106     init_acknowledgers (ly_assoc_get (ly_symbol2scm ("acknowledgers"),
 107                                       definition, SCM_EOL));
 108   SCM hash2 =
 109     init_acknowledgers (ly_assoc_get (ly_symbol2scm ("end-acknowledgers"),
 110                                       definition, SCM_EOL));
 111
 112   per_instance_listeners_ = listeners;
 113   interface_acknowledger_hash_.set (hash1, hash2);
 114
 115   // It's not defined whether Scheme_engraver::derived_mark is already
 116   // active while the construction is underway, so we make sure we
 117   // keep a version of everything on the stack that is not still
 118   // covered by `definition'.
 119
 120   scm_remember_upto_here_2 (definition, listeners);
 121   scm_remember_upto_here_2 (hash1, hash2);
 122
 123   // TODO: hook up description, props read/written, grobs created
 124   // etc. to provide automatic documentation.
 125 }
 126
 127 SCM
 128 Scheme_engraver::init_acknowledgers (SCM alist)
 129 {
 130   SCM hash = Scheme_hash_table::make_smob ();
 131   for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
 132     {
 133       SCM iface = scm_caar (p);
 134       SCM proc = scm_cdar (p);
 135
 136       if (!(ly_is_procedure (proc) && ly_is_symbol (iface)))
 137         continue;
 138
 139       unsmob<Scheme_hash_table>(hash)->set (iface, proc);
 140     }
 141   return hash;
 142 }
 143
 144 SCM
 145 Scheme_engraver::get_listener_list () const
 146 {
 147   return per_instance_listeners_;
 148 }
 149
 150 void
 151 Scheme_engraver::initialize ()
 152 {
 153   if (!SCM_UNBNDP (initialize_function_))
 154     scm_call_1 (initialize_function_, self_scm ());
 155 }
 156
 157 void
 158 Scheme_engraver::finalize ()
 159 {
 160   if (!SCM_UNBNDP (finalize_function_))
 161     scm_call_1 (finalize_function_, self_scm ());
 162 }
 163
 164 void
 165 Scheme_engraver::derived_mark () const
 166 {
 167   for (int i = 0; i < TRANSLATOR_METHOD_PRECOMPUTE_COUNT; i++)
 168     scm_gc_mark (precomputable_methods_[i]);
 169
 170   scm_gc_mark (initialize_function_);
 171   scm_gc_mark (finalize_function_);
 172   scm_gc_mark (per_instance_listeners_);
 173   scm_gc_mark (interface_acknowledger_hash_[START]);
 174   scm_gc_mark (interface_acknowledger_hash_[STOP]);
 175 }