From a5bd1abc0dba02bc2958526a6cd653b981911d43 Mon Sep 17 00:00:00 2001 From: Nicolas Sceaux Date: Fri, 14 May 2004 08:46:53 +0000 Subject: [PATCH] * scm/ly-from-scheme.scm (read-lily-expression): A variable refering to a music expression can be used in lily-inside-scheme: #{ $music #} * lily/my-lily-parser.cc (LY_DEFINE): introduce ly:clone-parser and ly:parser-define, and change ly:parser-parse-string in order to make #{ $music #} work. * scm/new-markup.scm (compile-markup-expression): when an argument is a string, use `make-simple-markup'. --- ChangeLog | 13 ++++++++ lily/my-lily-parser.cc | 23 ++++++++++++++- scm/ly-from-scheme.scm | 67 ++++++++++++++++++++++++++++-------------- scm/new-markup.scm | 5 +++- 4 files changed, 84 insertions(+), 24 deletions(-) diff --git a/ChangeLog b/ChangeLog index 222a4fe721..baf09eb697 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2004-05-14 Nicolas Sceaux + + * scm/ly-from-scheme.scm (read-lily-expression): A variable + refering to a music expression can be used in lily-inside-scheme: + #{ $music #} + + * lily/my-lily-parser.cc (LY_DEFINE): introduce ly:clone-parser + and ly:parser-define, and change ly:parser-parse-string in order + to make #{ $music #} work. + + * scm/new-markup.scm (compile-markup-expression): when an argument + is a string, use `make-simple-markup'. + 2004-05-14 Han-Wen Nienhuys * lily/parser.yy (My_lily_lexer): bugfix; op should be tag. diff --git a/lily/my-lily-parser.cc b/lily/my-lily-parser.cc index af660e4646..0d6aeb34bc 100644 --- a/lily/my-lily-parser.cc +++ b/lily/my-lily-parser.cc @@ -310,6 +310,27 @@ LY_DEFINE (ly_parse_string, "ly:parse-string", return SCM_UNSPECIFIED; } +LY_DEFINE (ly_clone_parser, "ly:clone-parser", + 1, 0, 0, + (SCM parser_smob), + "Return a clone of PARSER_SMOB.") +{ + My_lily_parser *parser = unsmob_my_lily_parser (parser_smob); + My_lily_parser *clone = new My_lily_parser (*parser); + return scm_gc_unprotect_object (clone->self_scm ()); +} + +LY_DEFINE(ly_parser_define, "ly:parser-define", + 3, 0, 0, + (SCM parser_smob, SCM symbol, SCM val), + "Bind SYMBOL to VAL in PARSER_SMOB's module.") +{ + SCM_ASSERT_TYPE (ly_c_symbol_p (symbol), symbol, SCM_ARG1, __FUNCTION__, "symbol"); + My_lily_parser *parser = unsmob_my_lily_parser (parser_smob); + parser->lexer_->set_identifier (scm_symbol_to_string (symbol), val); + return SCM_UNSPECIFIED; +} + LY_DEFINE (ly_parser_parse_string, "ly:parser-parse-string", 2, 0, 0, (SCM parser_smob, SCM ly_code), @@ -321,7 +342,7 @@ LY_DEFINE (ly_parser_parse_string, "ly:parser-parse-string", #endif SCM_ASSERT_TYPE (ly_c_string_p (ly_code), ly_code, SCM_ARG1, __FUNCTION__, "string"); -#if 0 +#if 1 My_lily_parser *parser = unsmob_my_lily_parser (parser_smob); parser->parse_string (ly_scm2string (ly_code)); #else diff --git a/scm/ly-from-scheme.scm b/scm/ly-from-scheme.scm index 6a94976c92..f7928db4b3 100644 --- a/scm/ly-from-scheme.scm +++ b/scm/ly-from-scheme.scm @@ -16,7 +16,7 @@ (char->integer #\0))))) (string->list (number->string var-idx))))))))) -(define-public (ly:parse-string-result str module) +(define-public (ly:parse-string-result str parser module) "Parse `str', which is supposed to contain a music expression." (let ((music-sym (gen-lily-sym))) (ly:parser-parse-string @@ -34,27 +34,50 @@ 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 () + (let ((bindings '())) + (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)) + (define (remove-dollars! form) + "Generate a form where `$variable' and `$ value' mottos are replaced + by new symbols, which are binded to the adequate values." + (cond (;; $variable + (and (symbol? form) + (string=? (substring (symbol->string form) 0 1) "$") + (not (string=? (substring (symbol->string form) 1 2) "$"))) + (create-binding! (string->symbol (substring (symbol->string form) 1)))) + (;; atom + (not (pair? form)) form) + (;; ($ value ...) + (eqv? (car form) '$) + (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 + (lambda (out) (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)))) + ((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) #\$)) + (display (read-char port) out)) ;; pop the second $ + ;; a #scheme expression + ((char=? c #\#) + (format out "#~a" (remove-dollars! (read port)))) + ;; other caracters + (else + (display c out)))))))) + `(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 (current-module)))))) (read-hash-extend #\{ read-lily-expression) diff --git a/scm/new-markup.scm b/scm/new-markup.scm index 2d3632cdf8..7dcf129684 100644 --- a/scm/new-markup.scm +++ b/scm/new-markup.scm @@ -175,8 +175,11 @@ e.g. (make-COMMAND-markup arg1 arg2 ...), and the rest expression." ;; expr === ((#:COMMAND arg1 ...) ...) (receive (m r) (compile-markup-expression (car expr)) (values m (cdr expr)))) + ((and (pair? expr) + (string? (car expr))) ;; expr === ("string" ...) + (values `(make-simple-markup ,(car expr)) (cdr expr))) (else - ;; expr === (symbol ...) or ("string" ...) or ((funcall ...) ...) + ;; expr === (symbol ...) or ((funcall ...) ...) (values (car expr) (cdr expr))))) -- 2.39.5