lily/tweak-registration.cc

   1 /*
   2   tweak-registration.cc --  implement Tweak_registry
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7
   8 */
   9
  10
  11 #include "object-key-undumper.hh"
  12 #include "tweak-registration.hh"
  13 #include "object-key.hh"
  14 #include "grob.hh"
  15
  16 #include "ly-smobs.icc"
  17
  18
  19 void
  20 Tweak_registry::clear ()
  21 {
  22   tweaks_.clear ();
  23   undumper_ = new Object_key_undumper();
  24   scm_gc_unprotect_object (undumper_->self_scm ());
  25 }
  26
  27 void
  28 Tweak_registry::insert_tweak_from_file (SCM tweak)
  29 {
  30   SCM skey = scm_car (tweak);
  31
  32   assert(scm_is_pair (skey) &&
  33          scm_car (skey) == ly_symbol2scm ("key"));
  34
  35   Object_key const * key =  undumper_->get_key (scm_to_int (scm_cadr (skey)));
  36   if (tweaks_.find (key) == tweaks_.end())
  37     {
  38       tweaks_[key] = SCM_EOL;
  39     }
  40
  41   tweaks_[key] = scm_cons (scm_cdr (tweak), tweaks_[key]);
  42 }
  43
  44
  45 void
  46 Tweak_registry::insert_grob_tweak (Grob *g, SCM tweak)
  47 {
  48   Object_key const * key =  g->get_key ();
  49   if (tweaks_.find (key) == tweaks_.end())
  50     {
  51       tweaks_[key] = SCM_EOL;
  52     }
  53
  54   tweaks_[key] = scm_cons (tweak, tweaks_[key]);
  55 }
  56
  57
  58 SCM
  59 Tweak_registry::get_tweaks (Grob *g)
  60 {
  61   Object_key const *key = g->get_key();
  62   if (tweaks_.find (key) == tweaks_.end())
  63     {
  64       return SCM_EOL;
  65     }
  66   return tweaks_[key];
  67 }
  68
  69 Tweak_registry::Tweak_registry ()
  70 {
  71   undumper_ = 0;
  72   smobify_self();
  73   undumper_ = new Object_key_undumper();
  74   scm_gc_unprotect_object (undumper_->self_scm ());
  75 }
  76
  77 Tweak_registry::~Tweak_registry ()
  78 {
  79 }
  80
  81 SCM
  82 Tweak_registry::list_tweaks ()
  83 {
  84   SCM retval = SCM_EOL;
  85   for (Tweak_map::const_iterator i (tweaks_.begin ());
  86        i != tweaks_.end();
  87        i++)
  88     {
  89       const Object_key *  key = (*i).first;
  90       for (SCM t = (*i).second; scm_is_pair (t); t = scm_cdr (t))
  91         {
  92           retval = scm_cons (scm_cons (key->self_scm(), scm_car (t)), retval);
  93         }
  94     }
  95
  96   return retval;
  97 }
  98
  99 SCM
 100 Tweak_registry::mark_smob (SCM smob)
 101 {
 102   Tweak_registry *me = (Tweak_registry*) SCM_CELL_WORD_1(smob);
 103
 104   for (Tweak_map::const_iterator i (me->tweaks_.begin ());
 105        i != me->tweaks_.end();
 106        i++)
 107     {
 108       scm_gc_mark ((*i).first->self_scm());
 109       scm_gc_mark ((*i).second);
 110     }
 111
 112   if (me->undumper_)
 113     scm_gc_mark (me->undumper_->self_scm());
 114
 115   return SCM_EOL;
 116 }
 117
 118 int
 119 Tweak_registry::print_smob (SCM smob, SCM port, scm_print_state*)
 120 {
 121   scm_puts ("#<Tweak_registry>", port);
 122   return 1;
 123 }
 124
 125 Object_key_undumper*
 126 Tweak_registry::undumper () const
 127 {
 128   return undumper_;
 129 }
 130
 131 IMPLEMENT_DEFAULT_EQUAL_P(Tweak_registry);
 132 IMPLEMENT_SMOBS(Tweak_registry);
 133
 134
 135 Tweak_registry  * global_registry_;
 136
 137 void
 138 init_global_tweak_registry()
 139 {
 140   global_registry_ = new Tweak_registry();
 141 }
 142
 143
 144 LY_DEFINE(ly_clear_tweak_registry, "ly:tweak-clear-registry",
 145           0,0,0,(),
 146           "Clear global tweak registry"
 147           )
 148 {
 149   global_registry_->clear ();
 150   return SCM_UNSPECIFIED;
 151 }
 152
 153 LY_DEFINE(ly_insert_tweak, "ly:insert-tweak",
 154           2,0,0,
 155           (SCM grob, SCM tweak),
 156           "add new tweak for grob."
 157           )
 158 {
 159   Grob *gr = unsmob_grob (grob);
 160   SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "Grob");
 161   SCM_ASSERT_TYPE(scm_list_p (tweak) == SCM_BOOL_T
 162                   && ly_c_procedure_p (scm_car (tweak)),
 163                   tweak, SCM_ARG2, __FUNCTION__, "Tweak");
 164
 165   global_registry_->insert_grob_tweak (gr, tweak);
 166   return SCM_UNSPECIFIED;
 167 }
 168
 169
 170 LY_DEFINE(ly_tweak_read_keys, "ly:tweak-define-keys",
 171           1,0,0,(SCM keys),
 172           "Read keys"
 173           )
 174 {
 175   global_registry_->undumper ()->parse_contents (keys);
 176   return SCM_UNSPECIFIED;
 177 }
 178
 179
 180 LY_DEFINE(ly_all_tweaks, "ly:all-tweaks",
 181           0,0,0,(),
 182           "all tweaks"
 183           )
 184 {
 185   return global_registry_->list_tweaks();
 186 }
 187
 188
 189 LY_DEFINE(ly_tweak_read_tweaks, "ly:tweak-define-tweaks",
 190           1,0,0,(SCM tweaks),
 191           "Read  tweaks"
 192           )
 193 {
 194   for (SCM s = tweaks; scm_is_pair (s); s = scm_cdr (s))
 195     {
 196       global_registry_->insert_tweak_from_file (scm_car (s));
 197     }
 198   return SCM_UNSPECIFIED;
 199 }