lily/grob-interface.cc

   1 #include  "protected-scm.hh"
   2 #include "grob-interface.hh"
   3 #include "lily-guile.hh"
   4 #include "grob.hh"
   5 #include "warn.hh"
   6
   7 Protected_scm all_ifaces;
   8
   9 void add_interface (const char * symbol,
  10                     const char * descr,
  11                     const char * vars)
  12 {
  13   SCM s = ly_symbol2scm (symbol);
  14   SCM d = scm_makfrom0str (descr);
  15   SCM l = parse_symbol_list (vars);
  16
  17
  18   ly_add_interface(s,d,l);
  19 }
  20
  21
  22 LY_DEFINE(ly_add_interface, "ly:add-interface", 3,0,0, (SCM a, SCM b, SCM c),
  23           "Add an interface description.")
  24 {
  25   SCM_ASSERT_TYPE (gh_symbol_p (a), a, SCM_ARG1, __FUNCTION__, "symbol");
  26   SCM_ASSERT_TYPE (gh_string_p (b), b, SCM_ARG2, __FUNCTION__, "string");
  27   SCM_ASSERT_TYPE (gh_list_p(c), c,  SCM_ARG3, __FUNCTION__, "list of syms");
  28   if (!gh_vector_p (all_ifaces))
  29     {
  30       all_ifaces = scm_make_vector (gh_int2scm (40), SCM_EOL);
  31     }
  32
  33   SCM entry = scm_list_n (a, b, c, SCM_UNDEFINED);
  34
  35   scm_hashq_set_x (all_ifaces, a, entry);
  36
  37
  38   return SCM_UNSPECIFIED;
  39 }
  40
  41
  42 LY_DEFINE(ly_all_grob_interfaces, "ly:all-grob-interfaces",
  43           0,0,0, (),
  44           "Get a hash table with all interface descriptions.")
  45 {
  46   return all_ifaces;
  47 }
  48
  49 void
  50 check_interfaces_for_property (Grob const *me, SCM sym)
  51 {
  52   if (sym == ly_symbol2scm ("meta"))
  53     {
  54       /*
  55         otherwise we get in a nasty recursion loop.
  56        */
  57       return ;
  58
  59     }
  60   SCM ifs =  me->get_grob_property ("interfaces");
  61
  62
  63   bool found = false;
  64   for (; !found && gh_pair_p (ifs); ifs =gh_cdr (ifs))
  65     {
  66       SCM iface = scm_hashq_ref (all_ifaces , gh_car (ifs), SCM_BOOL_F);
  67       if (iface == SCM_BOOL_F)
  68         {
  69           String msg = to_string ("Unknown interface `%s'",
  70                                ly_symbol2string (gh_car(ifs)).to_str0 ());
  71           programming_error (msg);
  72           continue;
  73         }
  74
  75       found= found || (scm_memq (sym, gh_caddr (iface)) != SCM_BOOL_F);
  76     }
  77
  78   if (!found)
  79     {
  80      String str = to_string ("Grob %s has no interface for property %s",
  81                          me->name ().to_str0 (),
  82                          ly_symbol2string(sym).to_str0 ());
  83      programming_error (str);
  84     }
  85 }