]> git.donarmstrong.com Git - lilypond.git/blob - lily/program-option-scheme.cc
Merge branch 'master' into lilypond/translation
[lilypond.git] / lily / program-option-scheme.cc
1 /*
2   program-option-scheme.cc -- implement option setting from Scheme
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 2001--2007  Han-Wen Nienhuys <hanwen@xs4all.nl>
7 */
8
9 #include "program-option.hh"
10
11 #include <cstdio>
12 #include <cstring>
13 using namespace std;
14
15 #include "profile.hh"
16 #include "international.hh"
17 #include "main.hh"
18 #include "parse-scm.hh"
19 #include "string-convert.hh"
20 #include "warn.hh"
21
22 bool debug_skylines;
23 bool debug_property_callbacks;
24 bool debug_page_breaking_scoring;
25
26 /*
27   Backwards compatibility.
28 */
29 bool lily_1_8_relative = false;
30 bool lily_1_8_compatibility_used = false;
31 bool profile_property_accesses = false;
32 /*
33   crash if internally the wrong type is used for a grob property.
34 */
35 bool do_internal_type_checking_global;
36 bool strict_infinity_checking = false; 
37
38 static SCM option_hash;
39
40 void internal_set_option (SCM var, SCM val)
41 {
42   if (0)
43     ;
44   else if (var == ly_symbol2scm ("profile-property-accesses"))
45     {
46       profile_property_accesses = to_boolean (val);
47       val = scm_from_bool (to_boolean (val));
48     }
49   else if (var == ly_symbol2scm ("point-and-click"))
50     {
51       point_and_click_global = to_boolean (val);
52       val = scm_from_bool (to_boolean (val));
53     }
54   else if (var == ly_symbol2scm ("protected-scheme-parsing"))
55     {
56       parse_protect_global = to_boolean (val);
57       val = scm_from_bool (to_boolean (val));
58     }
59   else if (var == ly_symbol2scm ("check-internal-types"))
60     {
61       do_internal_type_checking_global = to_boolean (val);
62       val = scm_from_bool (to_boolean (val));
63     }
64   else if (var == ly_symbol2scm ("debug-gc-assert-parsed-dead"))
65     {
66       parsed_objects_should_be_dead = to_boolean (val);
67       val = scm_from_bool (parsed_objects_should_be_dead);
68     }
69   else if (var == ly_symbol2scm ("safe"))
70     {
71       be_safe_global = to_boolean (val);
72       val = scm_from_bool (be_safe_global);
73     }
74   else if (var == ly_symbol2scm ("old-relative"))
75     {
76       lily_1_8_relative = to_boolean (val);
77       /*  Needs to be reset for each file that uses this option.  */
78       lily_1_8_compatibility_used = to_boolean (val);
79       val = scm_from_bool (to_boolean (val));
80     }
81   else if (var == ly_symbol2scm ("strict-infinity-checking"))
82     {
83       strict_infinity_checking = to_boolean (val);
84       val = scm_from_bool (to_boolean (val));
85     }
86   else if (var == ly_symbol2scm ("debug-skylines"))
87     {
88       debug_skylines = to_boolean (val);
89       val = scm_from_bool (to_boolean (val));
90     }
91   else if (var == ly_symbol2scm ("debug-property-callbacks"))
92     {
93       debug_property_callbacks = to_boolean (val);
94       val = scm_from_bool (to_boolean (val));
95     }
96   else if (var == ly_symbol2scm ("debug-page-breaking-scoring"))
97     {
98       debug_page_breaking_scoring = to_boolean (val);
99       val = scm_from_bool (to_boolean (val));
100     }
101   else if (var == ly_symbol2scm ("datadir"))
102     {
103       /* ignore input value. */
104       val = ly_string2scm (lilypond_datadir);
105     }
106
107
108   scm_hashq_set_x (option_hash, var, val);
109
110
111 }
112
113
114
115 ssize const HELP_INDENT = 30;
116 ssize const INDENT = 2;
117 ssize const SEPARATION = 5;
118
119 /*
120   Hmmm. should do in SCM / C++  ?
121 */
122 static string
123 get_help_string ()
124 {
125   SCM alist = ly_hash2alist (option_hash);
126   SCM convertor = ly_lily_module_constant ("scm->string");
127
128   vector<string> opts;
129
130   for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
131     {
132       SCM sym = scm_caar (s);
133       SCM val = scm_cdar (s);
134       string opt_spec
135         = String_convert::char_string (' ', INDENT)
136         + ly_symbol2string (sym)
137         + " ("
138         + ly_scm2string (scm_call_1 (convertor, val))
139         + ")";
140
141       if (opt_spec.length () + SEPARATION > HELP_INDENT)
142         {
143           opt_spec += "\n"
144             + String_convert::char_string (' ', HELP_INDENT);
145         }
146       else
147         opt_spec += String_convert::char_string (' ', HELP_INDENT - opt_spec.length ());
148
149       SCM opt_help_scm
150         = scm_object_property (sym, ly_symbol2scm ("program-option-documentation"));
151       string opt_help = ly_scm2string (opt_help_scm);
152       replace_all (&opt_help,
153                    string ("\n"),
154                    string ("\n")
155                    + String_convert::char_string (' ', HELP_INDENT));
156
157       opts.push_back (opt_spec + opt_help + "\n");
158     }
159
160   string help ("Options supported by ly:set-option\n\n");
161   vector_sort (opts, less<string> ());
162   for (vsize i = 0; i < opts.size (); i++)
163     help += opts[i];
164
165   help += string ("\n");
166   return help;
167 }
168
169
170 LY_DEFINE (ly_option_usage, "ly:option-usage", 0, 0, 0, (),
171            "Print @code{ly:set-option} usage.")
172 {
173   string help = get_help_string ();
174   progress_indication (help);
175
176   return SCM_UNSPECIFIED;
177 }
178
179 LY_DEFINE (ly_add_option, "ly:add-option", 3, 0, 0,
180            (SCM sym, SCM val, SCM description),
181            "Add a program option @var{sym} with default @var{val}.")
182 {
183   if (!option_hash)
184     {
185       option_hash = scm_permanent_object (scm_c_make_hash_table (11));
186     }
187   LY_ASSERT_TYPE (ly_is_symbol, sym, 1);
188   LY_ASSERT_TYPE (scm_is_string, description, 3);
189
190   internal_set_option (sym, val);
191
192   scm_set_object_property_x (sym, ly_symbol2scm ("program-option-documentation"),
193                              description);
194
195   return SCM_UNSPECIFIED;
196 }
197
198 LY_DEFINE (ly_set_option, "ly:set-option", 1, 1, 0, (SCM var, SCM val),
199            "Set a program option.")
200 {
201   LY_ASSERT_TYPE (ly_is_symbol, var, 1);
202
203   if (val == SCM_UNDEFINED)
204     val = SCM_BOOL_T;
205
206   string varstr = ly_scm2string (scm_symbol_to_string (var));
207   if (varstr.substr (0, 3) == string ("no-"))
208     {
209       var = ly_symbol2scm (varstr.substr (3, varstr.length () -3).c_str ());
210       val = scm_from_bool (!to_boolean (val));
211     }
212
213   SCM handle = scm_hashq_get_handle (option_hash, var);
214   if (handle == SCM_BOOL_F)
215     warning (_f ("no such internal option: %s", varstr.c_str ()));
216
217   internal_set_option (var, val);
218   return SCM_UNSPECIFIED;
219 }
220
221 LY_DEFINE (ly_command_line_options, "ly:command-line-options", 0, 0, 0, (),
222            "The Scheme options specified on command-line with @option{-d}.")
223 {
224   return ly_string2scm (init_scheme_variables_global); 
225 }
226
227 LY_DEFINE (ly_command_line_code, "ly:command-line-code", 0, 0, 0, (),
228            "The Scheme code specified on command-line with @option{-e}.")
229 {
230   return ly_string2scm (init_scheme_code_global); 
231 }
232
233 LY_DEFINE (ly_command_line_verbose_p, "ly:command-line-verbose?", 0, 0, 0, (),
234            "Was @code{be_verbose_global} set?")
235 {
236   return scm_from_bool (be_verbose_global);
237 }
238
239
240
241 LY_DEFINE (ly_all_options, "ly:all-options",
242            0, 0, 0, (),
243            "Get all option settings in an alist.")
244 {
245   return ly_hash2alist (option_hash);
246 }
247
248
249 LY_DEFINE (ly_get_option, "ly:get-option", 1, 0, 0, (SCM var),
250            "Get a global option setting.")
251 {
252   LY_ASSERT_TYPE (ly_is_symbol, var, 1);
253   return scm_hashq_ref (option_hash, var, SCM_BOOL_F);
254 }
255
256