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