From bee08e5734bb9ba7b2e9a6a72902c80bb9b3c108 Mon Sep 17 00:00:00 2001 From: Nicolas Sceaux Date: Thu, 23 Feb 2006 20:53:58 +0000 Subject: [PATCH] * mf/GNUmakefile: add '\' in multi-line "define ... endef" blocks (for make 3.80) * scm/parser-ly-from-scheme.scm (ly:parse-string-result): add \notemode so that user should not have to explicitely type it. * scm/define-music-display-methods.scm: various fixes (ApplyOutputEvent, ApplyContext; \new, \context and derived constructs) * input/no-notation/display-lily-tests.ly: new tests for \applyOutput and \applyContext --- ChangeLog | 15 +++++ input/no-notation/display-lily-tests.ly | 8 ++- mf/GNUmakefile | 4 +- scm/define-music-display-methods.scm | 39 +++++-------- scm/parser-ly-from-scheme.scm | 78 +++++++++++-------------- 5 files changed, 73 insertions(+), 71 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7e44af50a6..71d2bf9660 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2006-02-23 Nicolas Sceaux + + * mf/GNUmakefile: add '\' in multi-line "define ... endef" + blocks (for make 3.80) + + * scm/parser-ly-from-scheme.scm (ly:parse-string-result): add + \notemode so that user should not have to explicitely type it. + + * scm/define-music-display-methods.scm: various + fixes (ApplyOutputEvent, ApplyContext; \new, \context and derived + constructs) + + * input/no-notation/display-lily-tests.ly: new tests for + \applyOutput and \applyContext + 2006-02-23 Han-Wen Nienhuys * lily/constrained-breaking.cc: patch by Joe Neeman: "I have diff --git a/input/no-notation/display-lily-tests.ly b/input/no-notation/display-lily-tests.ly index 1585c734eb..136a87aa88 100644 --- a/input/no-notation/display-lily-tests.ly +++ b/input/no-notation/display-lily-tests.ly @@ -240,9 +240,12 @@ test = #(def-music-function (parser location result-info strings) (string? pair? \test #"" ##[ \revert Staff . Stem #'thickness #] % RevertProperty \test #"" ##[ \revert Beam #'thickness #] - %% \partial - + %% \applyOutput + \test #"" ##[ \applyOutput #(lambda (arg) ()) #] + %% \applyContext + \test #"" ##[ \applyContext #(lambda (arg) ()) #] + %% \partial \test #"" ##[ \partial 2 #] \test #"" ##[ \partial 8. #] \test #"TODO? exotic durations in \\partial" ##[ \partial 4*2/3 #] @@ -254,5 +257,6 @@ test = #(def-music-function (parser location result-info strings) (string? pair? %% Cue notes \test #"" ##[ \cueDuring #"foo" #1 { c d } #] \test #"" ##[ \quoteDuring #"foo" { c d } #] + } diff --git a/mf/GNUmakefile b/mf/GNUmakefile index 701f527e5d..e03b6d8eb0 100644 --- a/mf/GNUmakefile +++ b/mf/GNUmakefile @@ -67,8 +67,8 @@ define MAKE_OTF $(PYTHON) $(buildscript-dir)/substitute-encoding.py --outdir=$(outdir) $(2) endef -define EMMENTALER_RULE -$(outdir)/$(PFA_PREFIX)emmentaler-$(1).pfa $(outdir)/emmentaler-$(1).otf $(outdir)/emmentaler-$(1).svg: $(outdir)/emmentaler-$(1).pe $(outdir)/feta$(1).pfa $(outdir)/feta-alphabet$(1).pfa $(outdir)/parmesan$(1).pfa +define EMMENTALER_RULE \ +$(outdir)/$(PFA_PREFIX)emmentaler-$(1).pfa $(outdir)/emmentaler-$(1).otf $(outdir)/emmentaler-$(1).svg: $(outdir)/emmentaler-$(1).pe $(outdir)/feta$(1).pfa $(outdir)/feta-alphabet$(1).pfa $(outdir)/parmesan$(1).pfa \ $(call MAKE_OTF,emmentaler-$(1).pe, $(outdir)/PFAemmentaler-$(1).pfa) endef diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 67d0ee21e9..d098725d91 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -726,17 +726,16 @@ Otherwise, return #f." (define-display-method ContextSpeccedMusic (expr) (let ((id (ly:music-property expr 'context-id)) + (create-new (ly:music-property expr 'create-new)) (music (ly:music-property expr 'element)) (operations (ly:music-property expr 'property-operations)) (ctype (ly:music-property expr 'context-type))) (format #f "~a ~a~a~a ~a" - (if (and (not (null? id)) - (equal? id "$uniqueContextId")) + (if (and (not (null? create-new)) create-new) "\\new" "\\context") ctype - (if (or (null? id) - (equal? id "$uniqueContextId")) + (if (null? id) "" (format #f " = ~s" id)) (if (null? operations) @@ -756,7 +755,7 @@ Otherwise, return #f." ;; special cases: \figures \lyrics \drums (define-extra-display-method ContextSpeccedMusic (expr) (with-music-match (expr (music 'ContextSpeccedMusic - context-id "$uniqueContextId" + create-new #t property-operations ?op context-type ?context-type element ?sequence)) @@ -929,15 +928,11 @@ Otherwise, return #f." (define-extra-display-method ContextSpeccedMusic (expr) "If `expr' is a bar, return \"\\bar ...\". Otherwise, return #f." - (with-music-match (expr (music - 'ContextSpeccedMusic - element (music - 'ContextSpeccedMusic - context-type 'Timing - element (music - 'PropertySet - value ?bar-type - symbol 'whichBar)))) + (with-music-match (expr (music 'ContextSpeccedMusic + context-type 'Timing + element (music 'PropertySet + value ?bar-type + symbol 'whichBar))) (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string)))) ;;; \partial @@ -986,20 +981,20 @@ Otherwise, return #f." ;;; (define-display-method ApplyOutputEvent (applyoutput) - (let ((proc (ly:music-property applyoutput 'procedure)))) - (format #f "\\applyoutput #~a" + (let ((proc (ly:music-property applyoutput 'procedure))) + (format #f "\\applyOutput #~a" (or (procedure-name proc) (with-output-to-string (lambda () - (pretty-print (procedure-source proc))))))) + (pretty-print (procedure-source proc)))))))) (define-display-method ApplyContext (applycontext) - (let ((proc (ly:music-property applycontext 'procedure)))) - (format #f "\\applycontext #~a" + (let ((proc (ly:music-property applycontext 'procedure))) + (format #f "\\applyContext #~a" (or (procedure-name proc) (with-output-to-string (lambda () - (pretty-print (procedure-source proc))))))) + (pretty-print (procedure-source proc)))))))) ;;; \partcombine (define-display-method PartCombineMusic (expr) @@ -1065,13 +1060,11 @@ Otherwise, return #f." (with-music-match (expr (music 'SimultaneousMusic elements ((music 'ContextSpeccedMusic context-id ?id - ;;property-operations '() context-type 'Voice element ?note-sequence) (music 'ContextSpeccedMusic - context-id "$uniqueContextId" - ;;property-operations '() context-type 'Lyrics + create-new #t element (music 'LyricCombineMusic associated-context ?associated-id element ?lyric-sequence))))) diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm index 0331aa885d..d7a83a1f4d 100644 --- a/scm/parser-ly-from-scheme.scm +++ b/scm/parser-ly-from-scheme.scm @@ -12,18 +12,17 @@ (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) "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 +34,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 +53,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: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))))) (read-hash-extend #\{ read-lily-expression) -- 2.39.2