From: David Kastrup Date: Mon, 4 Feb 2013 15:38:12 +0000 (+0100) Subject: Issue 3153: Let music inside of #{ ... #} originate from @code{location} if set X-Git-Tag: release/2.17.13-1~10^2~23 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=b24aaf5d1e10c5ea055043ce6b2c3d50d2a9c943;p=lilypond.git Issue 3153: Let music inside of #{ ... #} originate from @code{location} if set In particular with regard to point-and-click, it has been a reoccuring complaint that music originating from #{ ... #} has the #{ ... #} environment as its origin. This patch will make such music originate from @code{location} if set to a valid input location. It would seem somewhat peculiar that #{ ... #} just grabs whatever meaning @code{location} happens to have at the current lexical level and runs with it. However, the same is already done for @code{parser}, so it is not really out of line. --- diff --git a/Documentation/extending/programming-interface.itely b/Documentation/extending/programming-interface.itely index 9fd578b2bd..4fe2057d0f 100644 --- a/Documentation/extending/programming-interface.itely +++ b/Documentation/extending/programming-interface.itely @@ -42,11 +42,14 @@ can deal with embedded Scheme expressions starting with @code{$} and@w{ }@code{#}. It extracts the Lilypond code block and generates a call to the -LilyPond @code{parser} which is executed at runtime to interpret the -LilyPond code block. Any embedded Scheme expression is executed in -the lexical environment of the Lilypond code block, so you have access -to local variables and function parameters at the point the Lilypond -code block is written. +LilyPond @code{parser} which is executed at runtime to interpret +the LilyPond code block. Any embedded Scheme expression is +executed in the lexical environment of the Lilypond code block, so +you have access to local variables and function parameters at the +point the Lilypond code block is written. If @code{location} +refers to a valid input location (which it usually does inside of +music/@/scheme functions), all music generated inside the code +block has its @samp{origin} set to @code{location}. A LilyPond code block may contain anything that you can use on the right side of an assignment. In addition, an empty LilyPond block corresponds diff --git a/lily/include/lily-lexer.hh b/lily/include/lily-lexer.hh index 8da2807266..08701c9827 100644 --- a/lily/include/lily-lexer.hh +++ b/lily/include/lily-lexer.hh @@ -50,6 +50,7 @@ private: SCM scopes_; SCM start_module_; int hidden_state_; + Input override_input_; SCM eval_scm (SCM, char extra_token = 0); public: SCM eval_scm_token (SCM sval) { return eval_scm (sval, '#'); } @@ -69,7 +70,7 @@ public: Input last_input_; Lily_lexer (Sources *, Lily_parser *); - Lily_lexer (Lily_lexer const &, Lily_parser *); + Lily_lexer (Lily_lexer const &, Lily_parser *, SCM); int yylex (); void add_lexed_char (int); @@ -77,6 +78,7 @@ public: void prepare_for_next_token (); int try_special_identifiers (SCM *, SCM); Input here_input () const; + Input const &override_input (Input const &) const; void add_scope (SCM); SCM set_current_scope (); diff --git a/lily/include/lily-parser.hh b/lily/include/lily-parser.hh index 810076c8a2..03556ab01e 100644 --- a/lily/include/lily-parser.hh +++ b/lily/include/lily-parser.hh @@ -54,7 +54,8 @@ public: bool ignore_version_b_; Lily_parser (Sources *sources); - Lily_parser (Lily_parser const &, SCM closures = SCM_EOL); + Lily_parser (Lily_parser const &, SCM closures = SCM_EOL, + SCM location = SCM_BOOL_F); DECLARE_SCHEME_CALLBACK (layout_description, ()); diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc index c529da7c43..c196808a2f 100644 --- a/lily/lily-lexer.cc +++ b/lily/lily-lexer.cc @@ -106,7 +106,8 @@ Lily_lexer::Lily_lexer (Sources *sources, Lily_parser *parser) chordmodifier_tab_ = scm_make_vector (scm_from_int (1), SCM_EOL); } -Lily_lexer::Lily_lexer (Lily_lexer const &src, Lily_parser *parser) +Lily_lexer::Lily_lexer (Lily_lexer const &src, Lily_parser *parser, + SCM override_input) : Includable_lexer () { parser_ = parser; @@ -122,6 +123,8 @@ Lily_lexer::Lily_lexer (Lily_lexer const &src, Lily_parser *parser) main_input_level_ = 0; extra_tokens_ = SCM_EOL; + if (unsmob_input (override_input)) + override_input_ = *unsmob_input (override_input); smobify_self (); @@ -335,6 +338,13 @@ Lily_lexer::here_input () const return Input (*lexloc_); } +Input const & +Lily_lexer::override_input (Input const &in) const +{ + return override_input_.get_source_file () + ? override_input_ : in; +} + void Lily_lexer::prepare_for_next_token () { diff --git a/lily/lily-parser-scheme.cc b/lily/lily-parser-scheme.cc index 059cac3149..74d3feb653 100644 --- a/lily/lily-parser-scheme.cc +++ b/lily/lily-parser-scheme.cc @@ -146,11 +146,12 @@ LY_DEFINE (ly_parser_lexer, "ly:parser-lexer", } LY_DEFINE (ly_parser_clone, "ly:parser-clone", - 1, 1, 0, (SCM parser_smob, SCM closures), + 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.") + " lexical environment. If @var{location} is a valid location," + " it becomes the source of all music expressions inside.") { LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); Lily_parser *parser = unsmob_lily_parser (parser_smob); @@ -158,7 +159,7 @@ LY_DEFINE (ly_parser_clone, "ly:parser-clone", closures = SCM_EOL; else LY_ASSERT_TYPE (ly_is_list, closures, 2); - Lily_parser *clone = new Lily_parser (*parser, closures); + Lily_parser *clone = new Lily_parser (*parser, closures, location); return clone->unprotect (); } diff --git a/lily/lily-parser.cc b/lily/lily-parser.cc index 550f6fb847..1b78abaed0 100644 --- a/lily/lily-parser.cc +++ b/lily/lily-parser.cc @@ -53,7 +53,7 @@ Lily_parser::Lily_parser (Sources *sources) lexer_->unprotect (); } -Lily_parser::Lily_parser (Lily_parser const &src, SCM closures) +Lily_parser::Lily_parser (Lily_parser const &src, SCM closures, SCM location) { lexer_ = 0; sources_ = src.sources_; @@ -65,10 +65,9 @@ Lily_parser::Lily_parser (Lily_parser const &src, SCM closures) smobify_self (); if (src.lexer_) { - lexer_ = new Lily_lexer (*src.lexer_, this); + lexer_ = new Lily_lexer (*src.lexer_, this, location); + lexer_->unprotect (); } - - lexer_->unprotect (); } Lily_parser::~Lily_parser () diff --git a/lily/parser.yy b/lily/parser.yy index 37d5fa4e77..3f4faf5d7c 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -194,7 +194,9 @@ while (0) %{ -#define MY_MAKE_MUSIC(x, spot) make_music_with_input (ly_symbol2scm (x), spot) +#define MY_MAKE_MUSIC(x, spot) \ + make_music_with_input (ly_symbol2scm (x), \ + parser->lexer_->override_input (spot)) /* ES TODO: - Don't use lily module, create a new module instead. @@ -203,12 +205,12 @@ while (0) #define LOWLEVEL_MAKE_SYNTAX(proc, args) \ scm_apply_0 (proc, args) /* Syntactic Sugar. */ -#define MAKE_SYNTAX(name, location, ...) \ - LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant (name), scm_list_n (parser->self_scm (), make_input (location) , ##__VA_ARGS__, SCM_UNDEFINED)) +#define MAKE_SYNTAX(name, location, ...) \ + LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant (name), scm_list_n (parser->self_scm (), make_input (parser->lexer_->override_input (location)), ##__VA_ARGS__, SCM_UNDEFINED)) #define START_MAKE_SYNTAX(name, ...) \ scm_list_n (ly_lily_module_constant (name) , ##__VA_ARGS__, SCM_UNDEFINED) #define FINISH_MAKE_SYNTAX(start, location, ...) \ - LOWLEVEL_MAKE_SYNTAX (scm_car (start), scm_cons2 (parser->self_scm (), make_input (location), scm_append_x (scm_list_2 (scm_cdr (start), scm_list_n (__VA_ARGS__, SCM_UNDEFINED))))) + LOWLEVEL_MAKE_SYNTAX (scm_car (start), scm_cons2 (parser->self_scm (), make_input (parser->lexer_->override_input (location)), scm_append_x (scm_list_2 (scm_cdr (start), scm_list_n (__VA_ARGS__, SCM_UNDEFINED))))) SCM get_next_unique_context_id (); SCM get_next_unique_lyrics_context_id (); @@ -3422,7 +3424,8 @@ Lily_lexer::try_special_identifiers (SCM *destination, SCM sid) mus = mus->clone (); *destination = mus->self_scm (); unsmob_music (*destination)-> - set_property ("origin", make_input (last_input_)); + set_property ("origin", + make_input (override_input (last_input_))); bool is_event = mus->is_mus_type ("post-event"); mus->unprotect (); diff --git a/ly/init.ly b/ly/init.ly index 7daa84929c..8e8a2fc212 100644 --- a/ly/init.ly +++ b/ly/init.ly @@ -20,6 +20,7 @@ #(note-names-language parser default-language) #(ly:set-option 'old-relative #f) +#(define location #f) #(define toplevel-scores (list)) #(define toplevel-bookparts (list)) #(define $defaultheader #f) diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm index ad95a16d24..23978608a2 100644 --- a/scm/parser-ly-from-scheme.scm +++ b/scm/parser-ly-from-scheme.scm @@ -65,13 +65,17 @@ from @var{port} and return the corresponding Scheme music expression. (set! closures (cons `(cons ,p (lambda () ,expr)) closures))))))))))) - (define (embedded-lilypond parser lily-string filename line closures) - (let* ((clone (ly:parser-clone parser closures)) + (define (embedded-lilypond parser lily-string filename line + closures location) + (let* ((clone (ly:parser-clone parser closures location)) (result (ly:parse-string-expression clone lily-string filename line))) (if (ly:parser-has-error? clone) (ly:parser-error parser (_ "error in #{ ... #}"))) result)) - (list embedded-lilypond 'parser lily-string filename line (cons 'list (reverse! closures))))) + (list embedded-lilypond + 'parser lily-string filename line + (cons 'list (reverse! closures)) + 'location))) (read-hash-extend #\{ read-lily-expression)