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