2 property-engraver.cc -- implement Property engraver
4 source file of the GNU LilyPond music typesetter
6 (c) 1999--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "lily-guile.hh"
11 #include "engraver.hh"
12 #include "dictionary.hh"
14 #include "scm-hash.hh"
15 #include "translator-group.hh"
18 JUNKME: should use pushproperty everywhere.
21 class Property_engraver : public Engraver
26 Scheme_hash_table *prop_dict_; // junkme
27 void apply_properties (SCM, Grob*, Translator_group *origin);
30 virtual void acknowledge_grob (Grob_info ei);
31 virtual void initialize ();
32 virtual void finalize ();
34 ~Property_engraver ();
35 TRANSLATOR_DECLARATIONS(Property_engraver);
40 Property_engraver::Property_engraver ()
45 Property_engraver::finalize ()
50 Property_engraver::~Property_engraver ()
53 scm_gc_unprotect_object (prop_dict_->self_scm ());
57 Property_engraver::initialize ()
59 prop_dict_ = new Scheme_hash_table;
61 SCM plist = get_property (ly_symbol2scm ("Generic_property_list"));
62 for (; gh_pair_p (plist); plist = ly_cdr (plist))
64 SCM elt_props = ly_car (plist);
65 prop_dict_->set (ly_car (elt_props), ly_cdr (elt_props));
70 Property_engraver::acknowledge_grob (Grob_info i)
72 SCM ifs = i.grob_l_->get_grob_property ("interfaces");
74 for (; gh_pair_p (ifs); ifs = ly_cdr (ifs))
76 if (prop_dict_->try_retrieve (ly_car (ifs), &props))
78 apply_properties (props,i.grob_l_, i.origin_trans_l_->daddy_trans_l_);
82 if (prop_dict_->try_retrieve (ly_symbol2scm ("all"), &props))
84 apply_properties (props, i.grob_l_, i.origin_trans_l_->daddy_trans_l_);
90 Property_engraver::apply_properties (SCM p, Grob *e, Translator_group*origin)
92 for (; gh_pair_p (p); p = ly_cdr (p))
95 Try each property in order; earlier descriptions take
96 precedence over later ones, and we don't touch elt-properties if
100 SCM entry = ly_car (p);
101 SCM prop_sym = ly_car (entry);
102 SCM type_p = ly_cadr (entry);
103 SCM elt_prop_sym = ly_caddr (entry);
105 SCM preset = scm_assq (elt_prop_sym, e->mutable_property_alist_);
106 if (preset != SCM_BOOL_F)
109 SCM val = get_property (prop_sym);
112 ; // Not defined in context.
113 else if (gh_apply (type_p, scm_list_n (val, SCM_UNDEFINED))
114 == SCM_BOOL_T) // defined and right type: do it
116 e->set_grob_property (elt_prop_sym, val);
118 SCM meta = e->get_grob_property ("meta");
119 SCM name = scm_assoc (ly_symbol2scm ("name"), meta);
120 warning (_f ("`%s' is deprecated. Use\n \\property %s.%s \\override #'%s = #%s",
121 ly_symbol2string (prop_sym).ch_C (),
122 origin->type_str_.ch_C (),
123 ly_scm2string (ly_cdr (name)).ch_C (),
124 ly_symbol2string (elt_prop_sym).ch_C (),
125 ly_scm2string (ly_write2scm (val)).ch_C ()));
130 we don't print a warning if VAL == (), because we would
131 get lots of warnings when we restore stuff to default, eg.
133 slurDash = #1 [...] slurDash = ()
135 should not cause "type error: slurDash expects number not
140 { // not the right type: error message.
141 SCM errport = scm_current_error_port ();
142 SCM typefunc = scm_primitive_eval (ly_symbol2scm ("type-name"));
143 SCM type_name = gh_call1 (typefunc, type_p);
144 warning (_f ("Wrong type for property: %s, type: %s, value found: %s, type: %s",
145 ly_symbol2string (prop_sym).ch_C (),
146 ly_scm2string (type_name).ch_C (),
147 ly_scm2string (ly_write2scm (val)).ch_C (),
148 ly_scm2string (ly_type (val)).ch_C ()));
149 scm_puts ("\n", errport);
155 ENTER_DESCRIPTION(Property_engraver,
156 /* descr */ "This is a engraver that converts property settings into
157 back-end grob-property settings. Example: Voice.stemLength will set
158 #'length in all Stem objects.
160 Due to CPU and memory requirements, the use of this engraver is deprecated.",
162 /* acks */ "grob-interface",
163 /* reads */ "Generic_property_list",