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