From: David Kastrup <dak@gnu.org>
Date: Wed, 16 Nov 2011 07:04:23 +0000 (+0100)
Subject: Lambaize $ and # in #{ ... #} to make Guile V2 happy.
X-Git-Tag: release/2.15.20-1~6
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;ds=sidebyside;h=c1595a93520de54eebc68ab8cb23bd28145e901c;p=lilypond.git

Lambaize $ and # in #{ ... #} to make Guile V2 happy.
---

diff --git a/lily/include/lily-lexer.hh b/lily/include/lily-lexer.hh
index c53263d33e..79aee379fe 100644
--- a/lily/include/lily-lexer.hh
+++ b/lily/include/lily-lexer.hh
@@ -100,6 +100,7 @@ public:
   virtual void new_input (string s, Sources *);
   virtual void new_input (string s, string d, Sources *);
 
+  bool top_input () { return include_stack_.size () < 2; }
   SCM keyword_list () const;
   SCM lookup_identifier (string s);
   SCM lookup_identifier_symbol (SCM s);
diff --git a/lily/parse-scm.cc b/lily/parse-scm.cc
index 7fea6f7d2c..9cd177f23c 100644
--- a/lily/parse-scm.cc
+++ b/lily/parse-scm.cc
@@ -23,6 +23,7 @@
 using namespace std;
 
 #include "lily-parser.hh"
+#include "lily-lexer.hh"
 #include "international.hh"
 #include "main.hh"
 #include "paper-book.hh"
@@ -57,8 +58,14 @@ internal_ly_parse_scm (Parse_start *ps)
      early. */
   // scm_close_port (port);
 
-  if (!SCM_EOF_OBJECT_P (form))
+  if (!SCM_EOF_OBJECT_P (form)) {
+    if (ps->parser_->lexer_->top_input ()
+	&& scm_is_pair (ps->parser_->local_environment_)) {
+      form = scm_list_1 (scm_car (ps->parser_->local_environment_));
+      ps->parser_->local_environment_ = scm_cdr (ps->parser_->local_environment_);
+    }
     return scm_cons (form, make_input (ps->start_location_));
+  }
 
   return SCM_UNDEFINED;
 }
@@ -66,8 +73,6 @@ internal_ly_parse_scm (Parse_start *ps)
 SCM
 internal_ly_eval_scm (Parse_start *ps)
 {
-  if (ps->parser_ && !SCM_UNBNDP (ps->parser_->local_environment_))
-    return scm_local_eval (ps->form_, ps->parser_->local_environment_);
   if (ps->safe_)
     {
       static SCM module = SCM_BOOL_F;
diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm
index 3f19641916..f96af9396d 100644
--- a/scm/parser-ly-from-scheme.scm
+++ b/scm/parser-ly-from-scheme.scm
@@ -20,19 +20,24 @@
   "Read a lilypond music expression enclosed within @code{#@{} and @code{#@}}
 from @var{port} and return the corresponding Scheme music expression.
 @samp{$} and @samp{#} introduce immediate and normal Scheme forms."
-  (let ((lily-string (call-with-output-string
-		      (lambda (out)
-			(do ((c (read-char port) (read-char port)))
-			    ((and (char=? c #\#)
-				  (char=? (peek-char port) #\})) ;; we stop when #} is encountered
-			     (read-char port))
-			  ;; a #scheme or $scheme expression
-			  (if (or (char=? c #\#) (char=? c #\$))
-			      (format out "~a~s" c (read port))
-			      ;; other characters
-			      (display c out)))))))
+  (let* ((closures '())
+	 (lily-string (call-with-output-string
+		       (lambda (out)
+			 (do ((c (read-char port) (read-char port)))
+			     ((and (char=? c #\#)
+				   (char=? (peek-char port) #\})) ;; we stop when #} is encountered
+			      (read-char port))
+			   ;; a #scheme or $scheme expression
+			   (if (or (char=? c #\#) (char=? c #\$))
+			       (begin
+				 (set! closures (cons (read port) closures))
+				 (format out "~a~s" c (car closures)))
+			       ;; other characters
+			       (display c out)))))))
     `(let* ((clone
-	     (ly:parser-clone parser (procedure-environment (lambda () '()))))
+	     (ly:parser-clone parser (list ,@(map (lambda (c)
+						    `(lambda () ,c))
+						  (reverse! closures)))))
 	    (result (ly:parse-string-expression clone ,lily-string)))
        (if (ly:parser-has-error? clone)
 	   (ly:parser-error parser (_ "error in #{ ... #}")))