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
  90
  91 void
  92 Grob::internal_set_property (SCM sym, SCM v)
  93 {
  94   internal_set_value_on_alist (&mutable_property_alist_,
  95                                sym, v);
  96
  97 }
  98 #endif
  99
 100 void
 101 Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v)
 102 {
 103   /* Perhaps we simply do the assq_set, but what the heck. */
 104   if (!is_live ())
 105     return;
 106
 107   if (do_internal_type_checking_global)
 108     {
 109       if (!ly_is_procedure (v)
 110           && !is_simple_closure (v)
 111           && v != ly_symbol2scm ("calculation-in-progress"))
 112         type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
 113
 114       check_interfaces_for_property (this, sym);
 115     }
 116
 117   *alist = scm_assq_set_x (*alist, sym, v);
 118 }
 119
 120 SCM
 121 Grob::internal_get_property_data (SCM sym) const
 122 {
 123 #ifndef NDEBUG
 124   if (profile_property_accesses)
 125     note_property_access (&grob_property_lookup_table, sym);
 126 #endif
 127
 128   SCM handle = scm_sloppy_assq (sym, mutable_property_alist_);
 129   if (handle != SCM_BOOL_F)
 130     return scm_cdr (handle);
 131
 132   handle = scm_sloppy_assq (sym, immutable_property_alist_);
 133
 134   if (do_internal_type_checking_global && scm_is_pair (handle))
 135     {
 136       SCM val = scm_cdr (handle);
 137       if (!ly_is_procedure (val) && !is_simple_closure (val))
 138         type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
 139
 140       check_interfaces_for_property (this, sym);
 141     }
 142
 143   return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
 144 }
 145
 146 SCM
 147 Grob::internal_get_property (SCM sym) const
 148 {
 149   SCM val = get_property_data (sym);
 150
 151 #ifndef NDEBUG
 152   if (val == ly_symbol2scm ("calculation-in-progress"))
 153     programming_error (_f ("cyclic dependency: calculation-in-progress encountered for #'%s (%s)",
 154                            ly_symbol2string (sym).c_str (),
 155                            name().c_str ()));
 156 #endif
 157
 158   if (ly_is_procedure (val)
 159       || is_simple_closure (val))
 160     {
 161       Grob *me = ((Grob*)this);
 162       val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
 163     }
 164
 165   return val;
 166 }
 167
 168 #ifndef NDEBUG
 169 #include "protected-scm.hh"
 170
 171 Protected_scm grob_property_callback_stack = SCM_EOL;
 172 bool debug_property_callbacks = 0;
 173 #endif
 174
 175 SCM
 176 Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc)
 177 {
 178   SCM marker = ly_symbol2scm ("calculation-in-progress");
 179   /*
 180     need to put a value in SYM to ensure that we don't get a
 181     cyclic call chain.
 182   */
 183   *alist = scm_assq_set_x (*alist, sym, marker);
 184
 185 #ifndef NDEBUG
 186   if (debug_property_callbacks)
 187     grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
 188 #endif
 189
 190   SCM value = SCM_EOL;
 191   if (ly_is_procedure (proc))
 192     value = scm_call_1 (proc, self_scm ());
 193   else if (is_simple_closure (proc))
 194     {
 195       value = evaluate_with_simple_closure (self_scm (),
 196                                             simple_closure_expression (proc),
 197                                             false, 0, 0);
 198     }
 199
 200 #ifndef NDEBUG
 201   if (debug_property_callbacks)
 202     grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
 203 #endif
 204
 205   /*
 206     If the function returns SCM_UNSPECIFIED, we assume the
 207     property has been set with an explicit set_property()
 208     call.
 209   */
 210   if (value == SCM_UNSPECIFIED)
 211     {
 212       value = get_property_data (sym);
 213       assert (value == SCM_EOL || value == marker);
 214       if (value == marker)
 215         *alist = scm_assq_remove_x (*alist, marker);
 216     }
 217   else
 218     internal_set_value_on_alist (alist, sym, value);
 219
 220   return value;
 221 }
 222
 223 void
 224 Grob::internal_set_object (SCM s, SCM v)
 225 {
 226   /* Perhaps we simply do the assq_set, but what the heck. */
 227   if (!is_live ())
 228     return;
 229
 230   object_alist_ = scm_assq_set_x (object_alist_, s, v);
 231 }
 232
 233 void
 234 Grob::internal_del_property (SCM sym)
 235 {
 236   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
 237 }
 238
 239 SCM
 240 Grob::internal_get_object (SCM sym) const
 241 {
 242   if (profile_property_accesses)
 243     note_property_access (&grob_property_lookup_table, sym);
 244
 245   SCM s = scm_sloppy_assq (sym, object_alist_);
 246
 247   if (s != SCM_BOOL_F)
 248     {
 249       SCM val = scm_cdr (s);
 250       if (ly_is_procedure (val)
 251           || is_simple_closure (val))
 252         {
 253           Grob *me = ((Grob*)this);
 254           val = me->try_callback_on_alist (&me->object_alist_, sym, val);
 255         }
 256
 257       return val;
 258     }
 259
 260   return SCM_EOL;
 261 }
 262
 263 bool
 264 Grob::is_live () const
 265 {
 266   return scm_is_pair (immutable_property_alist_);
 267 }
 268
 269 bool
 270 Grob::internal_has_interface (SCM k)
 271 {
 272   return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
 273 }
 274
 275 SCM
 276 call_pure_function (SCM unpure, SCM args, int start, int end)
 277 {
 278   SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function");
 279
 280   return scm_apply_0 (scm_call_pure_function,
 281                       scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end)));
 282 }