]> git.donarmstrong.com Git - lilypond.git/blob - lily/grob-interface.cc
Merge commit '25c91d5'
[lilypond.git] / lily / grob-interface.cc
1 /*
2   grob-interface.cc -- implement graphic objects interface
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 2002--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
7 */
8
9 #include "grob-interface.hh"
10
11 #include "grob.hh"
12 #include "international.hh"
13 #include "protected-scm.hh"
14 #include "string-convert.hh"
15 #include "warn.hh"
16 #include "misc.hh"
17
18 SCM add_interface (char const *cxx_name,
19                     char const *descr,
20                     char const *vars)
21 {
22   string suffix ("-interface");
23   string lispy_name = camel_case_to_lisp_identifier (cxx_name);
24   vsize end = max (int (0), int (lispy_name.length () - suffix.length ()));
25   if (lispy_name.substr (end) != suffix)
26     lispy_name += suffix;
27
28   SCM s = ly_symbol2scm (lispy_name.c_str ());
29   SCM d = scm_from_locale_string (descr);
30   SCM l = parse_symbol_list (vars);
31
32   internal_add_interface (s, d, l);
33
34   return s;
35 }
36
37 void
38 check_interfaces_for_property (Grob const *me, SCM sym)
39 {
40   if (sym == ly_symbol2scm ("meta"))
41     {
42       /*
43         otherwise we get in a nasty recursion loop.
44       */
45       return;
46     }
47
48   SCM ifs = me->interfaces ();
49
50   SCM all_ifaces = ly_all_grob_interfaces ();
51   bool found = false;
52   for (; !found && scm_is_pair (ifs); ifs = scm_cdr (ifs))
53     {
54       SCM iface = scm_hashq_ref (all_ifaces, scm_car (ifs), SCM_BOOL_F);
55       if (iface == SCM_BOOL_F)
56         {
57           string msg = to_string (_f ("Unknown interface `%s'",
58                                       ly_symbol2string (scm_car (ifs)).c_str ()));
59           programming_error (msg);
60           continue;
61         }
62
63       found = found || (scm_c_memq (sym, scm_caddr (iface)) != SCM_BOOL_F);
64     }
65
66   if (!found)
67     {
68       string str = to_string (_f ("Grob `%s' has no interface for property `%s'",
69                                   me->name ().c_str (),
70                                   ly_symbol2string (sym).c_str ()));
71       programming_error (str);
72     }
73 }