Use scalar instead of embedded_scm for context mod overrides.
[lilypond/mpolesky.git] / lily / font-config-scheme.cc
blob65ad68fe43adeee11d88405a6420d59c3f682dd5
1 /*
2 font-config-scheme.cc -- implement FontConfig bindings.
4 source file of the GNU LilyPond music typesetter
6 (c) 2005--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
8 */
10 #include "lily-guile.hh"
11 #include "international.hh"
12 #include "main.hh"
13 #include "string-convert.hh"
14 #include "warn.hh"
16 #include <fontconfig/fontconfig.h>
18 string
19 display_fontset (FcFontSet *fs)
21 string retval;
23 int j;
24 for (j = 0; j < fs->nfont; j++)
26 FcChar8 *font;
27 FcChar8 *str;
29 font = FcNameUnparse (fs->fonts[j]);
30 if (FcPatternGetString (fs->fonts[j], FC_FILE, 0, &str) == FcResultMatch)
31 retval += String_convert::form_string ("FILE %s\n", str);
32 if (FcPatternGetString (fs->fonts[j], FC_INDEX, 0, &str) == FcResultMatch)
33 retval += String_convert::form_string ("INDEX %s\n", str);
34 if (FcPatternGetString (fs->fonts[j], FC_FAMILY, 0, &str) == FcResultMatch)
35 retval += String_convert::form_string ("family %s\n ", str);
36 if (FcPatternGetString (fs->fonts[j],
37 "designsize", 0, &str) == FcResultMatch)
38 retval += String_convert::form_string ("designsize %s\n ", str);
40 retval += String_convert::form_string ("%s\n", (const char *)font);
41 free (font);
44 return retval;
47 string
48 display_strlist (char const *what, FcStrList *slist)
50 string retval;
51 while (FcChar8 *dir = FcStrListNext (slist))
53 retval += String_convert::form_string ("%s: %s\n", what, dir);
55 return retval;
58 string
59 display_config (FcConfig *fcc)
61 string retval;
62 retval += display_strlist ("Config files", FcConfigGetConfigFiles (fcc));
63 retval += display_strlist ("Config dir", FcConfigGetConfigDirs (fcc));
64 retval += display_strlist ("Font dir", FcConfigGetFontDirs (fcc));
65 return retval;
68 string
69 display_list (FcConfig *fcc)
71 FcPattern *pat = FcPatternCreate ();
73 FcObjectSet *os = 0;
74 if (!os)
75 os = FcObjectSetBuild (FC_FAMILY, FC_STYLE, (char *)0);
77 FcFontSet *fs = FcFontList (fcc, pat, os);
78 FcObjectSetDestroy (os);
79 if (pat)
80 FcPatternDestroy (pat);
82 string retval;
83 if (fs)
85 retval = display_fontset (fs);
86 FcFontSetDestroy (fs);
88 return retval;
92 LY_DEFINE (ly_font_config_get_font_file, "ly:font-config-get-font-file", 1, 0, 0,
93 (SCM name),
94 "Get the file for font @var{name}.")
96 LY_ASSERT_TYPE (scm_is_string, name, 1);
98 FcPattern *pat = FcPatternCreate ();
99 FcValue val;
101 val.type = FcTypeString;
102 val.u.s = (const FcChar8 *)ly_scm2string (name).c_str (); // FC_SLANT_ITALIC;
103 FcPatternAdd (pat, FC_FAMILY, val, FcFalse);
105 FcResult result;
106 SCM scm_result = SCM_BOOL_F;
108 FcConfigSubstitute (NULL, pat, FcMatchFont);
109 FcDefaultSubstitute (pat);
111 pat = FcFontMatch (NULL, pat, &result);
112 FcChar8 *str = 0;
113 if (FcPatternGetString (pat, FC_FILE, 0, &str) == FcResultMatch)
114 scm_result = scm_from_locale_string ((char const *)str);
116 FcPatternDestroy (pat);
118 return scm_result;
121 LY_DEFINE (ly_font_config_display_fonts, "ly:font-config-display-fonts", 0, 0, 0,
123 "Dump a list of all fonts visible to FontConfig.")
125 string str = display_list (NULL);
126 str += display_config (NULL);
128 progress_indication (str);
130 return SCM_UNSPECIFIED;
133 LY_DEFINE (ly_font_config_add_directory, "ly:font-config-add-directory", 1, 0, 0,
134 (SCM dir),
135 "Add directory @var{dir} to FontConfig.")
137 LY_ASSERT_TYPE (scm_is_string, dir, 1);
139 string d = ly_scm2string (dir);
141 if (!FcConfigAppFontAddDir (0, (const FcChar8 *)d.c_str ()))
142 error (_f ("failed adding font directory: %s", d.c_str ()));
143 else if (be_verbose_global)
144 message (_f ("adding font directory: %s", d.c_str ()));
146 return SCM_UNSPECIFIED;
149 LY_DEFINE (ly_font_config_add_font, "ly:font-config-add-font", 1, 0, 0,
150 (SCM font),
151 "Add font @var{font} to FontConfig.")
153 LY_ASSERT_TYPE (scm_is_string, font, 1);
155 string f = ly_scm2string (font);
157 if (!FcConfigAppFontAddFile (0, (const FcChar8 *)f.c_str ()))
158 error (_f ("failed adding font file: %s", f.c_str ()));
159 else if (be_verbose_global)
160 message (_f ("adding font file: %s", f.c_str ()));
162 return SCM_UNSPECIFIED;