release: 1.3.106

[lilypond.git] / lily / property-engraver.cc

diff --git a/lily/property-engraver.cc b/lily/property-engraver.cc
index 3a6f547c9176be4ee6081c5e779f7416f7178729..9861866e82442545206b97bdfc2f00153a1dd147 100644 (file)
--- a/lily/property-engraver.cc
+++ b/lily/property-engraver.cc
@@ -9,34 +9,61 @@
 
 #include "lily-guile.hh"
 #include "engraver.hh"
-#include "protected-scm.hh"
 #include "dictionary.hh"
 #include "score-element.hh"
 #include "scm-hash.hh"
+#include "translator-group.hh"
 
+/*
+  JUNKME: should use pushproperty everywhere.
+  
+ */
 class Property_engraver : public Engraver
 {
   /*
     UGH. Junk Dictionary
   */
-  Scheme_hash_table prop_dict_;        // junkme
-  void apply_properties (SCM, Score_element*);
+  Scheme_hash_table *prop_dict_;       // junkme
+  void apply_properties (SCM, Score_element*, Translator_group *origin);
 
 protected:
   virtual void acknowledge_element (Score_element_info ei);
   virtual void do_creation_processing ();
-
+  virtual void do_removal_processing ();
+public:
+  ~Property_engraver();
+  Property_engraver();
   VIRTUAL_COPY_CONS(Translator);
 };
 
+
+
+Property_engraver::Property_engraver()
+{
+  prop_dict_ = 0;
+}
+void
+Property_engraver::do_removal_processing()
+{
+  
+}
+
+Property_engraver::~Property_engraver ()
+{
+  if (prop_dict_)
+    scm_unprotect_object (prop_dict_->self_scm ());
+}
+
 void
 Property_engraver::do_creation_processing ()
 {
-  SCM plist = get_property ("Generic_property_list");
+  prop_dict_ = new Scheme_hash_table;
+
+  SCM plist = get_property (ly_symbol2scm ("Generic_property_list"));
   for (; gh_pair_p (plist); plist = gh_cdr (plist))
     {
       SCM elt_props = gh_car (plist);
-      prop_dict_.set (gh_car (elt_props), gh_cdr (elt_props));
+      prop_dict_->set (gh_car (elt_props), gh_cdr (elt_props));
     }
 }
 
@@ -47,22 +74,22 @@ Property_engraver::acknowledge_element (Score_element_info i)
   SCM props;
   for (; gh_pair_p (ifs); ifs = gh_cdr (ifs))
     {      
-      if (prop_dict_.try_retrieve (gh_car (ifs), &props))
+      if (prop_dict_->try_retrieve (gh_car (ifs), &props))
        {
-         apply_properties (props,i.elem_l_);
+         apply_properties (props,i.elem_l_, i.origin_trans_l_->daddy_trans_l_);
        }
     }
 
-  if (prop_dict_.try_retrieve (ly_symbol2scm ("all"), &props))
+  if (prop_dict_->try_retrieve (ly_symbol2scm ("all"), &props))
     {
-      apply_properties (props, i.elem_l_);
+      apply_properties (props, i.elem_l_, i.origin_trans_l_->daddy_trans_l_);
     }
 }
 
 
 void
-Property_engraver::apply_properties (SCM p, Score_element *e)
-{  
+Property_engraver::apply_properties (SCM p, Score_element *e, Translator_group*origin)
+{
   for (; gh_pair_p (p); p = gh_cdr (p))
     {
       /*
@@ -76,38 +103,59 @@ Property_engraver::apply_properties (SCM p, Score_element *e)
       SCM type_p   = gh_cadr (entry);
       SCM elt_prop_sym = gh_caddr (entry);
 
-      SCM preset = e->get_elt_property (elt_prop_sym); // scm_assq(elt_prop_sym, e->property_alist_);
-      if (preset != SCM_UNDEFINED)
+      SCM preset = scm_assq(elt_prop_sym, e->mutable_property_alist_);
+      if (preset != SCM_BOOL_F)
        continue;
   
       SCM val = get_property (prop_sym);
-     
-      if (val == SCM_UNDEFINED)
+
+      if (val == SCM_EOL)
        ;                       // Not defined in context.
       else if (gh_apply (type_p, scm_listify (val, SCM_UNDEFINED))
               == SCM_BOOL_T)   // defined and  right type: do it
-       e->set_elt_property (elt_prop_sym, val);
+       {
+         e->set_elt_property (elt_prop_sym, val);
+
+         SCM errport = scm_current_error_port ();
+         scm_display (prop_sym, errport);
+         scm_puts (_(" is deprecated. Use\n \\property ").ch_C(), errport);
+
+         scm_puts (origin->type_str_.ch_C(), errport);
+         scm_puts (".", errport);
+         
+         SCM name = e->get_elt_property ("meta");
+         name = scm_assoc (ly_symbol2scm ("name"), name);
+         scm_display (gh_cdr(name), errport);
+         scm_puts(" \\push #'",errport);
+         scm_write (elt_prop_sym,errport);
+         scm_puts ( " = #",errport);
+         scm_write (val, scm_current_error_port ());
+         scm_puts ("\n", errport);
+       }
       else
 
        /*
-           we don't print a warning if VAL == #f, because we would
+           we don't print a warning if VAL == (), because we would
            get lots of warnings when we restore stuff to default, eg.
 
-           slurDash = #1 [...] slurDash = ##f
+           slurDash = #1 [...] slurDash = ()
 
            should not cause "type error: slurDash expects number not
-           boolean"
+           boolean
 
        */
-       if (val != SCM_BOOL_F)
+       if (val != SCM_EOL)
          {                     // not the right type: error message.
            SCM errport = scm_current_error_port ();
            warning (_("Wrong type for property"));
            scm_display (prop_sym, errport);
-           scm_puts (", type predicate: ", errport);
-           scm_display (type_p, errport);
+           scm_puts (", type: ", errport);
+
+           SCM typefunc = scm_eval2 (ly_symbol2scm ("type-name"), SCM_EOL);
+           
+           scm_display (gh_call1 (typefunc, type_p), errport);
            scm_puts (", value found: ", errport);
-           scm_display (val, errport);
+           scm_write (val, errport);
            scm_puts (" type: ", errport);
            scm_display (ly_type (val), errport);
            scm_puts ("\n", errport);