lily/property-engraver.cc

   1 /*
   2   property-engraver.cc --  implement Property engraver
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1999--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #include "lily-guile.hh"
  11 #include "engraver.hh"
  12 #include "protected-scm.hh"
  13 #include "dictionary.hh"
  14 #include "score-element.hh"
  15 #include "scm-hash.hh"
  16
  17 class Property_engraver : public Engraver
  18 {
  19   /*
  20     UGH. Junk Dictionary
  21   */
  22   Scheme_hash_table prop_dict_; // junkme
  23   void apply_properties (SCM, Score_element*);
  24
  25 protected:
  26   virtual void acknowledge_element (Score_element_info ei);
  27   virtual void do_creation_processing ();
  28
  29   VIRTUAL_COPY_CONS(Translator);
  30 };
  31
  32 void
  33 Property_engraver::do_creation_processing ()
  34 {
  35   SCM plist = get_property ("Generic_property_list");
  36   for (; gh_pair_p (plist); plist = gh_cdr (plist))
  37     {
  38       SCM elt_props = gh_car (plist);
  39       prop_dict_.set (gh_car (elt_props), gh_cdr (elt_props));
  40     }
  41 }
  42
  43 void
  44 Property_engraver::acknowledge_element (Score_element_info i)
  45 {
  46   SCM ifs = i.elem_l_->get_elt_property ("interfaces");
  47   SCM props;
  48   for (; gh_pair_p (ifs); ifs = gh_cdr (ifs))
  49     {
  50       if (prop_dict_.try_retrieve (gh_car (ifs), &props))
  51         {
  52           apply_properties (props,i.elem_l_);
  53         }
  54     }
  55
  56   if (prop_dict_.try_retrieve (ly_symbol2scm ("all"), &props))
  57     {
  58       apply_properties (props, i.elem_l_);
  59     }
  60 }
  61
  62
  63 void
  64 Property_engraver::apply_properties (SCM p, Score_element *e)
  65 {
  66   for (; gh_pair_p (p); p = gh_cdr (p))
  67     {
  68       /*
  69         Try each property in order; earlier descriptions take
  70         precedence over later ones, and we don't touch elt-properties if
  71         they're already set.
  72       */
  73
  74       SCM entry = gh_car (p);
  75       SCM prop_sym = gh_car (entry);
  76       SCM type_p   = gh_cadr (entry);
  77       SCM elt_prop_sym = gh_caddr (entry);
  78
  79       SCM preset = e->get_elt_property (elt_prop_sym); // scm_assq(elt_prop_sym, e->property_alist_);
  80       if (preset != SCM_EOL)
  81         continue;
  82
  83       SCM val = get_property (prop_sym);
  84
  85       if (val == SCM_UNDEFINED)
  86         ;                       // Not defined in context.
  87       else if (gh_apply (type_p, scm_listify (val, SCM_UNDEFINED))
  88                == SCM_BOOL_T)   // defined and  right type: do it
  89         e->set_elt_property (elt_prop_sym, val);
  90       else
  91
  92         /*
  93             we don't print a warning if VAL == #f, because we would
  94             get lots of warnings when we restore stuff to default, eg.
  95
  96             slurDash = #1 [...] slurDash = ##f
  97
  98             should not cause "type error: slurDash expects number not
  99             boolean"
 100
 101         */
 102         if (val != SCM_BOOL_F)
 103           {                     // not the right type: error message.
 104             SCM errport = scm_current_error_port ();
 105             warning (_("Wrong type for property"));
 106             scm_display (prop_sym, errport);
 107             scm_puts (", type predicate: ", errport);
 108             scm_display (type_p, errport);
 109             scm_puts (", value found: ", errport);
 110             scm_display (val, errport);
 111             scm_puts (" type: ", errport);
 112             scm_display (ly_type (val), errport);
 113             scm_puts ("\n", errport);
 114           }
 115     }
 116 }
 117
 118 ADD_THIS_TRANSLATOR(Property_engraver);