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 "dictionary.hh"
  13 #include "score-element.hh"
  14 #include "scm-hash.hh"
  15
  16 /*
  17   JUNKME: should use pushproperty everywhere.
  18
  19  */
  20 class Property_engraver : public Engraver
  21 {
  22   /*
  23     UGH. Junk Dictionary
  24   */
  25   Scheme_hash_table *prop_dict_;        // junkme
  26   void apply_properties (SCM, Score_element*);
  27
  28 protected:
  29   virtual void acknowledge_element (Score_element_info ei);
  30   virtual void do_creation_processing ();
  31   virtual void do_removal_processing ();
  32 public:
  33   ~Property_engraver();
  34   Property_engraver();
  35   VIRTUAL_COPY_CONS(Translator);
  36 };
  37
  38
  39
  40 Property_engraver::Property_engraver()
  41 {
  42   prop_dict_ = 0;
  43 }
  44 void
  45 Property_engraver::do_removal_processing()
  46 {
  47
  48 }
  49
  50 Property_engraver::~Property_engraver ()
  51 {
  52   if (prop_dict_)
  53     scm_unprotect_object (prop_dict_->self_scm ());
  54 }
  55
  56 void
  57 Property_engraver::do_creation_processing ()
  58 {
  59   prop_dict_ = new Scheme_hash_table;
  60
  61   SCM plist = get_property ("Generic_property_list");
  62   for (; gh_pair_p (plist); plist = gh_cdr (plist))
  63     {
  64       SCM elt_props = gh_car (plist);
  65       prop_dict_->set (gh_car (elt_props), gh_cdr (elt_props));
  66     }
  67 }
  68
  69 void
  70 Property_engraver::acknowledge_element (Score_element_info i)
  71 {
  72   SCM ifs = i.elem_l_->get_elt_property ("interfaces");
  73   SCM props;
  74   for (; gh_pair_p (ifs); ifs = gh_cdr (ifs))
  75     {
  76       if (prop_dict_->try_retrieve (gh_car (ifs), &props))
  77         {
  78           apply_properties (props,i.elem_l_);
  79         }
  80     }
  81
  82   if (prop_dict_->try_retrieve (ly_symbol2scm ("all"), &props))
  83     {
  84       apply_properties (props, i.elem_l_);
  85     }
  86 }
  87
  88
  89 void
  90 Property_engraver::apply_properties (SCM p, Score_element *e)
  91 {
  92   for (; gh_pair_p (p); p = gh_cdr (p))
  93     {
  94       /*
  95         Try each property in order; earlier descriptions take
  96         precedence over later ones, and we don't touch elt-properties if
  97         they're already set.
  98       */
  99
 100       SCM entry = gh_car (p);
 101       SCM prop_sym = gh_car (entry);
 102       SCM type_p   = gh_cadr (entry);
 103       SCM elt_prop_sym = gh_caddr (entry);
 104
 105       SCM preset = scm_assq(elt_prop_sym, e->mutable_property_alist_);
 106       if (preset != SCM_BOOL_F)
 107         continue;
 108
 109       SCM val = get_property (prop_sym);
 110
 111       if (val == SCM_UNDEFINED)
 112         ;                       // Not defined in context.
 113       else if (gh_apply (type_p, scm_listify (val, SCM_UNDEFINED))
 114                == SCM_BOOL_T)   // defined and  right type: do it
 115         e->set_elt_property (elt_prop_sym, val);
 116       else
 117
 118         /*
 119             we don't print a warning if VAL == #f, because we would
 120             get lots of warnings when we restore stuff to default, eg.
 121
 122             slurDash = #1 [...] slurDash = ##f
 123
 124             should not cause "type error: slurDash expects number not
 125             boolean"
 126
 127         */
 128         if (val != SCM_BOOL_F)
 129           {                     // not the right type: error message.
 130             SCM errport = scm_current_error_port ();
 131             warning (_("Wrong type for property"));
 132             scm_display (prop_sym, errport);
 133             scm_puts (", type predicate: ", errport);
 134             scm_display (type_p, errport);
 135             scm_puts (", value found: ", errport);
 136             scm_display (val, errport);
 137             scm_puts (" type: ", errport);
 138             scm_display (ly_type (val), errport);
 139             scm_puts ("\n", errport);
 140           }
 141     }
 142 }
 143
 144 ADD_THIS_TRANSLATOR(Property_engraver);