From 651c0aa98ece85d2dc35288d2e939360f8f082a9 Mon Sep 17 00:00:00 2001
From: Nicolas Sceaux <nicolas.sceaux@free.fr>
Date: Sun, 25 Apr 2004 18:39:39 +0000
Subject: [PATCH] * scm/lily.scm (ly:load): Add ly-from-scheme.scm loading.

* scm/ly-from-scheme.scm: New file. Introduce a new syntax:
#{ lily music expression #} that returns an equivalent scheme
music expression by parsing the string.
---
 ChangeLog              |  8 ++++++
 scm/lily.scm           |  2 ++
 scm/ly-from-scheme.scm | 61 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 71 insertions(+)
 create mode 100644 scm/ly-from-scheme.scm

diff --git a/ChangeLog b/ChangeLog
index 1361b594f2..0b78459c11 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2004-04-25  Nicolas Sceaux  <nicolas.sceaux@free.fr>
+
+	* scm/lily.scm (ly:load): Add ly-from-scheme.scm loading.
+
+	* scm/ly-from-scheme.scm: New file. Introduce a new syntax:
+	#{ lily music expression #} that returns an equivalent scheme
+	music expression by parsing the string.
+
 2004-04-25  Jan Nieuwenhuizen  <janneke@gnu.org>
 
 	* lily/my-lily-parser.cc:
diff --git a/scm/lily.scm b/scm/lily.scm
index f217072603..1c80008611 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -442,6 +442,8 @@ L1 is copied, L2 not.
        "define-music-properties.scm"
        "auto-beam.scm"
        "chord-name.scm"
+
+       "ly-from-scheme.scm"
        
        "define-context-properties.scm"
        "translation-functions.scm"
diff --git a/scm/ly-from-scheme.scm b/scm/ly-from-scheme.scm
new file mode 100644
index 0000000000..0436f423e8
--- /dev/null
+++ b/scm/ly-from-scheme.scm
@@ -0,0 +1,61 @@
+;;;; ly-from-scheme.scm -- parsing LilyPond music expressions from scheme
+;;;;
+;;;;  source file of the GNU LilyPond music typesetter
+;;;; 
+;;;; (c)  2000--2004  Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
+
+
+(define gen-lily-sym
+  ;; Generate a lilyvartmpXX symbol, that may be (hopefully) unique.
+  (let ((var-idx -1))
+    (lambda ()
+      (set! var-idx (1+ var-idx))
+      (string->symbol (format #f "lilyvartmp~a"
+                              (list->string (map (lambda (chr)
+                                                   (integer->char (+ (char->integer #\a) (- (char->integer chr)
+                                                                                            (char->integer #\0)))))
+                                                 (string->list (number->string var-idx)))))))))
+
+(define-public (ly:parse-string-result str module)
+  "Parse `str', which is supposed to contain a music expression."
+  (let ((music-sym (gen-lily-sym)))
+    (ly:parser-parse-string
+     parser
+     (format #f "
+~a = { ~a }
+#(ly:export '~a)
+#(module-define! (resolve-module '~a) '~a ~a)
+"
+             music-sym str music-sym (module-name module) music-sym music-sym))
+  (eval `,music-sym module)))
+
+(define-public (read-lily-expression chr port)
+  "Read a #{ lily music expression #} from port and return
+the scheme music expression. The $ character may be used to introduce
+scheme forms, typically symbols. $$ may be used to simply write a `$'
+character."
+  (let* ((format-args '())
+         (lily-string (with-output-to-string
+                        (lambda ()
+                          (do ((c (read-char port) (read-char port)))
+                              ((and (char=? c #\#)
+                                    (char=? (peek-char port) #\}))
+                               (read-char port))
+                            (cond ((and (char=? c #\$)
+                                        (not (char=? (peek-char port) #\$)))
+                                   ;; a $variable
+                                   (display "~a")
+                                   (set! format-args (cons (read port) 
+format-args)))
+                                  ((and (char=? c #\$)
+                                        (char=? (peek-char port) #\$))
+                                   ;; just a $ character
+                                   (display (read-char port)))
+                                  (else
+                                   ;; other caracters
+                                   (display c))))))))
+   `(ly:parse-string-result (format #f ,lily-string ,@(reverse! format-args))
+                            (current-module))))
+
+(read-hash-extend #\{ read-lily-expression)
-- 
2.39.5