lily/object-key-dumper.cc

   1 /*
   2   object-key-dumper.cc --  implement Object_key_dumper
   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 <map>
  12
  13 #include "ly-smobs.icc"
  14
  15 #include "moment.hh"
  16 #include "object-key-dumper.hh"
  17 #include "object-key.hh"
  18
  19
  20 SCM
  21 Object_key_dumper::mark_smob (SCM smob )
  22 {
  23   Object_key_dumper * dumper = (Object_key_dumper*) SCM_CELL_WORD_1 (smob);
  24
  25   for (Key_to_key_map::const_iterator i (dumper->serialized_keys_.begin ());
  26        i != dumper->serialized_keys_.end();
  27        i++)
  28     {
  29       scm_gc_mark ((*i).first->self_scm());
  30     }
  31   return SCM_EOL;
  32 }
  33
  34 int
  35 Object_key_dumper::print_smob (SCM, SCM port, scm_print_state*)
  36 {
  37   scm_puts ("#<Object_key_dumper>", port);
  38   return 1;
  39 }
  40
  41 IMPLEMENT_DEFAULT_EQUAL_P(Object_key_dumper);
  42 IMPLEMENT_SMOBS(Object_key_dumper);
  43
  44 Object_key_dumper::Object_key_dumper ()
  45 {
  46   file_contents_ = SCM_EOL;
  47   next_available_ = 0;
  48   smobify_self ();
  49 }
  50
  51 SCM
  52 Object_key_dumper::key_serial (int k)
  53 {
  54   return scm_list_2 (ly_symbol2scm ("key"),
  55                      scm_from_int (k));
  56 }
  57
  58 SCM
  59 Object_key_dumper::serialize_key (Object_key const *key)
  60 {
  61   SCM skey = key->dump();
  62   for (SCM s = skey ; scm_is_pair (s) ; s = scm_cdr (s))
  63     {
  64       if (Object_key const * sub_key = unsmob_key (scm_car (s)))
  65         {
  66           scm_set_car_x (s, dump_key (sub_key));
  67         }
  68       else if (Moment *mom = unsmob_moment (scm_car (s)))
  69         {
  70           scm_set_car_x (s,
  71                          scm_list_2 (ly_symbol2scm ("unquote"),
  72                                      mom->as_scheme()));
  73         }
  74     }
  75
  76   file_contents_ = scm_cons (scm_list_3 (ly_symbol2scm("define-key"),
  77                                          scm_from_int (next_available_),
  78                                          skey),
  79                              file_contents_);
  80
  81   serialized_keys_[key] = key;
  82   key_serial_numbers_[key] = next_available_;
  83   SCM retval = key_serial (next_available_);
  84   next_available_ ++;
  85
  86   return retval;
  87 }
  88
  89 SCM
  90 Object_key_dumper::dump_key (Object_key const *key)
  91 {
  92   if (key_serial_numbers_.find (key) != key_serial_numbers_.end ())
  93     {
  94       return key_serial (key_serial_numbers_[key]);
  95     }
  96   else if (Object_key const *serialized = serialized_keys_[key])
  97     {
  98       return key_serial (key_serial_numbers_[ serialized_keys_ [serialized] ]);
  99     }
 100
 101   return serialize_key (key);
 102 }
 103
 104 SCM
 105 Object_key_dumper::get_file_contents () const
 106 {
 107   return scm_reverse (file_contents_);
 108 }
 109
 110 LY_DEFINE(ly_make_dumper, "ly:make-dumper",
 111           0,0,0,
 112           (),
 113           "Create a key dumper. "
 114           )
 115 {
 116   Object_key_dumper *u = new Object_key_dumper ();
 117   SCM x = u->self_scm();
 118   scm_gc_unprotect_object (x);
 119   return x;
 120 }
 121
 122 LY_DEFINE(ly_dumper_definitions, "ly:dumper-definitions",
 123           1,0,0,
 124           (SCM dumper),
 125           "Return list of key definitions. "
 126           )
 127 {
 128   Object_key_dumper *u = unsmob_key_dumper (dumper);
 129   SCM_ASSERT_TYPE(u, dumper, SCM_ARG1, __FUNCTION__, "dumper");
 130   return u->get_file_contents();
 131 }
 132
 133 LY_DEFINE(ly_dumper_key_serial, "ly:dumper-key-serial",
 134           2,0,0,
 135           (SCM dumper, SCM key),
 136           "Return the  key serial number @var{key}. "
 137           )
 138 {
 139   Object_key_dumper* u = unsmob_key_dumper (dumper);
 140   Object_key *k = unsmob_key (key);
 141   SCM_ASSERT_TYPE(u, dumper, SCM_ARG1, __FUNCTION__, "dumper");
 142   SCM_ASSERT_TYPE(k, key, SCM_ARG2, __FUNCTION__, "key");
 143   return u->dump_key (k);
 144 }
 145
 146 Object_key_dumper::~Object_key_dumper()
 147 {
 148 }