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 9fd578b2bd6262f0a42963f64f32c70392f5271c..4fe2057d0f06cd4d8ddeeff1ba92db601040b530 100644 (file)
--- 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 8da28072660aebb6b30aebc0063ba5e46f63f864..08701c982777c31954b8861da1c3392fbbfbc750 100644 (file)
--- 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 810076c8a241a7e3d9e0b42ae3acf7a82dbddb7e..03556ab01eda873a94f5aad7ce7f7c231f3281f9 100644 (file)
--- 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 c529da7c43a1efaa97d41b1ec336185b44358ccc..c196808a2fef49b9a3c62ec0cafd964477021bfe 100644 (file)
--- 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 059cac3149d23b150b2e9f1164f6ac03e96713c3..74d3feb65349a37f54e46a9e6437ca6ebefccca2 100644 (file)
--- 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 550f6fb84743f298cbfd1da60ab1e23bcaa67b06..1b78abaed0588debaf4adb9769ed328ce70e88d5 100644 (file)
--- 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 37d5fa4e770c4d954375bc584b899a75d4f6c499..3f4faf5d7c06ceadc599fade3b9a08355ed3ee16 100644 (file)
--- 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 7daa84929c6e578d423e4a2d353cb387874cc56d..8e8a2fc2123436dd8ee428e859b3ff7bfecdaea6 100644 (file)
--- 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 ad95a16d24d2f74ebc70e793b6d485f09a67d2e4..23978608a218e21812ddd482614bbcc9b50e5a0d 100644 (file)
--- 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)