]> git.donarmstrong.com Git - lilypond.git/blob - lily/program-option.cc
* lily/program-option.cc: add debug-gc option.
[lilypond.git] / lily / program-option.cc
1 /*
2   scm-option.cc -- implement option setting from Scheme
3
4   source file of the GNU LilyPond music typesetter
5
6   (c) 2001--2005  Han-Wen Nienhuys <hanwen@cs.uu.nl>
7 */
8
9 #include "program-option.hh"
10
11 #include <cstdio>
12 #include <string.h>
13
14 #include "string-convert.hh"
15 #include "protected-scm.hh"
16 #include "parse-scm.hh"
17 #include "warn.hh"
18 #include "main.hh"
19
20
21 /* Write midi as formatted ascii stream? */
22 bool do_midi_debugging_global;
23
24 /*
25   Backwards compatibility.
26 */
27 bool lily_1_8_relative = false;
28 bool lily_1_8_compatibility_used = false;
29
30 /*
31   crash if internally the wrong type is used for a grob property.
32 */
33 bool do_internal_type_checking_global;
34
35
36 static Lilypond_option_init options[] = {
37   {"point-and-click", "#t",
38    "use point & click"},
39   {"midi-debug", "#f",
40    "generate human readable MIDI",},
41   {"internal-type-checking", "#f",
42    "check every property assignment for types"},
43   {"parse-protect", "#t",
44    "continue when finding errors in inline\n" 
45    "scheme are caught in the parser. If off, halt \n"
46    "on errors, and print a stack trace."},
47   {"old-relative", "#f",
48    "relative for simultaneous music works\n"
49    "similar to chord syntax"},
50   {"resolution", "90",
51    "resolution for generating bitmaps"},
52   {"preview-include-book-title", "#t",
53    "include book-titles in preview images."},
54   {"gs-font-load", "#f",
55    "load fonts via Ghostscript."},
56   {"delete-intermediate-files", "#f",
57    "delete unusable PostScript files"},   
58   {"ttf-verbosity", "0",
59    "how much verbosity for TTF font embedding?"},
60   {"debug-gc", "#f",
61    "dump GC protection info"}, 
62   {0,0,0},
63 };
64
65 Protected_scm option_hash_;
66
67 void internal_set_option (SCM var, SCM val)
68 {
69   scm_hashq_set_x (option_hash_, var, val);
70   
71   if (var == ly_symbol2scm ("midi-debug"))
72     {
73       do_midi_debugging_global = to_boolean (val);
74       val = scm_from_bool (to_boolean (val));
75     }
76   else if (var == ly_symbol2scm ("point-and-click"))
77     {
78       point_and_click_global = to_boolean (val);
79       val = scm_from_bool (to_boolean (val));
80     }
81   else if (var == ly_symbol2scm ("parse-protect"))
82     {
83       parse_protect_global = to_boolean (val);
84       val = scm_from_bool (to_boolean (val));
85     }
86   else if (var == ly_symbol2scm ("internal-type-checking"))
87     {
88       do_internal_type_checking_global = to_boolean (val);
89       val = scm_from_bool (to_boolean (val));
90     }
91   else if (var == ly_symbol2scm ("old-relative"))
92     {
93       lily_1_8_relative = to_boolean (val);
94       /*  Needs to be reset for each file that uses this option.  */
95       lily_1_8_compatibility_used = to_boolean (val);
96       val = scm_from_bool (to_boolean (val));
97     }
98 }
99
100 const int HELP_INDENT = 30; 
101 const int INDENT = 2; 
102 const int SEPARATION = 5; 
103
104 static String
105 get_help_string ()
106 {
107   String help ("Options supported by ly:set-option\n\n");
108   for (Lilypond_option_init *p = options; p->name_; p ++)
109     {
110       String opt_spec =
111         String_convert::char_string (' ', INDENT)
112         + String (p->name_)
113         + " ("
114         + String (p->init_)
115         + ")";
116         
117
118       if (opt_spec.length () + SEPARATION > HELP_INDENT)
119         {
120           opt_spec += "\n"
121             + String_convert::char_string (' ', HELP_INDENT);
122         }
123       else
124         opt_spec += String_convert::char_string (' ', HELP_INDENT - opt_spec.length ());
125       
126       String opt_help = p->descr_;
127       opt_help.substitute (String ("\n"),
128                            String ("\n")
129                            + String_convert::char_string (' ', HELP_INDENT));
130       
131       help += opt_spec + opt_help + "\n";
132     }
133   
134   help += String ("\n");
135   return help;
136 }
137
138 static void
139 init_program_options ()
140 {
141   option_hash_ = scm_c_make_hash_table (11);
142
143   for (Lilypond_option_init *p = options; p->name_; p ++)
144     {
145       SCM sym = ly_symbol2scm (p->name_);
146       SCM val = scm_c_eval_string (p->init_);
147
148       internal_set_option (sym, val);
149     }
150
151   String help = get_help_string ();
152
153
154
155   internal_set_option (ly_symbol2scm ("help"),
156                        scm_makfrom0str (help.to_str0 ()));
157 }
158
159 ADD_SCM_INIT_FUNC(scm_option, init_program_options);
160
161
162 /*
163   This interface to option setting is meant for setting options are
164   useful to a limited audience. The reason for this interface is that
165   making command line options clutters up the command-line option name
166   space.
167
168 */
169
170 Protected_scm command_line_settings = SCM_EOL;
171
172 LY_DEFINE (ly_option_usage, "ly:option-usage", 0, 0, 0, (),
173            "Print ly:set-option usage")
174 {
175   SCM stdout = scm_current_output_port();
176   scm_display (ly_get_option (ly_symbol2scm ("help")), stdout);
177   exit (0);
178   return SCM_UNSPECIFIED;
179 }
180
181 LY_DEFINE (ly_set_option, "ly:set-option", 1, 1, 0, (SCM var, SCM val),
182            "Set a program option. Try setting 'help for a help string.")
183 {
184   SCM_ASSERT_TYPE (scm_is_symbol (var), var, SCM_ARG1,
185                    __FUNCTION__,  "symbol");
186
187   if (ly_symbol2scm ("help") == var)
188     {
189       ly_option_usage ();
190     }
191
192   if (val == SCM_UNDEFINED)
193     val = SCM_BOOL_T;
194
195   String  varstr = ly_scm2string (scm_symbol_to_string (var));
196   if (varstr.left_string (3) == String ("no-"))
197     {
198       var = ly_symbol2scm (varstr.nomid_string (0, 3).to_str0 ());
199       val = scm_from_bool (!to_boolean (val));
200     }
201   
202   SCM handle = scm_hashq_get_handle (option_hash_, var);
203   if (handle == SCM_BOOL_F)
204     {
205       warning (_f ("no such internal option: %s", varstr.to_str0 ()));
206     }
207
208   internal_set_option (var, val);
209   return SCM_UNSPECIFIED;
210 }
211
212 LY_DEFINE (ly_get_option, "ly:get-option", 1, 0, 0, (SCM var),
213            "Get a global option setting.")
214 {
215   SCM_ASSERT_TYPE (scm_is_symbol (var), var,
216                    SCM_ARG1, __FUNCTION__,  "symbol");
217   return scm_hashq_ref (option_hash_, var, SCM_BOOL_F);
218 }