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--2001 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   This is deprecated, since revert/override should be used
  19  */
  20 class Property_engraver : public Engraver
  21 {
  22   Scheme_hash_table *prop_dict_;        // junkme
  23   void apply_properties (SCM, Grob*, Translator_group *origin);
  24
  25 protected:
  26   virtual void acknowledge_grob (Grob_info ei);
  27   virtual void initialize ();
  28   virtual void finalize ();
  29 public:
  30   ~Property_engraver ();
  31   TRANSLATOR_DECLARATIONS(Property_engraver);
  32 };
  33
  34
  35
  36 Property_engraver::Property_engraver ()
  37 {
  38   prop_dict_ = 0;
  39 }
  40 void
  41 Property_engraver::finalize ()
  42 {
  43
  44 }
  45
  46 Property_engraver::~Property_engraver ()
  47 {
  48   if (prop_dict_)
  49     scm_gc_unprotect_object (prop_dict_->self_scm ());
  50 }
  51
  52 void
  53 Property_engraver::initialize ()
  54 {
  55   prop_dict_ = new Scheme_hash_table;
  56
  57   SCM plist = get_property ("Generic_property_list");
  58   for (; gh_pair_p (plist); plist = ly_cdr (plist))
  59     {
  60       SCM elt_props = ly_car (plist);
  61       prop_dict_->set (ly_car (elt_props), ly_cdr (elt_props));
  62     }
  63 }
  64
  65 void
  66 Property_engraver::acknowledge_grob (Grob_info i)
  67 {
  68   SCM ifs = i.grob_l_->get_grob_property ("interfaces");
  69   SCM props;
  70   for (; gh_pair_p (ifs); ifs = ly_cdr (ifs))
  71     {
  72       if (prop_dict_->try_retrieve (ly_car (ifs), &props))
  73         {
  74           apply_properties (props,i.grob_l_, i.origin_trans_l_->daddy_trans_l_);
  75         }
  76     }
  77
  78   if (prop_dict_->try_retrieve (ly_symbol2scm ("all"), &props))
  79     {
  80       apply_properties (props, i.grob_l_, i.origin_trans_l_->daddy_trans_l_);
  81     }
  82 }
  83
  84
  85 void
  86 Property_engraver::apply_properties (SCM p, Grob *e, Translator_group*origin)
  87 {
  88   for (; gh_pair_p (p); p = ly_cdr (p))
  89     {
  90       /*
  91         Try each property in order; earlier descriptions take
  92         precedence over later ones, and we don't touch elt-properties if
  93         they're already set.
  94       */
  95
  96       SCM entry = ly_car (p);
  97       SCM prop_sym = ly_car (entry);
  98       SCM type_p   = ly_cadr (entry);
  99       SCM elt_prop_sym = ly_caddr (entry);
 100
 101       SCM preset = scm_assq (elt_prop_sym, e->mutable_property_alist_);
 102       if (preset != SCM_BOOL_F)
 103         continue;
 104
 105       SCM val = internal_get_property (prop_sym);
 106
 107       if (val == SCM_EOL)
 108         ;                       // Not defined in context.
 109       else if (gh_apply (type_p, scm_list_n (val, SCM_UNDEFINED))
 110                == SCM_BOOL_T)   // defined and  right type: do it
 111         {
 112           e->internal_set_grob_property (elt_prop_sym, val);
 113
 114           SCM meta = e->get_grob_property ("meta");
 115           SCM name = scm_assoc (ly_symbol2scm ("name"), meta);
 116           warning (_f ("`%s' is deprecated.  Use\n \\property %s.%s \\override #'%s = #%s",
 117                        ly_symbol2string (prop_sym).ch_C (),
 118                        origin->type_str_.ch_C (),
 119                        ly_scm2string (ly_cdr (name)).ch_C (),
 120                        ly_symbol2string (elt_prop_sym).ch_C (),
 121                        ly_scm2string (ly_write2scm (val)).ch_C ()));
 122         }
 123       else
 124
 125         /*
 126             we don't print a warning if VAL == (), because we would
 127             get lots of warnings when we restore stuff to default, eg.
 128
 129             slurDash = #1 [...] slurDash = ()
 130
 131             should not cause "type error: slurDash expects number not
 132             boolean
 133
 134         */
 135         if (val != SCM_EOL)
 136           {                     // not the right type: error message.
 137             SCM errport = scm_current_error_port ();
 138             SCM typefunc = scm_primitive_eval (ly_symbol2scm ("type-name"));
 139             SCM type_name = gh_call1 (typefunc, type_p);
 140             warning (_f ("Wrong type for property: %s, type: %s, value found: %s, type: %s",
 141                          ly_symbol2string (prop_sym).ch_C (),
 142                          ly_scm2string (type_name).ch_C (),
 143                          ly_scm2string (ly_write2scm (val)).ch_C (),
 144                          ly_scm2string (ly_type (val)).ch_C ()));
 145             scm_puts ("\n", errport);
 146           }
 147     }
 148 }
 149
 150
 151 ENTER_DESCRIPTION(Property_engraver,
 152 /* descr */       "This is a engraver that converts property settings into
 153 back-end grob-property settings. Example: Voice.stemLength will set
 154 #'length in all Stem objects.
 155
 156 Due to CPU and memory requirements, the use of this engraver is deprecated.",
 157 /* creats*/       "",
 158 /* acks  */       "grob-interface",
 159 /* reads */       "Generic_property_list",
 160 /* write */       "");