2 property-engraver.cc -- implement Property engraver
4 source file of the GNU LilyPond music typesetter
6 (c) 1999--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
10 #include "lily-guile.hh"
11 #include "engraver.hh"
12 #include "dictionary.hh"
13 #include "score-element.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, Score_element*, Translator_group *origin);
30 virtual void acknowledge_element (Score_element_info ei);
31 virtual void do_creation_processing ();
32 virtual void do_removal_processing ();
36 VIRTUAL_COPY_CONS(Translator);
41 Property_engraver::Property_engraver()
46 Property_engraver::do_removal_processing()
51 Property_engraver::~Property_engraver ()
54 scm_unprotect_object (prop_dict_->self_scm ());
58 Property_engraver::do_creation_processing ()
60 prop_dict_ = new Scheme_hash_table;
62 SCM plist = get_property (ly_symbol2scm ("Generic_property_list"));
63 for (; gh_pair_p (plist); plist = gh_cdr (plist))
65 SCM elt_props = gh_car (plist);
66 prop_dict_->set (gh_car (elt_props), gh_cdr (elt_props));
71 Property_engraver::acknowledge_element (Score_element_info i)
73 SCM ifs = i.elem_l_->get_elt_property ("interfaces");
75 for (; gh_pair_p (ifs); ifs = gh_cdr (ifs))
77 if (prop_dict_->try_retrieve (gh_car (ifs), &props))
79 apply_properties (props,i.elem_l_, i.origin_trans_l_->daddy_trans_l_);
83 if (prop_dict_->try_retrieve (ly_symbol2scm ("all"), &props))
85 apply_properties (props, i.elem_l_, i.origin_trans_l_->daddy_trans_l_);
91 Property_engraver::apply_properties (SCM p, Score_element *e, Translator_group*origin)
93 for (; gh_pair_p (p); p = gh_cdr (p))
96 Try each property in order; earlier descriptions take
97 precedence over later ones, and we don't touch elt-properties if
101 SCM entry = gh_car (p);
102 SCM prop_sym = gh_car (entry);
103 SCM type_p = gh_cadr (entry);
104 SCM elt_prop_sym = gh_caddr (entry);
106 SCM preset = scm_assq(elt_prop_sym, e->mutable_property_alist_);
107 if (preset != SCM_BOOL_F)
110 SCM val = get_property (prop_sym);
112 if (val == SCM_UNDEFINED)
113 ; // Not defined in context.
114 else if (gh_apply (type_p, scm_listify (val, SCM_UNDEFINED))
115 == SCM_BOOL_T) // defined and right type: do it
117 e->set_elt_property (elt_prop_sym, val);
119 SCM errport = scm_current_error_port ();
120 scm_display (prop_sym, errport);
121 scm_puts (_(" is deprecated. Use\n \\property ").ch_C(), errport);
123 scm_puts (origin->type_str_.ch_C(), errport);
124 scm_puts (".", errport);
126 SCM name = e->get_elt_property ("meta");
127 name = scm_assoc (ly_symbol2scm ("name"), name);
128 scm_display (gh_cdr(name), errport);
129 scm_puts(" \\push #'",errport);
130 scm_display (elt_prop_sym,errport);
131 scm_puts ( " = #",errport);
132 if (gh_string_p (val))
133 scm_puts ("\"", errport);
134 scm_display (val, scm_current_error_port ());
135 if (gh_string_p (val))
136 scm_puts ("\"", errport);
137 scm_puts ("\n", errport);
142 we don't print a warning if VAL == #f, because we would
143 get lots of warnings when we restore stuff to default, eg.
145 slurDash = #1 [...] slurDash = ##f
147 should not cause "type error: slurDash expects number not
151 if (val != SCM_BOOL_F)
152 { // not the right type: error message.
153 SCM errport = scm_current_error_port ();
154 warning (_("Wrong type for property"));
155 scm_display (prop_sym, errport);
156 scm_puts (", type: ", errport);
158 SCM typefunc = scm_eval2 (ly_symbol2scm ("type-name"), SCM_EOL);
160 scm_display (gh_call1 (typefunc, type_p), errport);
161 scm_puts (", value found: ", errport);
162 scm_display (val, errport);
163 scm_puts (" type: ", errport);
164 scm_display (ly_type (val), errport);
165 scm_puts ("\n", errport);
170 ADD_THIS_TRANSLATOR(Property_engraver);