lily/object-key-undumper.cc

   1 /*
   2   object-key-undumper.cc --  implement Object_key_undumper
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2004 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7
   8 */
   9
  10 #include <map>
  11
  12
  13 #include "smobs.hh"
  14 #include "object-key.hh"
  15 #include "object-key-undumper.hh"
  16
  17 #include "ly-smobs.icc"
  18
  19 IMPLEMENT_SMOBS(Object_key_undumper);
  20 IMPLEMENT_DEFAULT_EQUAL_P(Object_key_undumper);
  21
  22 SCM
  23 Object_key_undumper::mark_smob (SCM smob)
  24 {
  25   Object_key_undumper * undumper = (Object_key_undumper*) SCM_CELL_WORD_1(smob);
  26   for (Int_to_key_map::const_iterator i (undumper->keys_.begin());
  27        i != undumper->keys_.end(); i++)
  28     {
  29       scm_gc_mark ((*i).second->self_scm ());
  30     }
  31
  32   return SCM_BOOL_F;
  33 }
  34
  35 int
  36 Object_key_undumper::print_smob (SCM s, SCM port, scm_print_state*)
  37 {
  38   scm_puts ("#<Object_key_undumper>", port);
  39   return 1;
  40 }
  41
  42
  43 Object_key_undumper::Object_key_undumper ()
  44 {
  45   smobify_self();
  46 }
  47
  48
  49 LY_DEFINE(ly_undumper_read_keys, "ly:undumper-read-keys",
  50           2,0,0,
  51           (SCM undumper, SCM keys),
  52           "Read serialized @var{keys} into @var{undumper}."
  53           )
  54 {
  55   Object_key_undumper *u = unsmob_key_undumper (undumper);
  56   SCM_ASSERT_TYPE(u, undumper, SCM_ARG1, __FUNCTION__, "Undumper");
  57
  58   u->parse_contents (keys);
  59   return SCM_UNSPECIFIED;
  60 }
  61
  62 LY_DEFINE(ly_make_undumper, "ly:make-undumper",
  63           0, 0,0,
  64           (),
  65           "Create a key undumper. "
  66           )
  67 {
  68   Object_key_undumper *u = new Object_key_undumper ();
  69   SCM x = u->self_scm();
  70   scm_gc_unprotect_object (x);
  71   return x;
  72 }
  73
  74
  75 LY_DEFINE(ly_undumper_lookup, "ly:undumper-lookup",
  76           2,0,0,
  77           (SCM undumper, SCM serial),
  78           "Return the object key for number @var{serial}. "
  79           )
  80
  81 {
  82   Object_key_undumper* u = unsmob_key_undumper (undumper);
  83
  84   SCM_ASSERT_TYPE(u, undumper, SCM_ARG1, __FUNCTION__, "undumper");
  85   SCM_ASSERT_TYPE(scm_is_integer(serial), serial, SCM_ARG2, __FUNCTION__, "integer");
  86   return u->get_key (scm_to_int (serial))->self_scm();
  87 }
  88
  89
  90 void
  91 Object_key_undumper::parse_contents (SCM contents)
  92 {
  93   for (SCM s = contents; scm_is_pair (s); s = scm_cdr (s))
  94     {
  95       SCM entry = scm_car (s);
  96       if (scm_car (entry) != ly_symbol2scm ("define-key"))
  97         continue;
  98
  99
 100       int number = scm_to_int (scm_cadr (entry));
 101       SCM skey = scm_caddr (entry);
 102
 103       SCM new_key = SCM_EOL;
 104       SCM *tail = &new_key;
 105       for (SCM t = skey; scm_is_pair (t); t = scm_cdr (t))
 106         {
 107           SCM item = scm_car (t);
 108           if (scm_is_pair (item)
 109               && scm_car (item) == ly_symbol2scm ("key"))
 110             {
 111               int index = scm_to_int (scm_cadr (item));
 112               Object_key const *key = get_key (index);
 113               *tail = scm_cons (key->self_scm(), SCM_EOL);
 114             }
 115           else
 116             {
 117               *tail = scm_cons (item, SCM_EOL);
 118             }
 119           tail = SCM_CDRLOC(*tail);
 120         }
 121
 122       Object_key *k = Object_key::undump (new_key);
 123       keys_[number] = k;
 124       scm_gc_unprotect_object (k->self_scm());
 125     }
 126
 127 }
 128
 129 Object_key const*
 130 Object_key_undumper::get_key (int idx)
 131 {
 132   Int_to_key_map::const_iterator i (keys_.find (idx));
 133   assert (i != keys_.end());
 134
 135   return (*i).second;
 136 }
 137
 138 Object_key_undumper::~Object_key_undumper()
 139 {
 140 }