]> git.donarmstrong.com Git - lilypond.git/blob - lily/object-key-dumper.cc
(Invoking lilypond-book):
[lilypond.git] / 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 }