lily/grob-property.cc

   1 /*
   2   Implement storage and manipulation of grob properties.
   3 */
   4
   5 #include <cstring>
   6
   7 #include "main.hh"
   8 #include "input.hh"
   9 #include "pointer-group-interface.hh"
  10 #include "misc.hh"
  11 #include "paper-score.hh"
  12 #include "output-def.hh"
  13 #include "spanner.hh"
  14 #include "international.hh"
  15 #include "item.hh"
  16 #include "misc.hh"
  17 #include "item.hh"
  18 #include "program-option.hh"
  19 #include "profile.hh"
  20 #include "simple-closure.hh"
  21 #include "warn.hh"
  22
  23 #ifndef NDEBUG
  24 static SCM modification_callback = SCM_EOL;
  25
  26 LY_DEFINE (ly_set_grob_modification_callback, "ly:set-grob-modification-callback",
  27            1, 0, 0, (SCM cb),
  28            "Specify a procedure that will be called every time lilypond modifies "
  29            "a grob property. The callback will receive as arguments "
  30            "the grob that is being modified, the name of the C++ file in which "
  31            "the modification was requested, the line number in the C++ file in "
  32            "which the modification was requested, the property to be changed and "
  33            "the new value for the property.")
  34 {
  35   LY_ASSERT_TYPE (ly_is_procedure, cb, 1);
  36
  37   modification_callback = cb;
  38   return SCM_UNSPECIFIED;
  39 }
  40 #endif
  41
  42 SCM
  43 Grob::get_property_alist_chain (SCM def) const
  44 {
  45   return scm_list_n (mutable_property_alist_,
  46                      immutable_property_alist_,
  47                      def,
  48                      SCM_UNDEFINED);
  49 }
  50
  51
  52 extern void check_interfaces_for_property (Grob const *me, SCM sym);
  53
  54 #if 0
  55
  56 /*
  57   We can't change signatures depending on NDEBUG, since NDEBUG comes
  58   over the command line and may be different per .cc file.  This
  59   should be done through the macro expansion of get_property ().
  60  */
  61 void
  62 Grob::internal_set_property (SCM sym, SCM v, char const *file, int line, char const *fun)
  63 {
  64   SCM grob_p = ly_lily_module_constant ("ly:grob?");
  65   SCM grob_list_p = ly_lily_module_constant ("grob-list?");
  66   SCM type = scm_object_property (sym, ly_symbol2scm ("backend-type?"));
  67
  68   if (type == grob_p
  69       || type == grob_list_p
  70       || (unsmob_grob (v) && ly_symbol2scm ("cause") != sym))
  71     {
  72       scm_display (scm_list_2 (sym, type), scm_current_output_port ());
  73       assert (0);
  74     }
  75
  76   internal_set_value_on_alist (&mutable_property_alist_,
  77                                sym, v);
  78
  79
  80   if (ly_is_procedure (modification_callback))
  81     scm_apply_0 (modification_callback,
  82                  scm_list_n (self_scm (),
  83                              scm_from_locale_string (file),
  84                              scm_from_int (line),
  85                              scm_from_locale_string (fun),
  86                              sym, v, SCM_UNDEFINED));
  87 }
  88 #else
  89 void
  90 Grob::internal_set_property (SCM sym, SCM v)
  91 {
  92   internal_set_value_on_alist (&mutable_property_alist_,
  93                                sym, v);
  94
  95 }
  96 #endif
  97
  98 void
  99 Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v)
 100 {
 101   /* Perhaps we simply do the assq_set, but what the heck. */
 102   if (!is_live ())
 103     return;
 104
 105   if (do_internal_type_checking_global)
 106     {
 107       if (!ly_is_procedure (v)
 108           && !is_simple_closure (v)
 109           && v != ly_symbol2scm ("calculation-in-progress"))
 110         type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
 111
 112       check_interfaces_for_property (this, sym);
 113     }
 114
 115   *alist = scm_assq_set_x (*alist, sym, v);
 116 }
 117
 118 SCM
 119 Grob::internal_get_property_data (SCM sym) const
 120 {
 121 #ifndef NDEBUG
 122   if (profile_property_accesses)
 123     note_property_access (&grob_property_lookup_table, sym);
 124 #endif
 125
 126   SCM handle = scm_sloppy_assq (sym, mutable_property_alist_);
 127   if (handle != SCM_BOOL_F)
 128     return scm_cdr (handle);
 129
 130   handle = scm_sloppy_assq (sym, immutable_property_alist_);
 131
 132   if (do_internal_type_checking_global && scm_is_pair (handle))
 133     {
 134       SCM val = scm_cdr (handle);
 135       if (!ly_is_procedure (val) && !is_simple_closure (val))
 136         type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
 137
 138       check_interfaces_for_property (this, sym);
 139     }
 140
 141   return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
 142 }
 143
 144 SCM
 145 Grob::internal_get_property (SCM sym) const
 146 {
 147   SCM val = get_property_data (sym);
 148
 149 #ifndef NDEBUG
 150   if (val == ly_symbol2scm ("calculation-in-progress"))
 151     programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
 152                            ly_symbol2string (sym).c_str (),
 153                            name ().c_str ()));
 154 #endif
 155
 156   if (ly_is_procedure (val)
 157       || is_simple_closure (val))
 158     {
 159       Grob *me = ((Grob*)this);
 160       val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
 161     }
 162
 163   return val;
 164 }
 165
 166 #ifndef NDEBUG
 167 #include "protected-scm.hh"
 168
 169 Protected_scm grob_property_callback_stack = SCM_EOL;
 170 bool debug_property_callbacks = 0;
 171 #endif
 172
 173 SCM
 174 Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
 175 {
 176   SCM marker = ly_symbol2scm ("calculation-in-progress");
 177   /*
 178     need to put a value in SYM to ensure that we don't get a
 179     cyclic call chain.
 180   */
 181   *alist = scm_assq_set_x (*alist, sym, marker);
 182
 183 #ifndef NDEBUG
 184   if (debug_property_callbacks)
 185     grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
 186 #endif
 187
 188   SCM value = SCM_EOL;
 189   if (ly_is_procedure (proc))
 190     value = scm_call_1 (proc, self_scm ());
 191   else if (is_simple_closure (proc))
 192     {
 193       value = evaluate_with_simple_closure (self_scm (),
 194                                             simple_closure_expression (proc),
 195                                             false, 0, 0);
 196     }
 197
 198 #ifndef NDEBUG
 199   if (debug_property_callbacks)
 200     grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
 201 #endif
 202
 203   /*
 204     If the function returns SCM_UNSPECIFIED, we assume the
 205     property has been set with an explicit set_property ()
 206     call.
 207   */
 208   if (value == SCM_UNSPECIFIED)
 209     {
 210       value = get_property_data (sym);
 211       assert (value == SCM_EOL || value == marker);
 212       if (value == marker)
 213         *alist = scm_assq_remove_x (*alist, marker);
 214     }
 215   else
 216     internal_set_value_on_alist (alist, sym, value);
 217
 218   return value;
 219 }
 220
 221 void
 222 Grob::internal_set_object (SCM s, SCM v)
 223 {
 224   /* Perhaps we simply do the assq_set, but what the heck. */
 225   if (!is_live ())
 226     return;
 227
 228   object_alist_ = scm_assq_set_x (object_alist_, s, v);
 229 }
 230
 231 void
 232 Grob::internal_del_property (SCM sym)
 233 {
 234   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
 235 }
 236
 237 SCM
 238 Grob::internal_get_object (SCM sym) const
 239 {
 240   if (profile_property_accesses)
 241     note_property_access (&grob_property_lookup_table, sym);
 242
 243   SCM s = scm_sloppy_assq (sym, object_alist_);
 244
 245   if (s != SCM_BOOL_F)
 246     {
 247       SCM val = scm_cdr (s);
 248       if (ly_is_procedure (val)
 249           || is_simple_closure (val))
 250         {
 251           Grob *me = ((Grob*)this);
 252           val = me->try_callback_on_alist (&me->object_alist_, sym, val);
 253         }
 254
 255       return val;
 256     }
 257
 258   return SCM_EOL;
 259 }
 260
 261 bool
 262 Grob::is_live () const
 263 {
 264   return scm_is_pair (immutable_property_alist_);
 265 }
 266
 267 bool
 268 Grob::internal_has_interface (SCM k)
 269 {
 270   return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
 271 }
 272
 273 SCM
 274 call_pure_function (SCM unpure, SCM args, int start, int end)
 275 {
 276   SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function");
 277
 278   return scm_apply_0 (scm_call_pure_function,
 279                       scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end)));
 280 }
 281