2 lily-parser-scheme.cc -- implement Lily_parser bindings
4 source file of the GNU LilyPond music typesetter
6 (c) 2005--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
11 #include "lily-parser.hh"
13 #include "file-name-map.hh"
14 #include "file-name.hh"
15 #include "file-path.hh"
16 #include "international.hh"
17 #include "lily-lexer.hh"
18 #include "ly-module.hh"
20 #include "program-option.hh"
24 LY_DEFINE (ly_parse_file
, "ly:parse-file",
26 "Parse a single @code{.ly} file."
27 " Upon failure, throw @code{ly-file-failed} key.")
29 LY_ASSERT_TYPE (scm_is_string
, name
, 1);
30 string file
= ly_scm2string (name
);
31 char const *extensions
[] = {"ly", "", 0};
33 string file_name
= global_path
.find (file
, extensions
);
35 /* By default, use base name of input file for output file name,
36 write output to cwd; do not use root and directory parts of input
38 File_name
out_file_name (file_name
);
40 out_file_name
.ext_
= "";
41 out_file_name
.root_
= "";
42 if (ly_get_option (ly_symbol2scm ("gui")) != SCM_BOOL_T
43 && ly_get_option (ly_symbol2scm ("strip-output-dir")) == SCM_BOOL_T
) {
44 out_file_name
.dir_
= "";
47 /* When running from gui, generate output in .ly source directory. */
48 string output_name
= output_name_global
;
49 if (!output_name
.empty ())
51 /* Interpret --output=DIR to mean --output=DIR/BASE. */
53 if (is_dir (output_name
))
60 File_name
out (output_name
);
61 if (is_dir (out
.dir_part ()))
63 dir
= out
.dir_part ();
64 out_file_name
= out
.file_part ();
68 if (dir
!= "" && dir
!= "." && dir
!= get_working_directory ())
70 global_path
.prepend (get_working_directory ());
71 message (_f ("Changing working directory to: `%s'",
76 out_file_name
= File_name (output_name
);
80 if (!init_name_global
.empty ())
81 init
= init_name_global
;
85 string out_file
= out_file_name
.to_string ();
86 if (init
.length () && global_path
.find (init
).empty ())
88 warning (_f ("cannot find init file: `%s'", init
));
89 warning (_f ("(search path: `%s')",
90 global_path
.to_string ().c_str ()));
96 if ((file_name
!= "-") && file_name
.empty ())
98 warning (_f ("cannot find file: `%s'", file
));
104 sources
.set_path (&global_path
);
106 string mapped_fn
= map_file_name (file_name
);
107 message (_f ("Processing `%s'", mapped_fn
.c_str ()));
108 progress_indication ("\n");
110 Lily_parser
*parser
= new Lily_parser (&sources
);
112 parser
->parse_file (init
, file_name
, out_file
);
114 error
= parser
->error_level_
;
117 parser
->unprotect ();
121 outside the if-else to ensure cleanup fo Sources object,
124 /* TODO: pass renamed input file too. */
125 scm_throw (ly_symbol2scm ("ly-file-failed"),
126 scm_list_1 (ly_string2scm (file_name
)));
128 return SCM_UNSPECIFIED
;
132 LY_DEFINE (ly_parser_lexer
, "ly:parser-lexer",
133 1, 0, 0, (SCM parser_smob
),
134 "Return the lexer for @var{parser-smob}.")
136 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
137 return parser
->lexer_
->self_scm ();
140 LY_DEFINE (ly_parser_clone
, "ly:parser-clone",
141 1, 0, 0, (SCM parser_smob
),
142 "Return a clone of @var{parser-smob}.")
144 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
145 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
146 Lily_parser
*clone
= new Lily_parser (*parser
);
148 return clone
->unprotect ();
151 LY_DEFINE (ly_parser_define_x
, "ly:parser-define!",
152 3, 0, 0, (SCM parser_smob
, SCM symbol
, SCM val
),
153 "Bind @var{symbol} to @var{val} in @var{parser-smob}'s module.")
156 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
157 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
159 LY_ASSERT_TYPE (ly_is_symbol
, symbol
, 2);
161 parser
->lexer_
->set_identifier (scm_symbol_to_string (symbol
), val
);
162 return SCM_UNSPECIFIED
;
165 LY_DEFINE (ly_parser_lookup
, "ly:parser-lookup",
166 2, 0, 0, (SCM parser_smob
, SCM symbol
),
167 "Look up @var{symbol} in @var{parser-smob}'s module."
168 " Return @code{'()} if not defined.")
170 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
172 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
174 LY_ASSERT_TYPE (ly_is_symbol
, symbol
, 2);
176 SCM val
= parser
->lexer_
->lookup_identifier (ly_scm2string (scm_symbol_to_string (symbol
)));
177 if (val
!= SCM_UNDEFINED
)
183 LY_DEFINE (ly_parser_parse_string
, "ly:parser-parse-string",
184 2, 0, 0, (SCM parser_smob
, SCM ly_code
),
185 "Parse the string @var{ly-code} with @var{parser-smob}."
186 " Upon failure, throw @code{ly-file-failed} key.")
188 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
189 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
190 LY_ASSERT_TYPE (scm_is_string
, ly_code
, 2);
192 parser
->parse_string (ly_scm2string (ly_code
));
194 return SCM_UNSPECIFIED
;
197 LY_DEFINE (ly_parser_set_note_names
, "ly:parser-set-note-names",
198 2, 0, 0, (SCM parser
, SCM names
),
199 "Replace current note names in @var{parser}."
200 " @var{names} is an alist of symbols. This only has effect"
201 " if the current mode is notes.")
203 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
204 Lily_parser
*p
= unsmob_lily_parser (parser
);
206 if (p
->lexer_
->is_note_state ())
208 p
->lexer_
->pop_state ();
209 p
->lexer_
->push_note_state (alist_to_hashq (names
));
212 return SCM_UNSPECIFIED
;
215 LY_DEFINE (ly_parser_set_repetition_symbol
, "ly:parser-set-repetition-symbol",
216 2, 0, 0, (SCM parser
, SCM sym
),
217 "Replace the current repetition symbol in @var{parser}."
218 " @var{sym} is the new repetition symbol.")
220 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
221 Lily_parser
*p
= unsmob_lily_parser (parser
);
223 p
->lexer_
->chord_repetition_
.repetition_symbol_
= sym
;
225 return SCM_UNSPECIFIED
;
228 LY_DEFINE (ly_parser_set_repetition_function
, "ly:parser-set-repetition-function",
229 2, 0, 0, (SCM parser
, SCM fun
),
230 "Replace the current repetition function in @var{parser}."
231 " @var{fun} is the new repetition function.")
233 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
234 Lily_parser
*p
= unsmob_lily_parser (parser
);
236 p
->lexer_
->chord_repetition_
.repetition_function_
= fun
;
238 return SCM_UNSPECIFIED
;
241 LY_DEFINE (ly_parser_output_name
, "ly:parser-output-name",
242 1, 0, 0, (SCM parser
),
243 "Return the base name of the output file.")
245 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
246 Lily_parser
*p
= unsmob_lily_parser (parser
);
248 return ly_string2scm (p
->output_basename_
);
251 LY_DEFINE (ly_parser_error
, "ly:parser-error",
252 2, 1, 0, (SCM parser
, SCM msg
, SCM input
),
253 "Display an error message and make the parser fail.")
255 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
256 Lily_parser
*p
= unsmob_lily_parser (parser
);
258 LY_ASSERT_TYPE (scm_is_string
, msg
, 2);
259 string s
= ly_scm2string (msg
);
261 Input
*i
= unsmob_input (input
);
263 p
->parser_error (*i
, s
);
270 LY_DEFINE (ly_parser_clear_error
, "ly:parser-clear-error",
271 1, 0, 0, (SCM parser
),
272 "Clear the error flag for the parser.")
274 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
275 Lily_parser
*p
= unsmob_lily_parser (parser
);
279 p
->lexer_
->error_level_
= 0;
281 return SCM_UNSPECIFIED
;
284 LY_DEFINE (ly_parser_has_error_p
, "ly:parser-has-error?",
285 1, 0, 0, (SCM parser
),
286 "Does @var{parser} have an error flag?")
288 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
289 Lily_parser
*p
= unsmob_lily_parser (parser
);
291 return scm_from_bool (p
->error_level_
|| p
->lexer_
->error_level_
);