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_property ("interfaces");
  61
  62   bool found = false;
  63   for (; !found && gh_pair_p (ifs); ifs =gh_cdr (ifs))
  64     {
  65       SCM iface = scm_hashq_ref (all_ifaces , gh_car (ifs), SCM_BOOL_F);
  66       if (iface == SCM_BOOL_F)
  67         {
  68           String msg = to_string ("Unknown interface `%s'",
  69                                ly_symbol2string (gh_car (ifs)).to_str0 ());
  70           programming_error (msg);
  71           continue;
  72         }
  73
  74       found= found || (scm_c_memq (sym, gh_caddr (iface)) != SCM_BOOL_F);
  75     }
  76
  77   if (!found)
  78     {
  79      String str = to_string ("Grob %s has no interface for property %s",
  80                          me->name ().to_str0 (),
  81                          ly_symbol2string (sym).to_str0 ());
  82      programming_error (str);
  83     }
  84 }