2 lily-parser-scheme.cc -- implement Lily_parser bindings
4 source file of the GNU LilyPond music typesetter
6 (c) 2005--2007 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 /* Do not append `!' suffix, since 1st argument is not modified. */
25 LY_DEFINE (ly_set_point_and_click
, "ly:set-point-and-click",
30 warning (_f ("deprecated function called: %s", "ly:set-point-and-click"));
31 return SCM_UNSPECIFIED
;
34 LY_DEFINE (ly_parse_file
, "ly:parse-file",
36 "Parse a single @code{.ly} file."
37 " Upon failure, throw @code{ly-file-failed} key.")
39 LY_ASSERT_TYPE (scm_is_string
, name
, 1);
40 string file
= ly_scm2string (name
);
41 char const *extensions
[] = {"ly", "", 0};
43 string file_name
= global_path
.find (file
, extensions
);
45 /* By default, use base name of input file for output file name,
46 write output to cwd; do not use root and directory parts of input
48 File_name
out_file_name (file_name
);
50 global_path
.append (out_file_name
.dir_
);
52 out_file_name
.ext_
= "";
53 out_file_name
.root_
= "";
54 if (ly_get_option (ly_symbol2scm ("gui")) != SCM_BOOL_T
55 && ly_get_option (ly_symbol2scm ("strip-output-dir")) == SCM_BOOL_T
) {
56 out_file_name
.dir_
= "";
59 /* When running from gui, generate output in .ly source directory. */
60 string output_name
= output_name_global
;
61 if (!output_name
.empty ())
63 /* Interpret --output=DIR to mean --output=DIR/BASE. */
65 if (is_dir (output_name
))
72 File_name
out (output_name
);
73 if (is_dir (out
.dir_part ()))
75 dir
= out
.dir_part ();
76 out_file_name
= out
.file_part ();
80 if (dir
!= "" && dir
!= "." && dir
!= get_working_directory ())
82 global_path
.prepend (get_working_directory ());
83 message (_f ("Changing working directory to: `%s'",
88 out_file_name
= File_name (output_name
);
92 if (!init_name_global
.empty ())
93 init
= init_name_global
;
97 string out_file
= out_file_name
.to_string ();
98 if (init
.length () && global_path
.find (init
).empty ())
100 warning (_f ("cannot find init file: `%s'", init
));
101 warning (_f ("(search path: `%s')",
102 global_path
.to_string ().c_str ()));
108 if ((file_name
!= "-") && file_name
.empty ())
110 warning (_f ("cannot find file: `%s'", file
));
116 sources
.set_path (&global_path
);
118 string mapped_fn
= map_file_name (file_name
);
119 message (_f ("Processing `%s'", mapped_fn
.c_str ()));
120 progress_indication ("\n");
122 Lily_parser
*parser
= new Lily_parser (&sources
);
124 parser
->parse_file (init
, file_name
, out_file
);
126 error
= parser
->error_level_
;
129 parser
->unprotect ();
133 outside the if-else to ensure cleanup fo Sources object,
136 /* TODO: pass renamed input file too. */
137 scm_throw (ly_symbol2scm ("ly-file-failed"),
138 scm_list_1 (ly_string2scm (file_name
)));
140 return SCM_UNSPECIFIED
;
144 LY_DEFINE (ly_parser_lexer
, "ly:parser-lexer",
145 1, 0, 0, (SCM parser_smob
),
146 "Return the lexer for @var{parser-smob}.")
148 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
149 return parser
->lexer_
->self_scm ();
152 LY_DEFINE (ly_parser_clone
, "ly:parser-clone",
153 1, 0, 0, (SCM parser_smob
),
154 "Return a clone of @var{parser-smob}.")
156 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
157 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
158 Lily_parser
*clone
= new Lily_parser (*parser
);
160 return clone
->unprotect ();
163 LY_DEFINE (ly_parser_define_x
, "ly:parser-define!",
164 3, 0, 0, (SCM parser_smob
, SCM symbol
, SCM val
),
165 "Bind @var{symbol} to @var{val} in @var{parser-smob}'s module.")
168 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
169 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
171 LY_ASSERT_TYPE (ly_is_symbol
, symbol
, 2);
173 parser
->lexer_
->set_identifier (scm_symbol_to_string (symbol
), val
);
174 return SCM_UNSPECIFIED
;
177 LY_DEFINE (ly_parser_lookup
, "ly:parser-lookup",
178 2, 0, 0, (SCM parser_smob
, SCM symbol
),
179 "Look up @var{symbol} in @var{parser-smob}'s module."
180 " Return @code{'()} if not defined.")
182 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
184 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
186 LY_ASSERT_TYPE (ly_is_symbol
, symbol
, 2);
188 SCM val
= parser
->lexer_
->lookup_identifier (ly_scm2string (scm_symbol_to_string (symbol
)));
189 if (val
!= SCM_UNDEFINED
)
195 LY_DEFINE (ly_parser_parse_string
, "ly:parser-parse-string",
196 2, 0, 0, (SCM parser_smob
, SCM ly_code
),
197 "Parse the string @var{ly-code} with @var{parser-smob}."
198 " Upon failure, throw @code{ly-file-failed} key.")
200 LY_ASSERT_SMOB (Lily_parser
, parser_smob
, 1);
201 Lily_parser
*parser
= unsmob_lily_parser (parser_smob
);
202 LY_ASSERT_TYPE (scm_is_string
, ly_code
, 2);
204 parser
->parse_string (ly_scm2string (ly_code
));
206 return SCM_UNSPECIFIED
;
209 LY_DEFINE (ly_parser_set_note_names
, "ly:parser-set-note-names",
210 2, 0, 0, (SCM parser
, SCM names
),
211 "Replace current note names in @var{parser}."
212 " @var{names} is an alist of symbols. This only has effect"
213 " if the current mode is notes.")
215 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
216 Lily_parser
*p
= unsmob_lily_parser (parser
);
218 if (p
->lexer_
->is_note_state ())
220 p
->lexer_
->pop_state ();
221 p
->lexer_
->push_note_state (alist_to_hashq (names
));
224 return SCM_UNSPECIFIED
;
227 LY_DEFINE (ly_parser_output_name
, "ly:parser-output-name",
228 1, 0, 0, (SCM parser
),
229 "Return the base name of the output file.")
231 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
232 Lily_parser
*p
= unsmob_lily_parser (parser
);
234 return ly_string2scm (p
->output_basename_
);
237 LY_DEFINE (ly_parser_error
, "ly:parser-error",
238 2, 1, 0, (SCM parser
, SCM msg
, SCM input
),
239 "Display an error message and make the parser fail.")
241 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
242 Lily_parser
*p
= unsmob_lily_parser (parser
);
244 LY_ASSERT_TYPE (scm_is_string
, msg
, 2);
245 string s
= ly_scm2string (msg
);
247 Input
*i
= unsmob_input (input
);
249 p
->parser_error (*i
, s
);
256 LY_DEFINE (ly_parser_clear_error
, "ly:parser-clear-error",
257 1, 0, 0, (SCM parser
),
258 "Clear the error flag for the parser.")
260 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
261 Lily_parser
*p
= unsmob_lily_parser (parser
);
265 p
->lexer_
->error_level_
= 0;
267 return SCM_UNSPECIFIED
;
270 LY_DEFINE (ly_parser_has_error_p
, "ly:parser-has-error?",
271 1, 0, 0, (SCM parser
),
272 "Does @var{parser} have an error flag?")
274 LY_ASSERT_SMOB (Lily_parser
, parser
, 1);
275 Lily_parser
*p
= unsmob_lily_parser (parser
);
277 return scm_from_bool (p
->error_level_
|| p
->lexer_
->error_level_
);