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   if (!ly_is_procedure (cb))
  36     warning (_ ("not setting modification callback: not a procedure"));
  37   else
  38     modification_callback = cb;
  39   return SCM_EOL;
  40 }
  41 #endif
  42
  43 SCM
  44 Grob::get_property_alist_chain (SCM def) const
  45 {
  46   return scm_list_n (mutable_property_alist_,
  47                      immutable_property_alist_,
  48                      def,
  49                      SCM_UNDEFINED);
  50 }
  51
  52
  53 extern void check_interfaces_for_property (Grob const *me, SCM sym);
  54
  55 void
  56 #ifndef NDEBUG
  57 Grob::internal_set_property (SCM sym, SCM v, char const *file, int line, char const *fun)
  58 {
  59   SCM grob_p = ly_lily_module_constant ("ly:grob?");
  60   SCM grob_list_p = ly_lily_module_constant ("grob-list?");
  61   SCM type = scm_object_property (sym, ly_symbol2scm ("backend-type?"));
  62
  63   if (type == grob_p
  64       || type == grob_list_p
  65       || (unsmob_grob (v) && ly_symbol2scm ("cause") != sym))
  66     {
  67       scm_display (scm_list_2 (sym, type), scm_current_output_port ());
  68       assert (0);
  69     }
  70 #else
  71 Grob::internal_set_property (SCM sym, SCM v)
  72 {
  73 #endif
  74
  75   /* Perhaps we simply do the assq_set, but what the heck. */
  76   if (!is_live ())
  77     return;
  78
  79   if (do_internal_type_checking_global)
  80     {
  81       if (!ly_is_procedure (v)
  82           && !is_simple_closure (v)
  83           && v != ly_symbol2scm ("calculation-in-progress")
  84           && !type_check_assignment (sym, v, ly_symbol2scm ("backend-type?")))
  85         abort ();
  86       check_interfaces_for_property (this, sym);
  87     }
  88
  89 #ifndef NDEBUG
  90   if (ly_is_procedure (modification_callback))
  91       scm_apply_0 (modification_callback,
  92                    scm_list_n (self_scm (),
  93                                scm_makfrom0str (file),
  94                                scm_from_int (line),
  95                                scm_makfrom0str (fun),
  96                                sym, v, SCM_UNDEFINED));
  97 #endif
  98
  99   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, sym, v);
 100 }
 101
 102 //#define PROFILE_PROPERTY_ACCESSES
 103 SCM
 104 Grob::get_property_data (SCM sym) const
 105 {
 106 #ifndef NDEBUG
 107   if (profile_property_accesses)
 108     note_property_access (&grob_property_lookup_table, sym);
 109 #endif
 110
 111   SCM handle = scm_sloppy_assq (sym, mutable_property_alist_);
 112   if (handle != SCM_BOOL_F)
 113     return scm_cdr (handle);
 114
 115   handle = scm_sloppy_assq (sym, immutable_property_alist_);
 116
 117   if (do_internal_type_checking_global && scm_is_pair (handle))
 118     {
 119       SCM val = scm_cdr (handle);
 120       if (!ly_is_procedure (val)
 121           && !is_simple_closure (val)
 122           && !type_check_assignment (sym, val,
 123                                   ly_symbol2scm ("backend-type?")))
 124         abort ();
 125
 126       check_interfaces_for_property (this, sym);
 127     }
 128
 129   return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle);
 130 }
 131
 132 SCM
 133 Grob::internal_get_property (SCM sym) const
 134 {
 135   SCM val = get_property_data (sym);
 136   if (ly_is_procedure (val)
 137       || is_simple_closure (val))
 138     {
 139       val = ((Grob*)this)->try_callback (sym, val);
 140     }
 141
 142   return val;
 143 }
 144
 145 #ifndef NDEBUG
 146 #include "protected-scm.hh"
 147
 148 Protected_scm grob_property_callback_stack = SCM_EOL;
 149 bool debug_property_callbacks = 0;
 150 #endif
 151
 152 SCM
 153 Grob::try_callback (SCM sym, SCM proc)
 154 {
 155   SCM marker = ly_symbol2scm ("calculation-in-progress");
 156   /*
 157     need to put a value in SYM to ensure that we don't get a
 158     cyclic call chain.
 159   */
 160   mutable_property_alist_
 161     = scm_assq_set_x (mutable_property_alist_, sym, marker);
 162
 163 #ifndef NDEBUG
 164   if (debug_property_callbacks)
 165     grob_property_callback_stack = scm_acons (sym, proc, grob_property_callback_stack);
 166 #endif
 167
 168   SCM value = SCM_EOL;
 169   if (ly_is_procedure (proc))
 170     value = scm_call_1 (proc, self_scm ());
 171   else if (is_simple_closure (proc))
 172     {
 173       value = evaluate_with_simple_closure (self_scm (),
 174                                             simple_closure_expression (proc));
 175     }
 176 #ifndef NDEBUG
 177   if (debug_property_callbacks)
 178     grob_property_callback_stack = scm_cdr (grob_property_callback_stack);
 179 #endif
 180
 181   /*
 182     If the function returns SCM_UNSPECIFIED, we assume the
 183     property has been set with an explicit set_property()
 184     call.
 185   */
 186   if (value == SCM_UNSPECIFIED)
 187     {
 188       value = internal_get_property (sym);
 189       if (value == marker)
 190         mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, marker);
 191     }
 192   else
 193     set_property (sym, value);
 194
 195   return value;
 196 }
 197
 198 void
 199 Grob::internal_set_object (SCM s, SCM v)
 200 {
 201   /* Perhaps we simply do the assq_set, but what the heck. */
 202   if (!is_live ())
 203     return;
 204
 205   object_alist_ = scm_assq_set_x (object_alist_, s, v);
 206 }
 207
 208 void
 209 Grob::internal_del_property (SCM sym)
 210 {
 211   mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, sym);
 212 }
 213
 214 SCM
 215 Grob::internal_get_object (SCM sym) const
 216 {
 217 #ifdef PROFILE_PROPERTY_ACCESSES
 218   note_property_access (&grob_property_lookup_table, sym);
 219 #endif
 220
 221   SCM s = scm_sloppy_assq (sym, object_alist_);
 222
 223   return (s == SCM_BOOL_F) ? SCM_EOL : scm_cdr (s);
 224 }
 225
 226 bool
 227 Grob::is_live () const
 228 {
 229   return scm_is_pair (immutable_property_alist_);
 230 }
 231
 232
 233 bool
 234 Grob::internal_has_interface (SCM k)
 235 {
 236   return scm_c_memq (k, interfaces_) != SCM_BOOL_F;
 237 }