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--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 */
   8
   9 #include "object-key-dumper.hh"
  10
  11 #include "moment.hh"
  12
  13 #include "ly-smobs.icc"
  14
  15 SCM
  16 Object_key_dumper::mark_smob (SCM smob)
  17 {
  18   Object_key_dumper *dumper = (Object_key_dumper *) SCM_CELL_WORD_1 (smob);
  19
  20   for (Key_to_key_map::const_iterator i (dumper->serialized_keys_.begin ());
  21        i != dumper->serialized_keys_.end ();
  22        i++)
  23     scm_gc_mark ((*i).first->self_scm ());
  24   return SCM_EOL;
  25 }
  26
  27 int
  28 Object_key_dumper::print_smob (SCM, SCM port, scm_print_state*)
  29 {
  30   scm_puts ("#<Object_key_dumper>", port);
  31   return 1;
  32 }
  33
  34 IMPLEMENT_DEFAULT_EQUAL_P (Object_key_dumper);
  35 IMPLEMENT_SMOBS (Object_key_dumper);
  36
  37 Object_key_dumper::Object_key_dumper ()
  38 {
  39   file_contents_ = SCM_EOL;
  40   next_available_ = 0;
  41   smobify_self ();
  42 }
  43
  44 SCM
  45 Object_key_dumper::key_serial (int k)
  46 {
  47   return scm_list_2 (ly_symbol2scm ("key"),
  48                      scm_from_int (k));
  49 }
  50
  51 SCM
  52 Object_key_dumper::serialize_key (Object_key const *key)
  53 {
  54   SCM skey = key->dump ();
  55   for (SCM s = skey; scm_is_pair (s); s = scm_cdr (s))
  56     {
  57       if (Object_key const *sub_key = unsmob_key (scm_car (s)))
  58         scm_set_car_x (s, dump_key (sub_key));
  59       else if (Moment *mom = unsmob_moment (scm_car (s)))
  60         scm_set_car_x (s,
  61                        scm_list_2 (ly_symbol2scm ("unquote"),
  62                                    mom->as_scheme ()));
  63     }
  64
  65   file_contents_ = scm_cons (scm_list_3 (ly_symbol2scm ("define-key"),
  66                                          scm_from_int (next_available_),
  67                                          skey),
  68                              file_contents_);
  69
  70   serialized_keys_[key] = key;
  71   key_serial_numbers_[key] = next_available_;
  72   SCM retval = key_serial (next_available_);
  73   next_available_++;
  74
  75   return retval;
  76 }
  77
  78 SCM
  79 Object_key_dumper::dump_key (Object_key const *key)
  80 {
  81   if (key_serial_numbers_.find (key) != key_serial_numbers_.end ())
  82     return key_serial (key_serial_numbers_[key]);
  83   else if (Object_key const *serialized = serialized_keys_[key])
  84     return key_serial (key_serial_numbers_[ serialized_keys_ [serialized] ]);
  85
  86   return serialize_key (key);
  87 }
  88
  89 SCM
  90 Object_key_dumper::get_file_contents () const
  91 {
  92   return scm_reverse (file_contents_);
  93 }
  94
  95 Object_key_dumper::~Object_key_dumper ()
  96 {
  97 }