X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fparser-ly-from-scheme.scm;h=f124a82f359776402d2a8afe793639b6555465c8;hb=7b3a9b122d7ef1eb70fdabaac466b7b0c23a1df2;hp=0331aa885d8c56a088d271de17ddba13ef49ea25;hpb=75eebcb49e52d296b1da3e1074e0825d2c780db4;p=lilypond.git diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm index 0331aa885d..f124a82f35 100644 --- a/scm/parser-ly-from-scheme.scm +++ b/scm/parser-ly-from-scheme.scm @@ -1,9 +1,20 @@ -;;;; ly-from-scheme.scm -- parsing LilyPond music expressions from scheme +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2004--2006 Nicolas Sceaux +;;;; Copyright (C) 2004--2011 Nicolas Sceaux ;;;; Jan Nieuwenhuizen +;;;; +;;;; 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 . (define gen-lily-sym ;; Generate a lilyvartmpXX symbol, that may be (hopefully) unique. @@ -12,18 +23,18 @@ (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))))) + (integer->char (+ (char->integer #\a) + (- (char->integer chr) + (char->integer #\0))))) (string->list (number->string var-idx))))))))) -(define-public (ly:parse-string-result str parser) +(define-public (parse-string-result str parser) "Parse `str', which is supposed to contain a music expression." - (let ((music-sym (gen-lily-sym))) - (ly:parser-parse-string - parser - (format #f "parseStringResult = { ~a }" str)) - (ly:parser-lookup parser 'parseStringResult))) + (ly:parser-parse-string + parser + (format #f "parseStringResult = \\notemode { ~a }" str)) + (ly:parser-lookup parser 'parseStringResult)) (define-public (read-lily-expression chr port) "Read a #{ lily music expression #} from port and return @@ -35,7 +46,6 @@ character." (define (create-binding! val) "Create a new symbol, bind it to `val' and return it." (let ((tmp-symbol (gen-lily-sym))) - (set! bindings (cons (cons tmp-symbol val) bindings)) tmp-symbol)) @@ -55,42 +65,34 @@ character." (cons (create-binding! (cadr form)) (remove-dollars! (cddr form)))) (else ;; (something ...) (cons (remove-dollars! (car form)) (remove-dollars! (cdr form)))))) - (let* - ((lily-string (call-with-output-string + + (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 encoutered - (read-char port)) - (cond - ;; a $form expression - ((and (char=? c #\$) (not (char=? (peek-char port) #\$))) - (format out "\\~a" (create-binding! (read port)))) - ;; just a $ character - ((and (char=? c #\$) (char=? (peek-char port) #\$)) - ;; pop the second $ - (display (read-char port) out)) - ;; a #scheme expression - ((char=? c #\#) - (let ((expr (read port))) - (format out "#~s" (if (eq? '$ expr) - (create-binding! (read port)) - (remove-dollars! expr))))) - ;; other caracters - (else - (display c out))))))) - - (result - `(let ((parser-clone (ly:clone-parser parser))) - ,@(map (lambda (binding) - `(ly:parser-define! parser-clone ',(car binding) ,(cdr binding))) - (reverse bindings)) - (ly:parse-string-result ,lily-string parser-clone)) - )) - - - - result - ))) + ((and (char=? c #\#) + (char=? (peek-char port) #\})) ;; we stop when #} is encoutered + (read-char port)) + (cond + ;; a $form expression + ((and (char=? c #\$) (not (char=? (peek-char port) #\$))) + (format out "\\~a" (create-binding! (read port)))) + ;; just a $ character + ((and (char=? c #\$) (char=? (peek-char port) #\$)) + ;; pop the second $ + (display (read-char port) out)) + ;; a #scheme expression + ((char=? c #\#) + (let ((expr (read port))) + (format out "#~s" (if (eq? '$ expr) + (create-binding! (read port)) + (remove-dollars! expr))))) + ;; other caracters + (else + (display c out)))))))) + `(let ((parser-clone (ly:parser-clone parser))) + ,@(map (lambda (binding) + `(ly:parser-define! parser-clone ',(car binding) ,(cdr binding))) + (reverse bindings)) + (parse-string-result ,lily-string parser-clone))))) (read-hash-extend #\{ read-lily-expression)