From b32896be1cc5b4f9f7cfaa4f83ad073961f16db8 Mon Sep 17 00:00:00 2001 From: Nicolas Sceaux Date: Fri, 3 Nov 2006 15:59:51 +0000 Subject: [PATCH] * scm/display-lily.scm: add a parser argument to display methods, instead of using a *parser* special variable. * scm/define-music-display-methods.scm: add a parser argument to display methods. Update the methods for \melisma, \melismaEnd, \breathe, \tempo, \partial. * input/no-notation/display-lily-tests.ly: update the test utilities according to the changes in display-lily.scm --- ChangeLog | 12 + input/no-notation/display-lily-tests.ly | 382 ++++++++++++----------- ly/music-functions-init.ly | 18 +- scm/define-music-display-methods.scm | 396 +++++++++++++----------- scm/display-lily.scm | 18 +- 5 files changed, 436 insertions(+), 390 deletions(-) diff --git a/ChangeLog b/ChangeLog index 566b1f8227..b664fb1a54 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2006-11-03 Nicolas Sceaux + + * scm/display-lily.scm: add a parser argument to display methods, + instead of using a *parser* special variable. + + * scm/define-music-display-methods.scm: add a parser argument to + display methods. Update the methods for \melisma, \melismaEnd, + \breathe, \tempo, \partial. + + * input/no-notation/display-lily-tests.ly: update the test + utilities according to the changes in display-lily.scm + 2006-11-03 Han-Wen Nienhuys * *: The Joy of Merging. diff --git a/input/no-notation/display-lily-tests.ly b/input/no-notation/display-lily-tests.ly index 5b931ad495..5557e046a7 100644 --- a/input/no-notation/display-lily-tests.ly +++ b/input/no-notation/display-lily-tests.ly @@ -6,13 +6,8 @@ %%% %%% Testing utilities %%% -#(define (my-parse-string-result str parser) - "Parse `str', which is supposed to contain a music expression." - (ly:parser-parse-string parser - (format #f "parseStringResult = \\notemode { ~a }" str)) - (ly:parser-lookup parser 'parseStringResult)) -#(define (my-read-lily-expression chr port) +#(define (parse-lily-and-compute-lily-string chr port) (let ((lily-string (call-with-output-string (lambda (out) (do ((c (read-char port) (read-char port))) @@ -22,42 +17,48 @@ (display c out)))))) `(let* ((parser-clone (ly:clone-parser parser)) (input-str (string-trim-both ,lily-string)) - (music (car (ly:music-property (my-parse-string-result input-str parser-clone) + (music (car (ly:music-property (parse-string-result input-str + parser-clone) 'elements))) - (result-str (string-trim-both (music->lily-string music)))) + (result-str (string-trim-both (music->lily-string music parser-clone)))) (cons input-str result-str)))) -#(read-hash-extend #\[ my-read-lily-expression) +#(read-hash-extend #\[ parse-lily-and-compute-lily-string) %{ ] %} -#(define test-number 0) - #(define (lily-string->markup str) (make-column-markup (string-split str #\NewLine))) -test = #(define-music-function (parser location result-info strings) (string? pair?) - (display-lily-init parser) - (let ((input (car strings)) - (output (cdr strings))) - (set! test-number (1+ test-number)) - (if (string=? input output) - (make-music 'SequentialMusic) - (make-music 'SequentialMusic - 'elements - (list (make-music 'EventChord - 'elements (list (make-music 'LineBreakEvent - 'break-permission 'force))) - (make-music 'EventChord - 'elements (list (make-music 'SkipEvent - 'duration (ly:make-duration 0 0 1 1)) - (make-music 'TextScriptEvent - 'direction -1 - 'text (markup #:column (#:simple (format #f "Test #~a " - test-number) - (if (string-null? result-info) - (markup #:bold "BUG") - (markup #:simple result-info)) - #:typewriter (lily-string->markup input) - #:typewriter (lily-string->markup output))))))))))) +#(define test-function + (let ((test-number 0)) + (lambda (parser location result-info strings) + (let ((input (car strings)) + (output (cdr strings))) + (set! test-number (1+ test-number)) + (if (string=? input output) + (make-music 'SequentialMusic 'void #t) + (make-music 'SequentialMusic + 'elements + (list (ly:parser-lookup parser 'fatText) + (make-music 'EventChord + 'elements (list (make-music 'LineBreakEvent + 'break-permission 'force))) + (make-music 'EventChord + 'elements (list (make-music 'SkipEvent + 'duration (ly:make-duration 0 0 1 1)) + (make-music 'TextScriptEvent + 'direction -1 + 'text (markup #:column + (#:simple (format #f "Test #~a " test-number) + (if (string-null? result-info) + (markup #:bold "BUG") + (markup #:simple result-info)) + #:typewriter (lily-string->markup input) + #:typewriter (lily-string->markup output))))))))))))) + + +test = +#(define-music-function (parser location result-info strings) (string? pair?) + (test-function parser location result-info strings)) %%% %%% Tests @@ -70,7 +71,7 @@ test = #(define-music-function (parser location result-info strings) (string? pa \layout { raggedright = ##t - indent = 0.0\cm + indent = 0\cm \context { \Staff \override StaffSymbol #'line-count = #1 @@ -82,183 +83,180 @@ test = #(define-music-function (parser location result-info strings) (string? pa \remove "Bar_number_engraver" } } -{ - \fatText - %% Sequential music - \test #"" ##[ { { a b } { c d } } #] % SequentialMusic - \test #"" ##[ << { a b } { c d } >> #] % SimultaneousMusic - \test #"" ##[ << { a b } \\ { c d } >> #] % VoiceSeparator - - %% Chords and Notes - \test #"" ##[ { ceses ces c cis cisis } #] % NoteEvent - \test #"" ##[ { deses des d dis disis } #] - \test #"" ##[ { eeses ees e eis eisis } #] - \test #"" ##[ { feses fes f fis fisis } #] - \test #"" ##[ { geses ges g gis gisis } #] - \test #"" ##[ { aeses aes a ais aisis } #] - \test #"" ##[ { beses bes b bis bisis } #] - \test #"" ##[ { c,, d' } #] - \test #"" ##[ { c' d'=' } #] - \test #"" ##[ { c! c? } #] - \test #"" ##[ r1.*4/3 #] % RestEvent - \test #"" ##[ c1\rest #] % RestEvent - \test #"" ##[ s2..*3/4 #] % SkipEvent - \test #"" ##[ R1.*2/3 #] % MultiMeasureRestMusicGroup, MultiMeasureRestEvent - \test #"" ##[ \skip 2.*3/4 #] % SkipMusic - \test #"" ##[ < c\1 e\3 >4.*3/4-. #] % EventChord, NoteEvent, StringNumberEvent, ArticulationEvent - %% tags - \test #"" ##[ { \tag #'foo { c4 d } } #] - \test #"" ##[ c-\tag #'foo -\tag #'baz -^ -. #] +%% Sequential music +\test "" ##[ { { a b } { c d } } #] % SequentialMusic +\test "" ##[ << { a b } { c d } >> #] % SimultaneousMusic +\test "" ##[ << { a b } \\ { c d } >> #] % VoiceSeparator - %% Graces - \test #"" ##[ { \grace c8 d2 } #] % GraceMusic - \test #"" ##[ { \appoggiatura c8 d2 } #] - \test #"" ##[ { \acciaccatura c8 d2 } #] - \test #"" ##[ { c1 \afterGrace { b,16 c } d2 } #] +%% Chords and Notes +\test "" ##[ { ceses ces c cis cisis } #] % NoteEvent +\test "" ##[ { deses des d dis disis } #] +\test "" ##[ { eeses ees e eis eisis } #] +\test "" ##[ { feses fes f fis fisis } #] +\test "" ##[ { geses ges g gis gisis } #] +\test "" ##[ { aeses aes a ais aisis } #] +\test "" ##[ { beses bes b bis bisis } #] +\test "" ##[ { c,, d' } #] +\test "" ##[ { c' d'=' } #] +\test "" ##[ { c! c? } #] +\test "" ##[ r1.*4/3 #] % RestEvent +\test "" ##[ c1\rest #] % RestEvent +\test "" ##[ s2..*3/4 #] % SkipEvent +\test "" ##[ R1.*2/3 #] % MultiMeasureRestMusicGroup, MultiMeasureRestEvent +\test "" ##[ \skip 2.*3/4 #] % SkipMusic +\test "" ##[ < c\1 e\3 >4.*3/4-. #] % EventChord, NoteEvent, StringNumberEvent, ArticulationEvent - %% Clusters - \test #"" ##[ { \makeClusters { c4 g } } #] % ClusterNoteEvent +%% tags +\test "" ##[ { \tag #'foo { c4 d } } #] +\test "" ##[ c-\tag #'foo -\tag #'baz -^ -. #] - %% Figured bass - \test #"" ##[ \figures { < 6 > } #] % BassFigureEvent - \test #"" ##[ \figuremode { < 1-- 3- > < 2+ 4++ > < _! 7! > } #] - \test #"" ##[ \figuremode { < [6 > < 5] > } #] +%% Graces +\test "" ##[ { \grace c8 d2 } #] % GraceMusic +\test "" ##[ { \appoggiatura c8 d2 } #] +\test "" ##[ { \acciaccatura c8 d2 } #] +\test "" ##[ { c1 \afterGrace { b,16 c } d2 } #] - %% Lyrics - \test #"" ##[ \lyrics { a b } #] - \test #"" ##[ \lyricmode { a -- b } #] % HyphenEvent - \test #"" ##[ \lyricmode { a __ b } #] % ExtenderEvent - \test #"" ##[ \lyricmode { "a " } #] % LyricEvent - \test #"" ##[ \lyricsto "foo" { bla bla } #] % LyricCombineMusic - \test #"" ##[ { { c d } - \addlyrics { bla bla } } #] +%% Clusters +\test "" ##[ { \makeClusters { c4 g } } #] % ClusterNoteEvent - %% Drums - \test #"" ##[ \drums { hihat } #] - \test #"" ##[ \drummode { hihat4.*3/4 } #] +%% Figured bass +\test "" ##[ \figures { < 6 > } #] % BassFigureEvent +\test "" ##[ \figuremode { < 1-- 3- > < 2+ 4++ > < _! 7! > } #] +\test "" ##[ \figuremode { < [6 > < 5] > } #] + +%% Lyrics +\test "" ##[ \lyrics { a b } #] +\test "" ##[ \lyricmode { a -- b } #] % HyphenEvent +\test "" ##[ \lyricmode { a __ b } #] % ExtenderEvent +\test "" ##[ \lyricmode { "a " } #] % LyricEvent +\test "" ##[ \lyricsto "foo" { bla bla } #] % LyricCombineMusic +\test "" ##[ { { c d } + \addlyrics { bla bla } } #] - %% Expressive marks - \test #"" ##[ c4 ~ #] % TieEvent - \test #"" ##[ c\noBeam #] % BeamForbidEvent - \test #"" ##[ c\1 #] % StringNumberEvent - \test #"" ##[ { c: c:1 } #] % TremoloEvent - \test #"" ##[ { c-^ c^^ c_^ } #] % ArticulationEvent - \test #"" ##[ { c-+ c^+ c_+ } #] - \test #"" ##[ { c-- c^- c_- } #] - \test #"" ##[ { c-| c^| c_| } #] - \test #"" ##[ { c-> c^> c_> } #] - \test #"" ##[ { c-. c^. c_. } #] - \test #"" ##[ { c-_ c^_ c__ } #] - \test #"" ##[ { c-\trill c^\trill c_\trill } #] - \test #"" ##[ { c-1 c^2 c_3 } #] % FingerEvent - \test #"" ##[ { c-"foo" c^"foo" c_"foo" } #] % TextScriptEvent - \test #"" ##[ { R1*4 -"foo" R ^"foo" R _"foo" } #] % MultiMeasureTextEvent - \test #"" ##[ { c4-\harmonic c^\harmonic c_\harmonic } #] % HarmonicEvent - \test #"" ##[ { c-\glissando c^\glissando c_\glissando } #] % GlissandoEvent - \test #"" ##[ { c-\arpeggio c^\arpeggio c_\arpeggio } #] % ArpeggioEvent - \test #"" ##[ { c\p c^\ff c_\sfz } #] % AbsoluteDynamicEvent - \test #"" ##[ { c[ c] c^[ c^] c_[ c_] } #] % BeamEvent - \test #"" ##[ { c( c) c^( c^) c_( c_) } #] % SlurEvent - \test #"" ##[ { c\< c\! c^\< c^\! c_\< c_\! } #] % CrescendoEvent - \test #"" ##[ { c\> c\! c^\> c^\! c_\> c_\! } #] % DecrescendoEvent - \test #"" ##[ { c\( c\) c^\( c^\) c_\( c_\) } #] % PhrasingSlurEvent - \test #"" ##[ { c\sustainDown c\sustainUp } #] % SustainEvent - \test #"" ##[ { c\sostenutoDown c\sostenutoUp } #] % SostenutoEvent - \test #"" ##[ { c\melisma c\melismaEnd } #] % ManualMelismaEvent - \test #"" ##[ { c\startTextSpan c\stopTextSpan } #] % TextSpanEvent - \test #"" ##[ { c\startTrillSpan c\stopTrillSpan } #] % TrillSpanEvent - \test #"" ##[ { c \startStaff c \stopStaff } #] % StaffSpanEvent - \test #"" ##[ { c\startGroup c\stopGroup c^\startGroup c^\stopGroup c_\startGroup c_\stopGroup } #] % NoteGroupingEvent - \test #"" ##[ { c\unaCorda c\treCorde } #] % UnaCordaEvent - \test #"" ##[ \breathe #] - \test #"" ##[ { c \[ c \] } #] % LigatureEvent - \test #"" ##[ \~ #] % PesOrFlexaEvent +%% Drums +\test "" ##[ \drums { hihat } #] +\test "" ##[ \drummode { hihat4.*3/4 } #] - \test #"" ##[ \break #] - \test #"" ##[ \noBreak #] - \test #"" ##[ \pageBreak #] - \test #"" ##[ \noPageBreak #] - \test #"" ##[ \pageTurn #] - \test #"" ##[ \noPageTurn #] +%% Expressive marks +\test "" ##[ c4 ~ #] % TieEvent +\test "" ##[ c\noBeam #] % BeamForbidEvent +\test "" ##[ c\1 #] % StringNumberEvent +\test "" ##[ { c: c:1 } #] % TremoloEvent +\test "" ##[ { c-^ c^^ c_^ } #] % ArticulationEvent +\test "" ##[ { c-+ c^+ c_+ } #] +\test "" ##[ { c-- c^- c_- } #] +\test "" ##[ { c-| c^| c_| } #] +\test "" ##[ { c-> c^> c_> } #] +\test "" ##[ { c-. c^. c_. } #] +\test "" ##[ { c-_ c^_ c__ } #] +\test "" ##[ { c-\trill c^\trill c_\trill } #] +\test "" ##[ { c-1 c^2 c_3 } #] % FingerEvent +\test "" ##[ { c-"foo" c^"foo" c_"foo" } #] % TextScriptEvent +\test "" ##[ { R1*4-"foo" R^"foo" R_"foo" } #] % MultiMeasureTextEvent +\test "" ##[ { c4-\harmonic c^\harmonic c_\harmonic } #] % HarmonicEvent +\test "" ##[ { c-\glissando c^\glissando c_\glissando } #] % GlissandoEvent +\test "" ##[ { c-\arpeggio c^\arpeggio c_\arpeggio } #] % ArpeggioEvent +\test "" ##[ { c\p c^\ff c_\sfz } #] % AbsoluteDynamicEvent +\test "" ##[ { c[ c] c^[ c^] c_[ c_] } #] % BeamEvent +\test "" ##[ { c( c) c^( c^) c_( c_) } #] % SlurEvent +\test "" ##[ { c\< c\! c^\< c^\! c_\< c_\! } #] % CrescendoEvent +\test "" ##[ { c\> c\! c^\> c^\! c_\> c_\! } #] % DecrescendoEvent +\test "" ##[ { c\( c\) c^\( c^\) c_\( c_\) } #] % PhrasingSlurEvent +\test "" ##[ { c\sustainDown c\sustainUp } #] % SustainEvent +\test "" ##[ { c\sostenutoDown c\sostenutoUp } #] % SostenutoEvent +\test "" ##[ \melisma #] +\test "" ##[ \melismaEnd #] +\test "" ##[ { c\startTextSpan c\stopTextSpan } #] % TextSpanEvent +\test "" ##[ { c\startTrillSpan c\stopTrillSpan } #] % TrillSpanEvent +\test "" ##[ { c \startStaff c \stopStaff } #] % StaffSpanEvent +\test "" ##[ { c\startGroup c\stopGroup c^\startGroup c^\stopGroup c_\startGroup c_\stopGroup } #] % NoteGroupingEvent +\test "" ##[ { c\unaCorda c\treCorde } #] % UnaCordaEvent +\test "" ##[ \breathe #] +\test "" ##[ { c \[ c \] } #] % LigatureEvent +\test "" ##[ \~ #] % PesOrFlexaEvent - %% Checks - \test #"" ##[ \octave a' #] % RelativeOctaveCheck - \test #"" ##[ | #] % BarCheck +\test "" ##[ \break #] +\test "" ##[ \noBreak #] +\test "" ##[ \pageBreak #] +\test "" ##[ \noPageBreak #] +\test "" ##[ \pageTurn #] +\test "" ##[ \noPageTurn #] - %% Marks - \test #"" ##[ \mark \default #] % MarkEvent - \test #"" ##[ \mark "Allegro" #] - \test #"" ##[ \tempo 4 = 120 #] % MetronomeChangeEvent +%% Checks +\test "" ##[ \octave a' #] % RelativeOctaveCheck +\test "" ##[ | #] % BarCheck - %% key, time, clef, bar - \test #"" ##[ \key \default #] % KeyChangeEvent - \test #"" ##[ \key e \minor #] - \test #"" ##[ \clef "bass" #] - \test #"" ##[ \clef "french^2" #] - \test #"" ##[ \clef "alto_3" #] - \test #"" ##[ \time 2/4 #] - \test #"" ##[ #(set-time-signature 5 8 '(3 2)) #] - \test #"" ##[ \bar "|." #] +%% Marks +\test "" ##[ \mark \default #] % MarkEvent +\test "" ##[ \mark "Allegro" #] +\test "" ##[ \tempo 4 = 120 #] % MetronomeChangeEvent - %% staff switches - \test #"" ##[ \autochange { c d } #] % AutoChangeMusic - \test #"" ##[ { \change Staff = "up" { c d } } #] % ContextChange +%% key, time, clef, bar +\test "" ##[ \key \default #] % KeyChangeEvent +\test "" ##[ \key e \minor #] +\test "" ##[ \clef "bass" #] +\test "" ##[ \clef "french^2" #] +\test "" ##[ \clef "alto_3" #] +\test "" ##[ \time 2/4 #] +\test "" ##[ #(set-time-signature 5 8 '(3 2)) #] +\test "" ##[ \bar "|." #] - %% Tuplets - \test #"" ##[ \times 2/3 { c8 d e } #] % TimeScaledMusic - \test #"" ##[ \times 4/6 { c16 d e f g a } #] +%% staff switches +\test "" ##[ \autochange { c d } #] % AutoChangeMusic +\test "" ##[ { \change Staff = "up" { c d } } #] % ContextChange - %% \relative and \tranpose - \test #"NOT A BUG" ##[ \relative c' { c b } #] % RelativeOctaveMusic - \test #"NOT A BUG" ##[ \transpose c d { c d } #] % TransposedMusic - - %% Repeats - \test #"" ##[ \repeat volta 2 { c d } #] % VoltaRepeatedMusic - \test #"" ##[ \repeat unfold 2 { c d } #] % UnfoldedRepeatedMusic - \test #"" ##[ \repeat fold 2 { c d } #] % FoldedRepeatedMusic - \test #"" ##[ \repeat percent 2 { c d } #] % PercentRepeatedMusic - \test #"" ##[ \repeat tremolo 4 { c16 d } #] % TremoloRepeatedMusic - \test #"" ##[ \repeat volta 2 { c4 d } \alternative { { c d } { e f } } #] % +%% Tuplets +\test "" ##[ \times 2/3 { c8 d e } #] % TimeScaledMusic +\test "" ##[ \times 4/6 { c16 d e f g a } #] +%} +%% \relative and \tranpose +\test #"NOT A BUG" ##[ \relative c' { c b } #] % RelativeOctaveMusic +\test #"NOT A BUG" ##[ \transpose c d { c d } #] % TransposedMusic +%} +%% Repeats +\test "" ##[ \repeat volta 2 { c d } #] % VoltaRepeatedMusic +\test "" ##[ \repeat unfold 2 { c d } #] % UnfoldedRepeatedMusic +\test "" ##[ \repeat fold 2 { c d } #] % FoldedRepeatedMusic +\test "" ##[ \repeat percent 2 { c d } #] % PercentRepeatedMusic +\test "" ##[ \repeat tremolo 4 { c16 d } #] % TremoloRepeatedMusic +\test "" ##[ \repeat volta 2 { c4 d } \alternative { { c d } { e f } } #] % - %% Context creation - \test #"" ##[ \new Staff { c d } #] % ContextSpeccedMusic - \test #"" ##[ \new Staff = "up" { c d } #] % ContextSpeccedMusic - \test #"" ##[ \context Staff { c d } #] - \test #"" ##[ \context Staff = "up" { c d } #] - \test #"" ##[ +%% Context creation +\test "" ##[ \new Staff { c d } #] % ContextSpeccedMusic +\test "" ##[ \new Staff = "up" { c d } #] % ContextSpeccedMusic +\test "" ##[ \context Staff { c d } #] +\test "" ##[ \context Staff = "up" { c d } #] +\test "" ##[ \new Staff \with { \consists "Timing_engraver" \remove "Clef_engraver" } { c d } #] - %% Context properties - \test #"" ##[ \once \set Score . skipBars = ##t #] % PropertySet - \test #"" ##[ \set autoBeaming = ##f #] - \test #"" ##[ \unset Score . skipBars #] % PropertyUnset - \test #"" ##[ \unset autoBeaming #] - %% Layout properties - \test #"" ##[ \override Staff . Stem #'thickness = #4.0 #] % OverrideProperty - \test #"" ##[ \once \override Beam #'thickness = #0.6 #] - \test #"" ##[ \revert Staff . Stem #'thickness #] % RevertProperty - \test #"" ##[ \revert Beam #'thickness #] +%% Context properties +\test "" ##[ \once \set Score . skipBars = ##t #] % PropertySet +\test "" ##[ \set autoBeaming = ##f #] +\test "" ##[ \unset Score . skipBars #] % PropertyUnset +\test "" ##[ \unset autoBeaming #] +%% Layout properties +\test "" ##[ \override Staff . Stem #'thickness = #4.0 #] % OverrideProperty +\test "" ##[ \once \override Beam #'thickness = #0.6 #] +\test "" ##[ \revert Staff . Stem #'thickness #] % RevertProperty +\test "" ##[ \revert Beam #'thickness #] - %% \applyOutput - \test #"" ##[ \applyOutput #'Foo #(lambda (arg) (list)) #] - %% \applyContext - \test #"" ##[ \applyContext #(lambda (arg) (list)) #] +%% \applyOutput +\test "" ##[ \applyOutput #'Foo #(lambda (arg) (list)) #] +%% \applyContext +\test "" ##[ \applyContext #(lambda (arg) (list)) #] - %% \partial - \test #"" ##[ \partial 2 #] - \test #"" ##[ \partial 8. #] - \test #"TODO? exotic durations in \\partial" ##[ \partial 4*2/3 #] +%% \partial +\test "" ##[ \partial 2 #] +\test "" ##[ \partial 8. #] +\test #"TODO? exotic durations in \\partial" ##[ \partial 4*2/3 #] - %% \partcombine - \test #"" ##[ \partcombine { c e } +%% \partcombine +\test "" ##[ \partcombine { c e } { d f } #] % PartCombineMusic UnrelativableMusic - %% Cue notes - \test #"" ##[ \cueDuring #"foo" #1 { c d } #] - \test #"" ##[ \quoteDuring #"foo" { c d } #] - -} - +%% Cue notes +\test "" ##[ \cueDuring #"foo" #1 { c d } #] +\test "" ##[ \quoteDuring #"foo" { c d } #] diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index a1fafa63e3..35cf74296e 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -9,13 +9,7 @@ %% need SRFI-1 filter -#(use-modules (srfi srfi-1)) -%% FIXME: guile-1.7 required? -%#(use-modules (scm display-lily))invalid module name for use-syntax ((srfi srfi-39)) - -#(use-modules (scm display-lily)) -#(display-lily-init parser) - +#(use-modules (srfi srfi-1)) acciaccatura = #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic) @@ -165,16 +159,20 @@ cueDuring = 'quoted-voice-direction dir 'origin location)) +%% The following causes an error with guile 1.6.8 (guile 1.6.7 and 1.8.x are fine) +#(use-modules (scm display-lily)) displayLilyMusic = #(define-music-function (parser location music) (ly:music?) - (display-lily-music music) + (newline) + (display-lily-music music parser) music) displayMusic = #(define-music-function (parser location music) (ly:music?) - (display-scheme-music music) - music) + (newline) + (display-scheme-music music) + music) featherDurations= #(define-music-function (parser location factor argument) (ly:moment? ly:music?) diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index d884cc36c9..66beb27cea 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -11,12 +11,6 @@ (define-module (scm display-lily)) -;;; `display-lily-init' must be called before using `display-lily-music'. It -;;; takes a parser object as an argument. -(define-public (display-lily-init parser) - (*parser* parser) - #t) - ;;; ;;; Scheme forms ;;; @@ -87,13 +81,13 @@ (if (and (car alist) (test item (cdar alist))) (set! result (car alist))))) -(define (note-name->lily-string ly-pitch) +(define (note-name->lily-string ly-pitch parser) ;; here we define a custom pitch= function, since we do not want to ;; test whether octaves are also equal. (otherwise, we would be using equal?) (define (pitch= pitch1 pitch2) (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2)) (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2)))) - (let ((result (rassoc ly-pitch (ly:parser-lookup (*parser*) 'pitchnames) pitch=))) + (let ((result (rassoc ly-pitch (ly:parser-lookup parser 'pitchnames) pitch=))) (if result (car result) #f))) @@ -157,7 +151,6 @@ 'TremoloEvent 'SustainEvent 'SostenutoEvent - 'ManualMelismaEvent 'TextSpanEvent 'HarmonicEvent 'BeamForbidEvent @@ -190,25 +183,25 @@ ,str-start ,str-stop)))) -(define-display-method HyphenEvent (event) +(define-display-method HyphenEvent (event parser) " --") -(define-display-method ExtenderEvent (event) +(define-display-method ExtenderEvent (event parser) " __") -(define-display-method TieEvent (event) +(define-display-method TieEvent (event parser) " ~") -(define-display-method BeamForbidEvent (event) +(define-display-method BeamForbidEvent (event parser) "\\noBeam") -(define-display-method StringNumberEvent (event) +(define-display-method StringNumberEvent (event parser) (format #f "\\~a" (ly:music-property event 'string-number))) -(define-display-method TremoloEvent (event) +(define-display-method TremoloEvent (event parser) (let ((tremolo-type (ly:music-property event 'tremolo-type))) (format #f ":~a" (if (= 0 tremolo-type) "" tremolo-type)))) -(define-post-event-display-method ArticulationEvent (event) #t +(define-post-event-display-method ArticulationEvent (event parser) #t (let ((articulation (ly:music-property event 'articulation-type))) (case (string->symbol articulation) ((marcato) "^") @@ -220,48 +213,47 @@ ((portato) "_") (else (format #f "\\~a" articulation))))) -(define-post-event-display-method FingeringEvent (event) #t +(define-post-event-display-method FingeringEvent (event parser) #t (ly:music-property event 'digit)) -(define-post-event-display-method TextScriptEvent (event) #t +(define-post-event-display-method TextScriptEvent (event parser) #t (markup->lily-string (ly:music-property event 'text))) -(define-post-event-display-method MultiMeasureTextEvent (event) #t +(define-post-event-display-method MultiMeasureTextEvent (event parser) #t (markup->lily-string (ly:music-property event 'text))) -(define-post-event-display-method HarmonicEvent (event) #t "\\harmonic") -(define-post-event-display-method GlissandoEvent (event) #t "\\glissando") -(define-post-event-display-method ArpeggioEvent (event) #t "\\arpeggio") -(define-post-event-display-method AbsoluteDynamicEvent (event) #f +(define-post-event-display-method HarmonicEvent (event parser) #t "\\harmonic") +(define-post-event-display-method GlissandoEvent (event parser) #t "\\glissando") +(define-post-event-display-method ArpeggioEvent (event parser) #t "\\arpeggio") +(define-post-event-display-method AbsoluteDynamicEvent (event parser) #f (format #f "\\~a" (ly:music-property event 'text))) -(define-span-event-display-method BeamEvent (event) #f "[" "]") -(define-span-event-display-method SlurEvent (event) #f "(" ")") -(define-span-event-display-method CrescendoEvent (event) #f "\\<" "\\!") -(define-span-event-display-method DecrescendoEvent (event) #f "\\>" "\\!") -(define-span-event-display-method PhrasingSlurEvent (event) #f "\\(" "\\)") -(define-span-event-display-method SustainEvent (event) #f "\\sustainDown" "\\sustainUp") -(define-span-event-display-method SostenutoEvent (event) #f "\\sostenutoDown" "\\sostenutoUp") -(define-span-event-display-method ManualMelismaEvent (event) #f "\\melisma" "\\melismaEnd") -(define-span-event-display-method TextSpanEvent (event) #f "\\startTextSpan" "\\stopTextSpan") -(define-span-event-display-method TrillSpanEvent (event) #f "\\startTrillSpan" "\\stopTrillSpan") -(define-span-event-display-method StaffSpanEvent (event) #f "\\startStaff" "\\stopStaff") -(define-span-event-display-method NoteGroupingEvent (event) #f "\\startGroup" "\\stopGroup") -(define-span-event-display-method UnaCordaEvent (event) #f "\\unaCorda" "\\treCorde") +(define-span-event-display-method BeamEvent (event parser) #f "[" "]") +(define-span-event-display-method SlurEvent (event parser) #f "(" ")") +(define-span-event-display-method CrescendoEvent (event parser) #f "\\<" "\\!") +(define-span-event-display-method DecrescendoEvent (event parser) #f "\\>" "\\!") +(define-span-event-display-method PhrasingSlurEvent (event parser) #f "\\(" "\\)") +(define-span-event-display-method SustainEvent (event parser) #f "\\sustainDown" "\\sustainUp") +(define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoDown" "\\sostenutoUp") +(define-span-event-display-method TextSpanEvent (event parser) #f "\\startTextSpan" "\\stopTextSpan") +(define-span-event-display-method TrillSpanEvent (event parser) #f "\\startTrillSpan" "\\stopTrillSpan") +(define-span-event-display-method StaffSpanEvent (event parser) #f "\\startStaff" "\\stopStaff") +(define-span-event-display-method NoteGroupingEvent (event parser) #f "\\startGroup" "\\stopGroup") +(define-span-event-display-method UnaCordaEvent (event parser) #f "\\unaCorda" "\\treCorde") ;;; ;;; Graces ;;; -(define-display-method GraceMusic (expr) +(define-display-method GraceMusic (expr parser) (format #f "\\grace ~a" - (music->lily-string (ly:music-property expr 'element)))) + (music->lily-string (ly:music-property expr 'element) parser))) ;; \acciaccatura \appoggiatura \grace ;; TODO: it would be better to compare ?start and ?stop ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic, ;; using a custom music equality predicate. -(define-extra-display-method GraceMusic (expr) +(define-extra-display-method GraceMusic (expr parser) "Display method for appoggiatura." (with-music-match (expr (music 'GraceMusic @@ -293,10 +285,10 @@ (music 'SlurEvent span-direction STOP)))))) - (format #f "\\appoggiatura ~a" (music->lily-string ?music)))))) + (format #f "\\appoggiatura ~a" (music->lily-string ?music parser)))))) -(define-extra-display-method GraceMusic (expr) +(define-extra-display-method GraceMusic (expr parser) "Display method for acciaccatura." (with-music-match (expr (music 'GraceMusic @@ -341,9 +333,9 @@ (music 'SlurEvent span-direction STOP)))))) - (format #f "\\acciaccatura ~a" (music->lily-string ?music)))))) + (format #f "\\acciaccatura ~a" (music->lily-string ?music parser)))))) -(define-extra-display-method GraceMusic (expr) +(define-extra-display-method GraceMusic (expr parser) "Display method for grace." (with-music-match (expr (music 'GraceMusic @@ -356,13 +348,13 @@ ;; startGraceMusic stopGraceMusic (and (null? (ly:music-property ?start 'elements)) (null? (ly:music-property ?stop 'elements)) - (format #f "\\grace ~a" (music->lily-string ?music))))) + (format #f "\\grace ~a" (music->lily-string ?music parser))))) ;;; ;;; Music sequences ;;; -(define-display-method SequentialMusic (seq) +(define-display-method SequentialMusic (seq parser) (let ((force-line-break (and (*force-line-break*) ;; hm (> (length (ly:music-property seq 'elements)) @@ -405,16 +397,20 @@ (if force-line-break 1 0) (if force-line-break (+ 2 (*indent*)) 1) (parameterize ((*indent* (+ 2 (*indent*)))) - (map-in-order music->lily-string elements)) + (map-in-order (lambda (music) + (music->lily-string music parser)) + elements)) (if force-line-break 1 0) (if force-line-break (*indent*) 0)))) -(define-display-method SimultaneousMusic (sim) +(define-display-method SimultaneousMusic (sim parser) (parameterize ((*indent* (+ 3 (*indent*)))) (format #f "<< ~{~a ~}>>" - (map-in-order music->lily-string (ly:music-property sim 'elements))))) + (map-in-order (lambda (music) + (music->lily-string music parser)) + (ly:music-property sim 'elements))))) -(define-extra-display-method SimultaneousMusic (expr) +(define-extra-display-method SimultaneousMusic (expr parser) "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\". Otherwise, return #f." ;; TODO: do something with afterGraceFraction? @@ -425,14 +421,14 @@ Otherwise, return #f." (music 'GraceMusic element ?grace)))))) (format #f "\\afterGrace ~a ~a" - (music->lily-string ?before-grace) - (music->lily-string ?grace)))) + (music->lily-string ?before-grace parser) + (music->lily-string ?grace parser)))) ;;; ;;; Chords ;;; -(define-display-method EventChord (chord) +(define-display-method EventChord (chord parser) ;; event_chord : simple_element post_events ;; | command_element ;; | note_chord_element @@ -446,23 +442,25 @@ Otherwise, return #f." 'NoteEvent 'ClusterNoteEvent 'RestEvent 'MultiMeasureRestEvent 'SkipEvent 'LyricEvent) elements))) - (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingSignEvent) (car elements)) + (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingEvent) (car elements)) ;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff) - ;; and BreathingSignEvent (\breathe) - (music->lily-string (car elements)) + ;; and BreathingEvent (\breathe) + (music->lily-string (car elements) parser) (if (and (not (null? simple-elements)) (null? (cdr simple-elements))) ;; simple_element : note | figure | rest | mmrest | lyric_element | skip (let* ((simple-element (car simple-elements)) (duration (ly:music-property simple-element 'duration)) (lily-string (format #f "~a~a~a~{~a ~}" - (music->lily-string simple-element) + (music->lily-string simple-element parser) (duration->lily-string duration) (if (and ((make-music-type-predicate 'RestEvent) simple-element) (ly:pitch? (ly:music-property simple-element 'pitch))) "\\rest" "") - (map-in-order music->lily-string (filter post-event? elements))))) + (map-in-order (lambda (music) + (music->lily-string music parser)) + (filter post-event? elements))))) (*previous-duration* duration) lily-string) (let ((chord-elements (filter (make-music-type-predicate @@ -472,34 +470,41 @@ Otherwise, return #f." (if (not (null? chord-elements)) ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events (let ((lily-string (format #f "< ~{~a ~}>~a~{~a ~}" - (map-in-order music->lily-string chord-elements) + (map-in-order (lambda (music) + (music->lily-string music parser)) + chord-elements) (duration->lily-string (ly:music-property (car chord-elements) 'duration)) - (map-in-order music->lily-string post-events)))) + (map-in-order (lambda (music) + (music->lily-string music parser)) + post-events)))) (*previous-duration* (ly:music-property (car chord-elements) 'duration)) lily-string) ;; command_element - (format #f "~{~a ~}" (map-in-order music->lily-string elements)))))))) + (format #f "~{~a ~}" (map-in-order (lambda (music) + (music->lily-string music parser)) + elements)))))))) -(define-display-method MultiMeasureRestMusic (mmrest) +(define-display-method MultiMeasureRestMusic (mmrest parser) (let* ((dur (ly:music-property mmrest 'duration)) (ly (format #f "R~a~{~a ~}" (duration->lily-string dur) - (map-in-order music->lily-string + (map-in-order (lambda (music) + (music->lily-string music parser)) (ly:music-property mmrest 'articulations))))) (*previous-duration* dur) ly)) -(define-display-method SkipMusic (skip) +(define-display-method SkipMusic (skip parser) (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t))) ;;; ;;; Notes, rests, skips... ;;; -(define (simple-note->lily-string event) +(define (simple-note->lily-string event parser) (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations - (note-name->lily-string (ly:music-property event 'pitch)) + (note-name->lily-string (ly:music-property event 'pitch) parser) (octave->lily-string (ly:music-property event 'pitch)) (let ((forced (ly:music-property event 'force-accidental)) (cautionary (ly:music-property event 'cautionary))) @@ -518,42 +523,39 @@ Otherwise, return #f." (make-string (1- (* -1 octave-check)) #\,)) (else ""))) "")) - (map-in-order music->lily-string (ly:music-property event 'articulations)))) + (map-in-order (lambda (event) + (music->lily-string event parser)) + (ly:music-property event 'articulations)))) -(define-display-method NoteEvent (note) +(define-display-method NoteEvent (note parser) (cond ((not (null? (ly:music-property note 'pitch))) ;; note - (simple-note->lily-string note)) + (simple-note->lily-string note parser)) ((not (null? (ly:music-property note 'drum-type))) ;; drum (format #f "~a" (ly:music-property note 'drum-type))) (else ;; unknown? ""))) -(define-display-method ClusterNoteEvent (note) - (simple-note->lily-string note)) +(define-display-method ClusterNoteEvent (note parser) + (simple-note->lily-string note parser)) -(define-display-method RestEvent (rest) +(define-display-method RestEvent (rest parser) (if (not (null? (ly:music-property rest 'pitch))) - (simple-note->lily-string rest) + (simple-note->lily-string rest parser) "r")) -(define-display-method MultiMeasureRestEvent (rest) +(define-display-method MultiMeasureRestEvent (rest parser) "R") -(define-display-method SkipEvent (rest) +(define-display-method SkipEvent (rest parser) "s") -(define-display-method MarkEvent (mark) +(define-display-method MarkEvent (mark parser) (let ((label (ly:music-property mark 'label))) (if (null? label) "\\mark \\default" (format #f "\\mark ~a" (markup->lily-string label))))) -(define-display-method MetronomeChangeEvent (tempo) - (format #f "\\tempo ~a = ~a" - (duration->lily-string (ly:music-property tempo 'tempo-unit) #:force-duration #t #:prev-duration #f) - (ly:music-property tempo 'metronome-count))) - -(define-display-method KeyChangeEvent (key) +(define-display-method KeyChangeEvent (key parser) (let ((pitch-alist (ly:music-property key 'pitch-alist)) (tonic (ly:music-property key 'tonic))) (if (or (null? pitch-alist) @@ -562,36 +564,36 @@ Otherwise, return #f." (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist (ly:pitch-diff (ly:make-pitch 0 0 0) tonic)))) (format #f "\\key ~a \\~a~a" - (note-name->lily-string (ly:music-property key 'tonic)) + (note-name->lily-string (ly:music-property key 'tonic) parser) (any (lambda (mode) - (if (and (*parser*) - (equal? (ly:parser-lookup (*parser*) mode) c-pitch-alist)) + (if (and parser + (equal? (ly:parser-lookup parser mode) c-pitch-alist)) (symbol->string mode) #f)) '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian)) (new-line->lily-string)))))) -(define-display-method RelativeOctaveCheck (octave) +(define-display-method RelativeOctaveCheck (octave parser) (let ((pitch (ly:music-property octave 'pitch))) (format #f "\\octave ~a~a" - (note-name->lily-string pitch) + (note-name->lily-string pitch parser) (octave->lily-string pitch)))) -(define-display-method VoiceSeparator (sep) +(define-display-method VoiceSeparator (sep parser) "\\\\") -(define-display-method LigatureEvent (ligature) +(define-display-method LigatureEvent (ligature parser) (if (= START (ly:music-property ligature 'span-direction)) "\\[" "\\]")) -(define-display-method BarCheck (check) +(define-display-method BarCheck (check parser) (format #f "|~a" (new-line->lily-string))) -(define-display-method PesOrFlexaEvent (expr) +(define-display-method PesOrFlexaEvent (expr parser) "\\~") -(define-display-method BassFigureEvent (figure) +(define-display-method BassFigureEvent (figure parser) (let ((alteration (ly:music-property figure 'alteration)) (fig (ly:music-property figure 'figure)) (bracket-start (ly:music-property figure 'bracket-start)) @@ -612,7 +614,7 @@ Otherwise, return #f." (else ""))) (if (null? bracket-stop) "" "]")))) -(define-display-method LyricEvent (lyric) +(define-display-method LyricEvent (lyric parser) (let ((text (ly:music-property lyric 'text))) (if (or (string? text) (eqv? (first text) simple-markup)) @@ -626,25 +628,25 @@ Otherwise, return #f." string)) (markup->lily-string text)))) -(define-display-method BreathingSignEvent (event) +(define-display-method BreathingEvent (event parser) "\\breathe") ;;; ;;; Staff switches ;;; -(define-display-method AutoChangeMusic (m) +(define-display-method AutoChangeMusic (m parser) (format #f "\\autochange ~a" - (music->lily-string (ly:music-property m 'element)))) + (music->lily-string (ly:music-property m 'element) parser))) -(define-display-method ContextChange (m) +(define-display-method ContextChange (m parser) (format #f "\\change ~a = \"~a\"" (ly:music-property m 'change-to-type) (ly:music-property m 'change-to-id))) ;;; -(define-display-method TimeScaledMusic (times) +(define-display-method TimeScaledMusic (times parser) (let* ((num (ly:music-property times 'numerator)) (den (ly:music-property times 'denominator)) (nd-gcd (gcd num den))) @@ -654,42 +656,44 @@ Otherwise, return #f." (format #f "\\times ~a/~a ~a" num den - (music->lily-string (ly:music-property times 'element)))))) + (music->lily-string (ly:music-property times 'element) parser))))) -(define-display-method RelativeOctaveMusic (m) - (music->lily-string (ly:music-property m 'element))) +(define-display-method RelativeOctaveMusic (m parser) + (music->lily-string (ly:music-property m 'element) parser)) -(define-display-method TransposedMusic (m) - (music->lily-string (ly:music-property m 'element))) +(define-display-method TransposedMusic (m parser) + (music->lily-string (ly:music-property m 'element) parser)) ;;; ;;; Repeats ;;; -(define (repeat->lily-string expr repeat-type) +(define (repeat->lily-string expr repeat-type parser) (format #f "\\repeat ~a ~a ~a ~a" repeat-type (ly:music-property expr 'repeat-count) - (music->lily-string (ly:music-property expr 'element)) + (music->lily-string (ly:music-property expr 'element) parser) (let ((alternatives (ly:music-property expr 'elements))) (if (null? alternatives) "" (format #f "\\alternative { ~{~a ~}}" - (map-in-order music->lily-string alternatives)))))) + (map-in-order (lambda (music) + (music->lily-string music parser)) + alternatives)))))) -(define-display-method VoltaRepeatedMusic (expr) - (repeat->lily-string expr "volta")) +(define-display-method VoltaRepeatedMusic (expr parser) + (repeat->lily-string expr "volta" parser)) -(define-display-method UnfoldedRepeatedMusic (expr) - (repeat->lily-string expr "unfold")) +(define-display-method UnfoldedRepeatedMusic (expr parser) + (repeat->lily-string expr "unfold" parser)) -(define-display-method FoldedRepeatedMusic (expr) - (repeat->lily-string expr "fold")) +(define-display-method FoldedRepeatedMusic (expr parser) + (repeat->lily-string expr "fold" parser)) -(define-display-method PercentRepeatedMusic (expr) - (repeat->lily-string expr "percent")) +(define-display-method PercentRepeatedMusic (expr parser) + (repeat->lily-string expr "percent" parser)) -(define-display-method TremoloRepeatedMusic (expr) +(define-display-method TremoloRepeatedMusic (expr parser) (let* ((count (ly:music-property expr 'repeat-count)) (dots (if (= 0 (modulo count 3)) 0 1)) (shift (- (log2 (if (= 0 dots) @@ -718,15 +722,15 @@ Otherwise, return #f." element) (format #f "\\repeat tremolo ~a ~a" count - (music->lily-string element)))) + (music->lily-string element parser)))) ;;; ;;; Contexts ;;; -(define-display-method ContextSpeccedMusic (expr) +(define-display-method ContextSpeccedMusic (expr parser) (let ((id (ly:music-property expr 'context-id)) - (create-new (ly:music-property expr 'create-new)) + (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))) @@ -750,12 +754,12 @@ Otherwise, return #f." (reverse operations))) (*indent*))) (parameterize ((*current-context* ctype)) - (music->lily-string music))))) + (music->lily-string music parser))))) ;; special cases: \figures \lyrics \drums -(define-extra-display-method ContextSpeccedMusic (expr) +(define-extra-display-method ContextSpeccedMusic (expr parser) (with-music-match (expr (music 'ContextSpeccedMusic - create-new #t + create-new #t property-operations ?op context-type ?context-type element ?sequence)) @@ -763,18 +767,18 @@ Otherwise, return #f." (parameterize ((*explicit-mode* #f)) (case ?context-type ((FiguredBass) - (format #f "\\figures ~a" (music->lily-string ?sequence))) + (format #f "\\figures ~a" (music->lily-string ?sequence parser))) ((Lyrics) - (format #f "\\lyrics ~a" (music->lily-string ?sequence))) + (format #f "\\lyrics ~a" (music->lily-string ?sequence parser))) ((DrumStaff) - (format #f "\\drums ~a" (music->lily-string ?sequence))) + (format #f "\\drums ~a" (music->lily-string ?sequence parser))) (else #f))) #f))) ;;; Context properties -(define-extra-display-method ContextSpeccedMusic (expr) +(define-extra-display-method ContextSpeccedMusic (expr parser) (let ((element (ly:music-property expr 'element)) (property-tuning? (make-music-type-predicate 'PropertySet 'PropertyUnset @@ -786,12 +790,12 @@ Otherwise, return #f." (and (sequence? element) (every property-tuning? (ly:music-property element 'elements))))) (parameterize ((*current-context* (ly:music-property expr 'context-type))) - (music->lily-string element)) + (music->lily-string element parser)) #f))) -(define (property-value->lily-string arg) +(define (property-value->lily-string arg parser) (cond ((ly:music? arg) - (music->lily-string arg)) + (music->lily-string arg parser)) ((string? arg) (format #f "#~s" arg)) ((markup? arg) @@ -799,7 +803,7 @@ Otherwise, return #f." (else (format #f "#~a" (scheme-expr->lily-string arg))))) -(define-display-method PropertySet (expr) +(define-display-method PropertySet (expr parser) (let ((property (ly:music-property expr 'symbol)) (value (ly:music-property expr 'value)) (once (ly:music-property expr 'once))) @@ -811,10 +815,10 @@ Otherwise, return #f." "" (format #f "~a . " (*current-context*))) property - (property-value->lily-string value) + (property-value->lily-string value parser) (new-line->lily-string)))) -(define-display-method PropertyUnset (expr) +(define-display-method PropertyUnset (expr parser) (format #f "\\unset ~a~a~a" (if (eqv? (*current-context*) 'Bottom) "" @@ -824,7 +828,7 @@ Otherwise, return #f." ;;; Layout properties -(define-display-method OverrideProperty (expr) +(define-display-method OverrideProperty (expr parser) (let ((symbol (ly:music-property expr 'symbol)) (properties (ly:music-property expr 'grob-property-path)) (value (ly:music-property expr 'grob-value)) @@ -841,10 +845,10 @@ Otherwise, return #f." (if (null? (cdr properties)) (car properties) properties) - (property-value->lily-string value) + (property-value->lily-string value parser) (new-line->lily-string)))) -(define-display-method RevertProperty (expr) +(define-display-method RevertProperty (expr parser) (let ((symbol (ly:music-property expr 'symbol)) (properties (ly:music-property expr 'grob-property-path))) (format #f "\\revert ~a~a #'~a~a" @@ -857,13 +861,46 @@ Otherwise, return #f." properties) (new-line->lily-string)))) +;;; \melisma and \melismaEnd +(define-extra-display-method ContextSpeccedMusic (expr parser) + "If expr is a melisma, return \"\\melisma\", otherwise, return #f." + (with-music-match (expr (music 'ContextSpeccedMusic + element (music 'PropertySet + value #t + symbol 'melismaBusy))) + "\\melisma")) + +(define-extra-display-method ContextSpeccedMusic (expr parser) + "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f." + (with-music-match (expr (music 'ContextSpeccedMusic + element (music 'PropertyUnset + symbol 'melismaBusy))) + "\\melismaEnd")) + +;;; \tempo +(define-extra-display-method ContextSpeccedMusic (expr parser) + "If expr is a tempo, return \"\\tempo x = nnn\", otherwise return #f." + (with-music-match (expr (music 'ContextSpeccedMusic + element (music 'SequentialMusic + elements ((music 'PropertySet + symbol 'tempoWholesPerMinute) + (music 'PropertySet + value ?unit-duration + symbol 'tempoUnitDuration) + (music 'PropertySet + value ?unit-count + symbol 'tempoUnitCount))))) + (format #f "\\tempo ~a = ~a" + (duration->lily-string ?unit-duration #:force-duration #t) + ?unit-count))) + ;;; \clef (define clef-name-alist (map (lambda (name+vals) (cons (cdr name+vals) (car name+vals))) supported-clefs)) -(define-extra-display-method ContextSpeccedMusic (expr) +(define-extra-display-method ContextSpeccedMusic (expr parser) "If `expr' is a clef change, return \"\\clef ...\" Otherwise, return #f." (with-music-match (expr (music 'ContextSpeccedMusic @@ -895,7 +932,7 @@ Otherwise, return #f." #f)))) ;;; \time -(define-extra-display-method ContextSpeccedMusic (expr) +(define-extra-display-method ContextSpeccedMusic (expr parser) "If `expr' is a time signature set, return \"\\time ...\". Otherwise, return #f." (with-music-match (expr (music @@ -925,14 +962,14 @@ Otherwise, return #f." (car ?num+den) (cdr ?num+den) ?grouping (new-line->lily-string))))) ;;; \bar -(define-extra-display-method ContextSpeccedMusic (expr) +(define-extra-display-method ContextSpeccedMusic (expr parser) "If `expr' is a bar, return \"\\bar ...\". Otherwise, return #f." (with-music-match (expr (music 'ContextSpeccedMusic - context-type 'Timing - element (music 'PropertySet - value ?bar-type - symbol 'whichBar))) + context-type 'Timing + element (music 'PropertySet + value ?bar-type + symbol 'whichBar))) (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string)))) ;;; \partial @@ -957,11 +994,11 @@ Otherwise, return #f." (list 0 1 2 3 4)))) (define (moment->duration moment) - (let ((result (assoc (- moment) moment-duration-alist))) + (let ((result (assoc (- moment) moment-duration-alist =))) (and result (cdr result)))) -(define-extra-display-method ContextSpeccedMusic (expr) +(define-extra-display-method ContextSpeccedMusic (expr parser) "If `expr' is a partial measure, return \"\\partial ...\". Otherwise, return #f." (with-music-match (expr (music @@ -975,22 +1012,23 @@ Otherwise, return #f." symbol 'measurePosition)))) (let ((duration (moment->duration (/ (ly:moment-main-numerator ?moment) (ly:moment-main-denominator ?moment))))) - (and duration (format #f "\\partial ~a" (duration->lily-string duration #:force-duration #t)))))) + (and duration (format #f "\\partial ~a" (duration->lily-string duration + #:force-duration #t)))))) ;;; ;;; -(define-display-method ApplyOutputEvent (applyoutput) +(define-display-method ApplyOutputEvent (applyoutput parser) (let ((proc (ly:music-property applyoutput 'procedure)) - (ctx (ly:music-property applyoutput 'context-type))) + (ctx (ly:music-property applyoutput 'context-type))) (format #f "\\applyOutput #'~a #~a" - ctx + ctx (or (procedure-name proc) (with-output-to-string (lambda () (pretty-print (procedure-source proc)))))))) -(define-display-method ApplyContext (applycontext) +(define-display-method ApplyContext (applycontext parser) (let ((proc (ly:music-property applycontext 'procedure))) (format #f "\\applyContext #~a" (or (procedure-name proc) @@ -999,11 +1037,13 @@ Otherwise, return #f." (pretty-print (procedure-source proc)))))))) ;;; \partcombine -(define-display-method PartCombineMusic (expr) +(define-display-method PartCombineMusic (expr parser) (format #f "\\partcombine ~{~a ~}" - (map-in-order music->lily-string (ly:music-property expr 'elements)))) + (map-in-order (lambda (music) + (music->lily-string music parser)) + (ly:music-property expr 'elements)))) -(define-extra-display-method PartCombineMusic (expr) +(define-extra-display-method PartCombineMusic (expr parser) (with-music-match (expr (music 'PartCombineMusic elements ((music 'UnrelativableMusic element (music 'ContextSpeccedMusic @@ -1016,15 +1056,15 @@ Otherwise, return #f." context-type 'Voice element ?sequence2))))) (format #f "\\partcombine ~a~a~a" - (music->lily-string ?sequence1) + (music->lily-string ?sequence1 parser) (new-line->lily-string) - (music->lily-string ?sequence2)))) + (music->lily-string ?sequence2 parser)))) -(define-display-method UnrelativableMusic (expr) - (music->lily-string (ly:music-property expr 'element))) +(define-display-method UnrelativableMusic (expr parser) + (music->lily-string (ly:music-property expr 'element) parser)) ;;; Cue notes -(define-display-method QuoteMusic (expr) +(define-display-method QuoteMusic (expr parser) (or (with-music-match (expr (music 'QuoteMusic quoted-voice-direction ?quoted-voice-direction @@ -1035,45 +1075,45 @@ Otherwise, return #f." (format #f "\\cueDuring #~s #~a ~a" ?quoted-music-name ?quoted-voice-direction - (music->lily-string ?music))) + (music->lily-string ?music parser))) (format #f "\\quoteDuring #~s ~a" (ly:music-property expr 'quoted-music-name) - (music->lily-string (ly:music-property expr 'element))))) + (music->lily-string (ly:music-property expr 'element) parser)))) ;;; ;;; Breaks ;;; -(define-display-method LineBreakEvent (expr) +(define-display-method LineBreakEvent (expr parser) (if (null? (ly:music-property expr 'break-permission)) "\\noBreak" "\\break")) -(define-display-method PageBreakEvent (expr) +(define-display-method PageBreakEvent (expr parser) (if (null? (ly:music-property expr 'break-permission)) "\\noPageBreak" "\\pageBreak")) -(define-display-method PageTurnEvent (expr) +(define-display-method PageTurnEvent (expr parser) (if (null? (ly:music-property expr 'break-permission)) "\\noPageTurn" "\\pageTurn")) -(define-extra-display-method EventChord (expr) +(define-extra-display-method EventChord (expr parser) (with-music-match (expr (music 'EventChord - elements ((music 'LineBreakEvent - break-permission 'force) - (music 'PageBreakEvent - break-permission 'force)))) + elements ((music 'LineBreakEvent + break-permission 'force) + (music 'PageBreakEvent + break-permission 'force)))) "\\pageBreak")) -(define-extra-display-method EventChord (expr) +(define-extra-display-method EventChord (expr parser) (with-music-match (expr (music 'EventChord - elements ((music 'LineBreakEvent - break-permission 'force) - (music 'PageBreakEvent - break-permission 'force) - (music 'PageTurnEvent - break-permission 'force)))) + elements ((music 'LineBreakEvent + break-permission 'force) + (music 'PageBreakEvent + break-permission 'force) + (music 'PageTurnEvent + break-permission 'force)))) "\\pageTurn")) ;;; @@ -1081,14 +1121,14 @@ Otherwise, return #f." ;;; ;;; \lyricsto -(define-display-method LyricCombineMusic (expr) +(define-display-method LyricCombineMusic (expr parser) (format #f "\\lyricsto ~s ~a" (ly:music-property expr 'associated-context) (parameterize ((*explicit-mode* #f)) - (music->lily-string (ly:music-property expr 'element))))) + (music->lily-string (ly:music-property expr 'element) parser)))) ;; \addlyrics -(define-extra-display-method SimultaneousMusic (expr) +(define-extra-display-method SimultaneousMusic (expr parser) (with-music-match (expr (music 'SimultaneousMusic elements ((music 'ContextSpeccedMusic context-id ?id @@ -1096,16 +1136,16 @@ Otherwise, return #f." element ?note-sequence) (music 'ContextSpeccedMusic context-type 'Lyrics - create-new #t + create-new #t element (music 'LyricCombineMusic associated-context ?associated-id element ?lyric-sequence))))) (if (string=? ?id ?associated-id) (format #f "~a~a \\addlyrics ~a" - (music->lily-string ?note-sequence) + (music->lily-string ?note-sequence parser) (new-line->lily-string) (parameterize ((*explicit-mode* #f)) - (music->lily-string ?lyric-sequence))) + (music->lily-string ?lyric-sequence parser))) #f))) diff --git a/scm/display-lily.scm b/scm/display-lily.scm index e20053128c..df0d04df7d 100644 --- a/scm/display-lily.scm +++ b/scm/display-lily.scm @@ -42,7 +42,7 @@ `display-methods' property of the music type entry found in the `music-name-to-property-table' hash table. Print methods previously defined for that music type are lost. -Syntax: (define-display-method MusicType (expression) +Syntax: (define-display-method MusicType (expression parser) ...body...))" `(let ((type-props (hashq-ref music-name-to-property-table ',music-type '())) @@ -76,11 +76,11 @@ display method will be called." (define* (tag->lily-string expr #:optional (post-event? #f)) (format #f "~{~a ~}" - (map (lambda (tag) - (format #f "~a\\tag #'~a" (if post-event? "-" "") tag)) - (ly:music-property expr 'tags)))) + (map (lambda (tag) + (format #f "~a\\tag #'~a" (if post-event? "-" "") tag)) + (ly:music-property expr 'tags)))) -(define-public (music->lily-string expr) +(define-public (music->lily-string expr parser) "Print expr, a music expression, in LilyPond syntax" (if (ly:music? expr) (let* ((music-type (ly:music-property expr 'name)) @@ -88,7 +88,7 @@ display method will be called." music-type '()) 'display-methods)) (result-string (and procs (any (lambda (proc) - (proc expr)) + (proc expr parser)) procs)))) (if result-string (format #f "~a~a" @@ -98,11 +98,11 @@ display method will be called." music-type))) (format #f "%{ expecting a music expression: ~a %}" expr))) -(define*-public (display-lily-music expr #:key force-duration) +(define*-public (display-lily-music expr parser #:key force-duration) (parameterize ((*indent* 0) (*previous-duration* (ly:make-duration 2)) (*force-duration* force-duration)) - (display (music->lily-string expr)) + (display (music->lily-string expr parser)) (newline))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -283,8 +283,6 @@ inside body." (define *time-factor-denominator* (make-parameter #f)) (define *time-factor-numerator* (make-parameter #f)) -(define *parser* (make-parameter #f)) - (define *current-context* (make-parameter 'Bottom)) (define *explicit-mode* (make-parameter #t)) -- 2.39.2