X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Flily-parser-scheme.cc;h=37dbc7a8966f274f6ac6f9f4449ca337e9ab6127;hb=9e781b7dc83b60a543ce218aa1a5f139f74c760f;hp=32f4405bebaf6fa5bd6836b7c0ce676a0f33e8d7;hpb=5d1ddaf889233f8e5c32a118f9e843e1becca2d2;p=lilypond.git diff --git a/lily/lily-parser-scheme.cc b/lily/lily-parser-scheme.cc index 32f4405beb..0da04c9296 100644 --- a/lily/lily-parser-scheme.cc +++ b/lily/lily-parser-scheme.cc @@ -1,174 +1,195 @@ /* - lily-parser-scheme.cc -- implement Lily_parser bindings + This file is part of LilyPond, the GNU music typesetter. - source file of the GNU LilyPond music typesetter + Copyright (C) 2005--2014 Han-Wen Nienhuys - (c) 2005 Han-Wen Nienhuys + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . */ +#include + +#include "lily-parser.hh" + +#include "file-name-map.hh" #include "file-name.hh" #include "file-path.hh" +#include "international.hh" +#include "lily-lexer.hh" +#include "ly-module.hh" #include "main.hh" -#include "lily-parser.hh" +#include "program-option.hh" +#include "sources.hh" #include "warn.hh" -#include "source.hh" -#include "lily-lexer.hh" -#include "score.hh" -#include "lilypond-key.hh" -#include "ly-module.hh" -#include "output-def.hh" -#include "book.hh" -#include "paper-book.hh" - -/* - junkme? - */ -bool store_locations_global; - -/* Do not append `!' suffix, since 1st argument is not modified. */ -LY_DEFINE (ly_set_point_and_click, "ly:set-point-and-click", - 1, 0, 0, (SCM what), - "Set the options for Point-and-click source specials output. The\n" -"argument is a symbol. Possible options are @code{none} (no source specials), \n" -"@code{line} and @code{line-column}") -{ - /* UGH. */ - SCM val = SCM_BOOL_F; - if (ly_symbol2scm ("line-column") == what) - val = ly_lily_module_constant ("line-column-location"); - else if (what == ly_symbol2scm ("line")) - val = ly_lily_module_constant ("line-location"); - - scm_module_define (global_lily_module, ly_symbol2scm ("point-and-click"), - val); - store_locations_global = ly_c_procedure_p (val); - return SCM_UNSPECIFIED; -} LY_DEFINE (ly_parse_file, "ly:parse-file", - 1, 0, 0, (SCM name), - "Parse a single @code{.ly} file. " - "Upon failure, throw @code{ly-file-failed} key.") + 1, 0, 0, (SCM name), + "Parse a single @code{.ly} file." + " Upon failure, throw @code{ly-file-failed} key.") { - SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string"); - char const *file = scm_i_string_chars (name); + LY_ASSERT_TYPE (scm_is_string, name, 1); + string file = ly_scm2string (name); char const *extensions[] = {"ly", "", 0}; - String file_name = global_path.find (file, extensions); + string file_name = global_path.find (file, extensions); /* By default, use base name of input file for output file name, write output to cwd; do not use root and directory parts of input file name. */ File_name out_file_name (file_name); - global_path.append (out_file_name.dir_); - out_file_name.ext_ = ""; out_file_name.root_ = ""; - out_file_name.dir_ = ""; + if (ly_get_option (ly_symbol2scm ("gui")) != SCM_BOOL_T + && ly_get_option (ly_symbol2scm ("strip-output-dir")) == SCM_BOOL_T) + { + out_file_name.dir_ = ""; + } - if (!output_name_global.is_empty ()) - out_file_name = File_name (output_name_global); - - String init; - if (!init_name_global.is_empty ()) + /* When running from gui, generate output in .ly source directory. */ + string output_name = output_name_global; + if (!output_name.empty ()) + { + /* Interpret --output=DIR to mean --output=DIR/BASE. */ + string dir; + if (is_dir (output_name)) + { + dir = output_name; + output_name = ""; + } + else + { + File_name out (output_name); + dir = out.dir_part (); + out_file_name = out.file_part (); + } + + if (dir != "" && dir != "." && dir != get_working_directory ()) + { + global_path.prepend (get_working_directory ()); + message (_f ("Changing working directory to: `%s'", dir)); + // If we can't change to the output dir (not existing, wrong + // permissions), exit lilypond + if (chdir (dir.c_str ()) != 0) + error (_f ("unable to change directory to: `%s'", dir)); + } + else + out_file_name = File_name (output_name); + } + + string init; + if (!init_name_global.empty ()) init = init_name_global; else init = "init.ly"; - String out_file = out_file_name.to_string (); - - if (init.length () && global_path.find (init).is_empty ()) + string out_file = out_file_name.to_string (); + if (init.length () && global_path.find (init).empty ()) { - warning (_f ("can't find init file: `%s'", init)); + warning (_f ("cannot find init file: `%s'", init)); warning (_f ("(search path: `%s')", - global_path.to_string ().to_str0 ())); + global_path.to_string ().c_str ())); exit (2); } - if ((file_name != "-") && global_path.find (file_name).is_empty ()) + bool error = false; + if ((file_name != "-") && file_name.empty ()) { - warning (_f ("can't find file: `%s'", file_name)); - scm_throw (ly_symbol2scm ("ly-file-failed"), - scm_list_1 (scm_makfrom0str (file_name.to_str0 ()))); + warning (_f ("cannot find file: `%s'", file)); + error = true; } else { Sources sources; sources.set_path (&global_path); - - progress_indication (_f ("Processing `%s'", file_name.to_str0 ())); - progress_indication ("\n"); + + string mapped_fn = map_file_name (file_name); + basic_progress (_f ("Processing `%s'", mapped_fn.c_str ())); Lily_parser *parser = new Lily_parser (&sources); parser->parse_file (init, file_name, out_file); - bool error = parser->error_level_; - scm_gc_unprotect_object (parser->self_scm ()); - parser = 0; - if (error) - /* TODO: pass renamed input file too. */ - scm_throw (ly_symbol2scm ("ly-file-failed"), - scm_list_1 (scm_makfrom0str (file_name.to_str0 ()))); + error = parser->error_level_; + + parser->clear (); + parser->unprotect (); } + + /* + outside the if-else to ensure cleanup fo Sources object, + */ + if (error) + /* TODO: pass renamed input file too. */ + scm_throw (ly_symbol2scm ("ly-file-failed"), + scm_list_1 (ly_string2scm (file_name))); + return SCM_UNSPECIFIED; } -LY_DEFINE (ly_parse_string, "ly:parse-string", - 1, 0, 0, (SCM ly_code), - "Parse the string LY_CODE. " - "Upon failure, throw @code{ly-file-failed} key.") +LY_DEFINE (ly_parser_lexer, "ly:parser-lexer", + 1, 0, 0, (SCM parser_smob), + "Return the lexer for @var{parser-smob}.") { - SCM_ASSERT_TYPE (scm_is_string (ly_code), ly_code, SCM_ARG1, __FUNCTION__, "string"); - - Sources sources; - sources.set_path (&global_path); - Lily_parser *parser = new Lily_parser (&sources); - scm_module_define (global_lily_module, ly_symbol2scm ("parser"), - parser->self_scm ()); - parser->parse_string (ly_scm2string (ly_code)); - scm_gc_unprotect_object (parser->self_scm ()); - parser = 0; - - return SCM_UNSPECIFIED; + Lily_parser *parser = unsmob_lily_parser (parser_smob); + return parser->lexer_->self_scm (); } -LY_DEFINE (ly_clone_parser, "ly:clone-parser", - 1, 0, 0, (SCM parser_smob), - "Return a clone of PARSER_SMOB.") +LY_DEFINE (ly_parser_clone, "ly:parser-clone", + 1, 2, 0, (SCM parser_smob, SCM closures, SCM location), + "Return a clone of @var{parser-smob}. An association list" + " of port positions to closures can be specified in @var{closures}" + " in order to have @code{$} and @code{#} interpreted in their original" + " lexical environment. If @var{location} is a valid location," + " it becomes the source of all music expressions inside.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); - Lily_parser *clone = new Lily_parser (*parser); + LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); + Lily_parser *parser = unsmob_lily_parser (parser_smob); + if (SCM_UNBNDP (closures)) + closures = SCM_EOL; + else + LY_ASSERT_TYPE (ly_is_list, closures, 2); + Lily_parser *clone = new Lily_parser (*parser, closures, location); - /* FIXME: should copy scopes too. */ - return scm_gc_unprotect_object (clone->self_scm ()); + return clone->unprotect (); } -LY_DEFINE (ly_parser_define, "ly:parser-define", - 3, 0, 0, (SCM parser_smob, SCM symbol, SCM val), - "Bind SYMBOL to VAL in PARSER_SMOB's module.") +LY_DEFINE (ly_parser_define_x, "ly:parser-define!", + 3, 0, 0, (SCM parser_smob, SCM symbol, SCM val), + "Bind @var{symbol} to @var{val} in @var{parser-smob}'s module.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); - SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, SCM_ARG2, __FUNCTION__, "symbol"); - SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG2, __FUNCTION__, "parser"); + + LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); + Lily_parser *parser = unsmob_lily_parser (parser_smob); + + LY_ASSERT_TYPE (ly_is_symbol, symbol, 2); parser->lexer_->set_identifier (scm_symbol_to_string (symbol), val); return SCM_UNSPECIFIED; } LY_DEFINE (ly_parser_lookup, "ly:parser-lookup", - 2, 0, 0, (SCM parser_smob, SCM symbol), - "Lookup @var{symbol} in @var{parser_smob}'s module. " - "Undefined is '().") + 2, 0, 0, (SCM parser_smob, SCM symbol), + "Look up @var{symbol} in @var{parser-smob}'s module." + " Return @code{'()} if not defined.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); + LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); - SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, SCM_ARG2, __FUNCTION__, "symbol"); - SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG2, __FUNCTION__, "parser"); + Lily_parser *parser = unsmob_lily_parser (parser_smob); - SCM val = parser->lexer_->lookup_identifier (ly_scm2string (scm_symbol_to_string (symbol))); + LY_ASSERT_TYPE (ly_is_symbol, symbol, 2); + + SCM val = parser->lexer_->lookup_identifier (ly_symbol2string (symbol)); if (val != SCM_UNDEFINED) return val; else @@ -176,118 +197,136 @@ LY_DEFINE (ly_parser_lookup, "ly:parser-lookup", } LY_DEFINE (ly_parser_parse_string, "ly:parser-parse-string", - 2, 0, 0, (SCM parser_smob, SCM ly_code), - "Parse the string LY_CODE with PARSER_SMOB." - "Upon failure, throw @code{ly-file-failed} key.") + 2, 0, 0, (SCM parser_smob, SCM ly_code), + "Parse the string @var{ly-code} with @var{parser-smob}." + " Upon failure, throw @code{ly-file-failed} key.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); + LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); + Lily_parser *parser = unsmob_lily_parser (parser_smob); + LY_ASSERT_TYPE (scm_is_string, ly_code, 2); + + if (!parser->lexer_->is_clean ()) + parser->parser_error (_ ("ly:parser-parse-string is only valid with a new parser." + " Use ly:parser-include-string instead.")); + else + parser->parse_string (ly_scm2string (ly_code)); - SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser"); - SCM_ASSERT_TYPE (scm_is_string (ly_code), ly_code, SCM_ARG2, __FUNCTION__, "string"); - - parser->parse_string (ly_scm2string (ly_code)); - return SCM_UNSPECIFIED; } -/* TODO: move this to Scheme? Why take the parser arg, and all the back - & forth between scm and c++? */ -LY_DEFINE (ly_parser_print_score, "ly:parser-print-score", - 2, 0, 0, - (SCM parser_smob, SCM score_smob), - "Print score, i.e., the classic way.") +LY_DEFINE (ly_parse_string_expression, "ly:parse-string-expression", + 2, 2, 0, (SCM parser_smob, SCM ly_code, SCM filename, + SCM line), + "Parse the string @var{ly-code} with @var{parser-smob}." + " Return the contained music expression." + " @var{filename} and @var{line} are optional source indicators.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); - Score *score = unsmob_score (score_smob); - - Object_key * key = new Lilypond_general_key (0, score->user_key_, 0); - - if (score->error_found_) - return SCM_UNSPECIFIED; - - SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser"); - SCM_ASSERT_TYPE (score, score_smob, SCM_ARG2, __FUNCTION__, "score"); - - SCM header = ly_c_module_p (score->header_) ? score->header_ - : parser->lexer_->lookup_identifier ("$globalheader"); - - File_name outname (parser->output_basename_); - int *c = &parser->book_count_; - if (*c) - outname.base_ += "-" + to_string (*c); - (*c)++; - - SCM os = scm_makfrom0str (outname.to_string ().to_str0 ()); - SCM paper = get_paper (parser)->self_scm (); - for (int i = 0; i < score->defs_.size (); i++) - default_rendering (score->get_music (), score->defs_[i]->self_scm (), - paper, - header, os, - key->self_scm ()); - - if (score->defs_.is_empty ()) + LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); + Lily_parser *parser = unsmob_lily_parser (parser_smob); + LY_ASSERT_TYPE (scm_is_string, ly_code, 2); + string fn; + if (SCM_UNBNDP (filename) || !scm_is_string (filename)) + fn = ""; + else + fn = ly_scm2string (filename); + int ln; + if (SCM_UNBNDP (line) || !scm_is_integer (line)) + ln = 0; + else + ln = scm_to_int (line); + + if (!parser->lexer_->is_clean ()) { - Output_def *layout = get_layout (parser); - default_rendering (score->get_music(), layout->self_scm (), - get_paper (parser)->self_scm (), - header, os, key->self_scm ()); - scm_gc_unprotect_object (layout->self_scm ()); + parser->parser_error (_ ("ly:parse-string-expression is only valid with a new parser." + " Use ly:parser-include-string instead.")); + return SCM_UNSPECIFIED; } - scm_gc_unprotect_object (key->self_scm ()); - return SCM_UNSPECIFIED; + return parser->parse_string_expression (ly_scm2string (ly_code), + fn, ln); } +LY_DEFINE (ly_parser_include_string, "ly:parser-include-string", + 2, 0, 0, (SCM parser_smob, SCM ly_code), + "Include the string @var{ly-code} into the input stream" + " for @var{parser-smob}. Can only be used in immediate" + " Scheme expressions (@code{$} instead of @code{#}).") +{ + LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); + Lily_parser *parser = unsmob_lily_parser (parser_smob); + LY_ASSERT_TYPE (scm_is_string, ly_code, 2); + + parser->include_string (ly_scm2string (ly_code)); + return SCM_UNSPECIFIED; +} LY_DEFINE (ly_parser_set_note_names, "ly:parser-set-note-names", - 2, 0, 0, (SCM parser, SCM names), - "Replace current note names in @var{parser}. " - "@var{names} is an alist of symbols. " - "This only has effect if the current mode is notes.") + 2, 0, 0, (SCM parser, SCM names), + "Replace current note names in @var{parser}." + " @var{names} is an alist of symbols. This only has effect" + " if the current mode is notes.") { - Lily_parser *p = unsmob_my_lily_parser (parser); - SCM_ASSERT_TYPE(p, parser, SCM_ARG1, __FUNCTION__, "Lilypond parser"); + LY_ASSERT_SMOB (Lily_parser, parser, 1); + Lily_parser *p = unsmob_lily_parser (parser); if (p->lexer_->is_note_state ()) { p->lexer_->pop_state (); - p->lexer_->push_note_state (alist_to_hashq (names)); + p->lexer_->push_note_state (names); } return SCM_UNSPECIFIED; } -LY_DEFINE (ly_parser_print_book, "ly:parser-print-book", - 2, 0, 0, (SCM parser_smob, SCM book_smob), - "Print book.") +LY_DEFINE (ly_parser_output_name, "ly:parser-output-name", + 1, 0, 0, (SCM parser), + "Return the base name of the output file.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); - Book *book = unsmob_book (book_smob); - Output_def *bp = unsmob_output_def (parser->lexer_->lookup_identifier ("$defaultpaper")); - - SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "Lilypond parser"); - SCM_ASSERT_TYPE (book, book_smob, SCM_ARG2, __FUNCTION__, "Book"); - - /* ugh. changing argument.*/ - book->paper_ = bp; - - File_name outname (parser->output_basename_); - int *c = &parser->book_count_; - if (*c) - outname.base_ += "-" + to_string (*c); - (*c)++; - - Output_def *layout = get_layout (parser); - Paper_book* pb = book->process (outname.to_string (), layout); - - if (pb) - { - pb->output (outname.to_string ()); - scm_gc_unprotect_object (pb->self_scm ()); - } + LY_ASSERT_SMOB (Lily_parser, parser, 1); + Lily_parser *p = unsmob_lily_parser (parser); + + return ly_string2scm (p->output_basename_); +} + +LY_DEFINE (ly_parser_error, "ly:parser-error", + 2, 1, 0, (SCM parser, SCM msg, SCM input), + "Display an error message and make the parser fail.") +{ + LY_ASSERT_SMOB (Lily_parser, parser, 1); + Lily_parser *p = unsmob_lily_parser (parser); + + LY_ASSERT_TYPE (scm_is_string, msg, 2); + string s = ly_scm2string (msg); + + Input *i = unsmob_input (input); + if (i) + p->parser_error (*i, s); + else + p->parser_error (s); + + return parser; +} + +LY_DEFINE (ly_parser_clear_error, "ly:parser-clear-error", + 1, 0, 0, (SCM parser), + "Clear the error flag for the parser.") +{ + LY_ASSERT_SMOB (Lily_parser, parser, 1); + Lily_parser *p = unsmob_lily_parser (parser); + + p->error_level_ = 0; + p->lexer_->error_level_ = 0; - scm_gc_unprotect_object (layout->self_scm ()); return SCM_UNSPECIFIED; } +LY_DEFINE (ly_parser_has_error_p, "ly:parser-has-error?", + 1, 0, 0, (SCM parser), + "Does @var{parser} have an error flag?") +{ + LY_ASSERT_SMOB (Lily_parser, parser, 1); + Lily_parser *p = unsmob_lily_parser (parser); + + return scm_from_bool (p->error_level_ || p->lexer_->error_level_); +}