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