+ if (gh_symbol_p(prop))
+ {
+ if (val != SCM_UNDEFINED)
+ {
+ SCM prev = get_property (prop);
+
+ /*
+ we don't tack onto SCM_UNDEFINED, because it creates
+ errors down the line, if we do scm_assoc().
+ */
+ if (gh_pair_p (prev) || prev == SCM_EOL)
+ {
+ bool ok = true;
+
+ SCM errport = scm_current_error_port ();
+
+ SCM meta = scm_assoc (ly_symbol2scm ("meta"), prev);
+ SCM props = scm_assoc (ly_symbol2scm ("properties"), gh_cdr (meta));
+ SCM type_p = scm_assoc (eltprop, gh_cdr (props));
+ if (!gh_pair_p (type_p))
+ {
+ scm_puts (_("Couldn't find property description for #'").ch_C(),errport);
+ scm_display (eltprop, errport);
+
+ scm_puts (_(" in element description ").ch_C(),errport);
+ scm_display (prop, errport);
+
+ scm_puts (_(". Perhaps you made a typing error?\n").ch_C(),errport);
+ }
+ else
+ {
+ type_p = gh_cdr (type_p);
+ if (gh_call1 (type_p, val) == SCM_BOOL_F)
+ {
+ ok = false;
+ scm_puts (_("Failed typecheck for #'").ch_C (),errport);
+ scm_display (eltprop,errport);
+ scm_puts ( _(", value ").ch_C (), errport);
+ scm_write (val, errport);
+ scm_puts (_(" must be of type ").ch_C (), errport);
+ SCM typefunc = scm_eval2 (ly_symbol2scm ("type-name"), SCM_EOL);
+ scm_display (gh_call1 (typefunc, type_p), errport);
+ scm_puts ("\n", errport);
+ }
+ }
+
+ if (ok)
+ {
+ prev = gh_cons (gh_cons (eltprop, val), prev);
+ set_property (prop, prev);
+ }
+ }
+ else
+ {
+ // warning here.
+ }
+
+ }
+ else
+ {
+ SCM prev = get_property (prop);
+
+ SCM newprops= SCM_EOL ;
+ while (gh_pair_p (prev) && gh_caar (prev) != eltprop)
+ {
+ newprops = gh_cons (gh_car (prev), newprops);
+ prev = gh_cdr (prev);
+ }
+
+ if (gh_pair_p (prev))
+ {
+ newprops = scm_reverse_x (newprops, gh_cdr (prev));
+ set_property (prop, newprops);
+ }
+ }
+ }