X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scm%2Fdefine-music-display-methods.scm;h=aa87f9978c3ac0ace19b003a34180d2b47ff92f7;hb=097cec3ca750c11ca1129034de3a1bb630782c0e;hp=6a428dd5d35218020f84b5b623eabd0780800c1a;hpb=7f48cb638958a728209577caa41bbaca8a2e4ef2;p=lilypond.git diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm index 6a428dd5d3..aa87f9978c 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -89,10 +89,7 @@ expression." (define (pitch= pitch1 pitch2) (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2)) (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2)))) - (let* ((pitches (if parser (ly:parser-lookup 'pitchnames) - (assoc-get (string->symbol default-language) - language-pitch-names '()))) - (result (rassoc ly-pitch pitches pitch=))) + (let* ((result (rassoc ly-pitch pitchnames pitch=))) (and result (car result)))) (define-public (octave->lily-string pitch) @@ -128,8 +125,7 @@ expression." ;;; post events ;;; -(define (post-event? m) - (music-is-of-type? m 'post-event)) +(define post-event? (music-type-predicate 'post-event)) (define* (event-direction->lily-string event #:optional (required #t)) (let ((direction (ly:music-property event 'direction))) @@ -153,23 +149,23 @@ expression." ,str-start ,str-stop)))) -(define-display-method HyphenEvent (event parser) +(define-display-method HyphenEvent (event) " --") -(define-display-method ExtenderEvent (event parser) +(define-display-method ExtenderEvent (event) " __") -(define-display-method TieEvent (event parser) +(define-display-method TieEvent (event) " ~") -(define-display-method BeamForbidEvent (event parser) +(define-display-method BeamForbidEvent (event) "\\noBeam") -(define-display-method StringNumberEvent (event parser) +(define-display-method StringNumberEvent (event) (format #f "\\~a" (ly:music-property event 'string-number))) -(define-display-method TremoloEvent (event parser) +(define-display-method TremoloEvent (event) (let ((tremolo-type (ly:music-property event 'tremolo-type 8))) (format #f ":~a" tremolo-type))) -(define-display-method ArticulationEvent (event parser) #t +(define-display-method ArticulationEvent (event) #t (let* ((articulation (ly:music-property event 'articulation-type)) (shorthand (case (string->symbol articulation) @@ -186,46 +182,46 @@ expression." shorthand (or shorthand articulation)))) -(define-post-event-display-method FingeringEvent (event parser) #t +(define-post-event-display-method FingeringEvent (event) #t (ly:music-property event 'digit)) -(define-post-event-display-method TextScriptEvent (event parser) #t +(define-post-event-display-method TextScriptEvent (event) #t (markup->lily-string (ly:music-property event 'text))) -(define-post-event-display-method MultiMeasureTextEvent (event parser) #t +(define-post-event-display-method MultiMeasureTextEvent (event) #t (markup->lily-string (ly:music-property event 'text))) -(define-post-event-display-method BendAfterEvent (event parser) #f +(define-post-event-display-method BendAfterEvent (event) #f (format #f "\\bendAfter #~a " (ly:music-property event 'delta-step))) -(define-post-event-display-method HarmonicEvent (event parser) #f "\\harmonic") -(define-post-event-display-method GlissandoEvent (event parser) #f "\\glissando") -(define-post-event-display-method ArpeggioEvent (event parser) #f "\\arpeggio") -(define-post-event-display-method AbsoluteDynamicEvent (event parser) #f +(define-post-event-display-method HarmonicEvent (event) #f "\\harmonic") +(define-post-event-display-method GlissandoEvent (event) #f "\\glissando") +(define-post-event-display-method ArpeggioEvent (event) #f "\\arpeggio") +(define-post-event-display-method AbsoluteDynamicEvent (event) #f (format #f "\\~a" (ly:music-property event 'text))) -(define-post-event-display-method StrokeFingerEvent (event parser) #f +(define-post-event-display-method StrokeFingerEvent (event) #f (format #f "\\rightHandFinger #~a " (ly:music-property event 'digit))) -(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 EpisemaEvent (event parser) #f "\\episemInitium" "\\episemFinis") -(define-span-event-display-method PhrasingSlurEvent (event parser) #f "\\(" "\\)") -(define-span-event-display-method SustainEvent (event parser) #f "\\sustainOn" "\\sustainOff") -(define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoOn" "\\sostenutoOff") -(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") +(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 EpisemaEvent (event) #f "\\episemInitium" "\\episemFinis") +(define-span-event-display-method PhrasingSlurEvent (event) #f "\\(" "\\)") +(define-span-event-display-method SustainEvent (event) #f "\\sustainOn" "\\sustainOff") +(define-span-event-display-method SostenutoEvent (event) #f "\\sostenutoOn" "\\sostenutoOff") +(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") ;;; ;;; Graces ;;; -(define-display-method GraceMusic (expr parser) +(define-display-method GraceMusic (expr) (format #f "\\grace ~a" (music->lily-string (ly:music-property expr 'element)))) @@ -233,7 +229,7 @@ expression." ;; 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 parser) +(define-extra-display-method GraceMusic (expr) "Display method for appoggiatura." (with-music-match (expr (music 'GraceMusic @@ -264,7 +260,7 @@ expression." (format #f "\\appoggiatura ~a" (music->lily-string ?music)))))) -(define-extra-display-method GraceMusic (expr parser) +(define-extra-display-method GraceMusic (expr) "Display method for acciaccatura." (with-music-match (expr (music 'GraceMusic @@ -308,7 +304,7 @@ expression." span-direction STOP)))))) (format #f "\\acciaccatura ~a" (music->lily-string ?music)))))) -(define-extra-display-method GraceMusic (expr parser) +(define-extra-display-method GraceMusic (expr) "Display method for grace." (with-music-match (expr (music 'GraceMusic @@ -327,7 +323,7 @@ expression." ;;; Music sequences ;;; -(define-display-method SequentialMusic (seq parser) +(define-display-method SequentialMusic (seq) (let ((force-line-break (and (*force-line-break*) ;; hm (> (length (ly:music-property seq 'elements)) @@ -382,32 +378,18 @@ expression." (if force-line-break 1 0) (if force-line-break (*indent*) 1)))) -(define-display-method SimultaneousMusic (sim parser) +(define-display-method SimultaneousMusic (sim) (parameterize ((*indent* (+ 3 (*indent*)))) (format #f "<< ~{~a ~}>>" (map-in-order (lambda (music) (music->lily-string music)) (ly:music-property sim 'elements))))) -(define-extra-display-method SimultaneousMusic (expr parser) - "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\". -Otherwise, return #f." - ;; TODO: do something with afterGraceFraction? - (with-music-match (expr (music 'SimultaneousMusic - elements (?before-grace - (music 'SequentialMusic - elements ((music 'SkipMusic) - (music 'GraceMusic - element ?grace)))))) - (format #f "\\afterGrace ~a ~a" - (music->lily-string ?before-grace) - (music->lily-string ?grace)))) - ;;; ;;; Chords ;;; -(define-display-method EventChord (chord parser) +(define-display-method EventChord (chord) ;; event_chord : command_element ;; | note_chord_element @@ -420,7 +402,7 @@ Otherwise, return #f." (chord-repeat (ly:music-property chord 'duration))) (call-with-values (lambda () - (partition (lambda (m) (music-is-of-type? m 'rhythmic-event)) + (partition (music-type-predicate 'rhythmic-event) elements)) (lambda (chord-elements other-elements) (cond ((pair? chord-elements) @@ -464,24 +446,24 @@ Otherwise, return #f." (music->lily-string music))) other-elements)))))))) -(define-display-method MultiMeasureRestMusic (mmrest parser) +(define-display-method MultiMeasureRestMusic (mmrest) (format #f "R~a~{~a~^ ~}" (duration->lily-string (ly:music-property mmrest 'duration)) (map-in-order (lambda (music) (music->lily-string music)) (ly:music-property mmrest 'articulations)))) -(define-display-method SkipMusic (skip parser) +(define-display-method SkipMusic (skip) (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t))) -(define-display-method OttavaMusic (ottava parser) +(define-display-method OttavaMusic (ottava) (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number))) ;;; ;;; Notes, rests, skips... ;;; -(define (simple-note->lily-string event parser) +(define (simple-note->lily-string event) (format #f "~a~a~a~a~a~a~:{~:[-~;~]~a~}" ; pitchname octave !? octave-check duration optional_rest articulations (note-name->lily-string (ly:music-property event 'pitch)) (octave->lily-string (ly:music-property event 'pitch)) @@ -511,9 +493,9 @@ Otherwise, return #f." (music->lily-string event))) (ly:music-property event 'articulations)))) -(define-display-method NoteEvent (note parser) +(define-display-method NoteEvent (note) (cond ((not (null? (ly:music-property note 'pitch))) ;; note - (simple-note->lily-string note parser)) + (simple-note->lily-string note)) ((not (null? (ly:music-property note 'drum-type))) ;; drum (format #f "~a~a~{~a~}" (ly:music-property note 'drum-type) (duration->lily-string (ly:music-property note 'duration)) @@ -529,38 +511,38 @@ Otherwise, return #f." (music->lily-string event)) (ly:music-property note 'articulations)))))) -(define-display-method ClusterNoteEvent (note parser) - (simple-note->lily-string note parser)) +(define-display-method ClusterNoteEvent (note) + (simple-note->lily-string note)) -(define-display-method RestEvent (rest parser) +(define-display-method RestEvent (rest) (if (not (null? (ly:music-property rest 'pitch))) - (simple-note->lily-string rest parser) + (simple-note->lily-string rest) (format #f "r~a~{~a~}" (duration->lily-string (ly:music-property rest 'duration)) (map-in-order (lambda (event) (music->lily-string event)) (ly:music-property rest 'articulations))))) -(define-display-method MultiMeasureRestEvent (rest parser) +(define-display-method MultiMeasureRestEvent (rest) (string-append "R" (duration->lily-string (ly:music-property rest 'duration)))) -(define-display-method SkipEvent (rest parser) +(define-display-method SkipEvent (rest) (format #f "s~a~{~a~}" (duration->lily-string (ly:music-property rest 'duration)) (map-in-order (lambda (event) (music->lily-string event)) (ly:music-property rest 'articulations)))) -(define-display-method RepeatedChord (chord parser) +(define-display-method RepeatedChord (chord) (music->lily-string (ly:music-property chord 'element))) -(define-display-method MarkEvent (mark parser) +(define-display-method MarkEvent (mark) (let ((label (ly:music-property mark 'label))) (if (null? label) "\\mark \\default" (format #f "\\mark ~a" (markup->lily-string label))))) -(define-display-method KeyChangeEvent (key parser) +(define-display-method KeyChangeEvent (key) (let ((pitch-alist (ly:music-property key 'pitch-alist)) (tonic (ly:music-property key 'tonic))) (if (or (null? pitch-alist) @@ -571,34 +553,32 @@ Otherwise, return #f." (format #f "\\key ~a \\~a~a" (note-name->lily-string (ly:music-property key 'tonic)) (any (lambda (mode) - (if (and parser - (equal? (ly:parser-lookup mode) c-pitch-alist)) - (symbol->string mode) - #f)) + (and (equal? (ly:parser-lookup mode) c-pitch-alist) + (symbol->string mode))) '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian)) (new-line->lily-string)))))) -(define-display-method RelativeOctaveCheck (octave parser) +(define-display-method RelativeOctaveCheck (octave) (let ((pitch (ly:music-property octave 'pitch))) (format #f "\\octaveCheck ~a~a" (note-name->lily-string pitch) (octave->lily-string pitch)))) -(define-display-method VoiceSeparator (sep parser) +(define-display-method VoiceSeparator (sep) "\\\\") -(define-display-method LigatureEvent (ligature parser) +(define-display-method LigatureEvent (ligature) (if (= START (ly:music-property ligature 'span-direction)) "\\[" "\\]")) -(define-display-method BarCheck (check parser) +(define-display-method BarCheck (check) (format #f "|~a" (new-line->lily-string))) -(define-display-method PesOrFlexaEvent (expr parser) +(define-display-method PesOrFlexaEvent (expr) "\\~") -(define-display-method BassFigureEvent (figure parser) +(define-display-method BassFigureEvent (figure) (let ((alteration (ly:music-property figure 'alteration)) (fig (ly:music-property figure 'figure)) (bracket-start (ly:music-property figure 'bracket-start)) @@ -620,7 +600,7 @@ Otherwise, return #f." (else ""))) (if (null? bracket-stop) "" "]")))) -(define-display-method LyricEvent (lyric parser) +(define-display-method LyricEvent (lyric) (format #f "~a~{~a~^ ~}" (let ((text (ly:music-property lyric 'text))) (if (or (string? text) @@ -634,28 +614,29 @@ Otherwise, return #f." (format #f "~s" string) string)) (markup->lily-string text))) - (map-in-order (lambda (m) (music->lily-string m)) + (map-in-order music->lily-string (ly:music-property lyric 'articulations)))) -(define-display-method BreathingEvent (event parser) +(define-display-method BreathingEvent (event) "\\breathe") ;;; ;;; Staff switches ;;; -(define-display-method AutoChangeMusic (m parser) +(define-display-method AutoChangeMusic (m) (format #f "\\autochange ~a" - (music->lily-string (ly:music-property m 'element)))) + (music->lily-string + (ly:music-property (ly:music-property m 'element) 'element)))) -(define-display-method ContextChange (m parser) +(define-display-method ContextChange (m) (format #f "\\change ~a = \"~a\"" (ly:music-property m 'change-to-type) (ly:music-property m 'change-to-id))) ;;; -(define-display-method TimeScaledMusic (times parser) +(define-display-method TimeScaledMusic (times) (let* ((num (ly:music-property times 'numerator)) (den (ly:music-property times 'denominator)) (span (ly:music-property times 'duration #f)) @@ -674,19 +655,19 @@ Otherwise, return #f." (music->lily-string (ly:music-property times 'element)))))) result))) -(define-display-method RelativeOctaveMusic (m parser) +(define-display-method RelativeOctaveMusic (m) (music->lily-string (ly:music-property m 'element))) -(define-display-method TransposedMusic (m parser) +(define-display-method TransposedMusic (m) (music->lily-string (ly:music-property m 'element))) ;;; ;;; Repeats ;;; -(define-display-method AlternativeEvent (alternative parser) "") +(define-display-method AlternativeEvent (alternative) "") -(define (repeat->lily-string expr repeat-type parser) +(define (repeat->lily-string expr repeat-type) (let* ((main (music->lily-string (ly:music-property expr 'element)))) (format #f "\\repeat ~a ~a ~a ~a" repeat-type @@ -700,23 +681,23 @@ Otherwise, return #f." (music->lily-string music)) alternatives))))))) -(define-display-method VoltaRepeatedMusic (expr parser) - (repeat->lily-string expr "volta" parser)) +(define-display-method VoltaRepeatedMusic (expr) + (repeat->lily-string expr "volta")) -(define-display-method UnfoldedRepeatedMusic (expr parser) - (repeat->lily-string expr "unfold" parser)) +(define-display-method UnfoldedRepeatedMusic (expr) + (repeat->lily-string expr "unfold")) -(define-display-method PercentRepeatedMusic (expr parser) - (repeat->lily-string expr "percent" parser)) +(define-display-method PercentRepeatedMusic (expr) + (repeat->lily-string expr "percent")) -(define-display-method TremoloRepeatedMusic (expr parser) - (repeat->lily-string expr "tremolo" parser)) +(define-display-method TremoloRepeatedMusic (expr) + (repeat->lily-string expr "tremolo")) ;;; ;;; Contexts ;;; -(define-display-method ContextSpeccedMusic (expr parser) +(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)) @@ -744,8 +725,28 @@ Otherwise, return #f." (parameterize ((*current-context* ctype)) (music->lily-string music))))) +;; \afterGrace +(define-extra-display-method ContextSpeccedMusic (expr) + "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\". +Otherwise, return #f." + ;; TODO: do something with afterGraceFraction? + (with-music-match + (expr (music 'ContextSpeccedMusic + context-type 'Bottom + element + (music 'SimultaneousMusic + elements (?before-grace + (music 'SequentialMusic + elements ((music 'SkipMusic) + (music 'GraceMusic + element ?grace))))))) + (format #f "\\afterGrace ~a ~a" + (music->lily-string ?before-grace) + (music->lily-string ?grace)))) + + ;; special cases: \figures \lyrics \drums -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-extra-display-method ContextSpeccedMusic (expr) (with-music-match (expr (music 'ContextSpeccedMusic create-new #t property-operations ?op @@ -766,7 +767,7 @@ Otherwise, return #f." ;;; Context properties -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-extra-display-method ContextSpeccedMusic (expr) (let ((element (ly:music-property expr 'element)) (property-tuning? (make-music-type-predicate 'PropertySet 'PropertyUnset @@ -797,7 +798,7 @@ Otherwise, return #f." (else (format #f "#~a" (scheme-expr->lily-string arg))))) -(define-display-method PropertySet (expr parser) +(define-display-method PropertySet (expr) (let ((property (ly:music-property expr 'symbol)) (value (ly:music-property expr 'value)) (once (ly:music-property expr 'once))) @@ -812,8 +813,9 @@ Otherwise, return #f." (value->lily-string value) (new-line->lily-string)))) -(define-display-method PropertyUnset (expr parser) - (format #f "\\unset ~a~a~a" +(define-display-method PropertyUnset (expr) + (format #f "~a\\unset ~a~a~a" + (if (ly:music-property expr 'once #f) "\\once " "") (if (eqv? (*current-context*) 'Bottom) "" (format #f "~a . " (*current-context*))) @@ -822,7 +824,7 @@ Otherwise, return #f." ;;; Layout properties -(define-display-method OverrideProperty (expr parser) +(define-display-method OverrideProperty (expr) (let* ((symbol (ly:music-property expr 'symbol)) (properties (ly:music-property expr 'grob-property-path (list (ly:music-property expr 'grob-property)))) @@ -840,17 +842,20 @@ Otherwise, return #f." (value->lily-string value) (new-line->lily-string)))) -(define-display-method RevertProperty (expr parser) +(define-display-method RevertProperty (expr) (let* ((symbol (ly:music-property expr 'symbol)) (properties (ly:music-property expr 'grob-property-path - (list (ly:music-property expr 'grob-property))))) - (format #f "\\revert ~{~a~^.~}~a" + (list (ly:music-property expr + 'grob-property)))) + (once (ly:music-property expr 'once #f))) + (format #f "~a\\revert ~{~a~^.~}~a" + (if once "\\once " "") (if (eqv? (*current-context*) 'Bottom) (cons symbol properties) (cons* (*current-context*) symbol properties)) (new-line->lily-string)))) -(define-display-method TimeSignatureMusic (expr parser) +(define-display-method TimeSignatureMusic (expr) (let* ((num (ly:music-property expr 'numerator)) (den (ly:music-property expr 'denominator)) (structure (ly:music-property expr 'beat-structure))) @@ -860,12 +865,16 @@ Otherwise, return #f." num den (new-line->lily-string)) (format #f - "\\time #'~a ~a/~a~a" + ;; This is silly but the latter will also work for #f + ;; and other + (if (key-list? structure) + "\\time ~{~a~^,~} ~a/~a~a" + "\\time #'~a ~a/~a~a") structure num den (new-line->lily-string))))) ;;; \melisma and \melismaEnd -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-extra-display-method ContextSpeccedMusic (expr) "If expr is a melisma, return \"\\melisma\", otherwise, return #f." (with-music-match (expr (music 'ContextSpeccedMusic element (music 'PropertySet @@ -873,7 +882,7 @@ Otherwise, return #f." symbol 'melismaBusy))) "\\melisma")) -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-extra-display-method ContextSpeccedMusic (expr) "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f." (with-music-match (expr (music 'ContextSpeccedMusic element (music 'PropertyUnset @@ -881,7 +890,7 @@ Otherwise, return #f." "\\melismaEnd")) ;;; \tempo -(define-extra-display-method SequentialMusic (expr parser) +(define-extra-display-method SequentialMusic (expr) (with-music-match (expr (music 'SequentialMusic elements ((music 'TempoChangeEvent text ?text @@ -900,7 +909,7 @@ Otherwise, return #f." ?count) (new-line->lily-string)))) -(define-display-method TempoChangeEvent (expr parser) +(define-display-method TempoChangeEvent (expr) (let ((text (ly:music-property expr 'text))) (format #f "\\tempo ~a~a" (markup->lily-string text) @@ -917,7 +926,7 @@ Otherwise, return #f." (car name+vals))) clefs)))) -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-extra-display-method ContextSpeccedMusic (expr) "If @var{expr} is a clef change, return \"\\clef ...\". Otherwise, return @code{#f}." (with-music-match (expr (music 'ContextSpeccedMusic @@ -956,7 +965,7 @@ Otherwise, return @code{#f}." (new-line->lily-string)))))) ;;; \bar -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-extra-display-method ContextSpeccedMusic (expr) "If `expr' is a bar, return \"\\bar ...\". Otherwise, return #f." (with-music-match (expr (music 'ContextSpeccedMusic @@ -967,7 +976,7 @@ Otherwise, return #f." (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string)))) ;;; \partial -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-extra-display-method ContextSpeccedMusic (expr) "If `expr' is a partial measure, return \"\\partial ...\". Otherwise, return #f." (with-music-match (expr (music @@ -986,17 +995,19 @@ Otherwise, return #f." ;;; ;;; -(define-display-method ApplyOutputEvent (applyoutput parser) +(define-display-method ApplyOutputEvent (applyoutput) (let ((proc (ly:music-property applyoutput 'procedure)) - (ctx (ly:music-property applyoutput 'context-type))) - (format #f "\\applyOutput #'~a #~a" + (ctx (ly:music-property applyoutput 'context-type)) + (grob (ly:music-property applyoutput 'symbol))) + (format #f "\\applyOutput ~a~@[.~a~] #~a" ctx + (and (symbol? grob) grob) (or (procedure-name proc) (with-output-to-string (lambda () (pretty-print (procedure-source proc)))))))) -(define-display-method ApplyContext (applycontext parser) +(define-display-method ApplyContext (applycontext) (let ((proc (ly:music-property applycontext 'procedure))) (format #f "\\applyContext #~a" (or (procedure-name proc) @@ -1005,34 +1016,22 @@ Otherwise, return #f." (pretty-print (procedure-source proc)))))))) ;;; \partcombine -(define-display-method PartCombineMusic (expr parser) - (format #f "\\partcombine ~{~a ~}" - (map-in-order (lambda (music) - (music->lily-string music)) - (ly:music-property expr 'elements)))) - -(define-extra-display-method PartCombineMusic (expr parser) - (with-music-match (expr (music 'PartCombineMusic - direction ?dir - elements ((music 'UnrelativableMusic - element (music 'ContextSpeccedMusic - context-id "one" - context-type 'Voice - element ?sequence1)) - (music 'UnrelativableMusic - element (music 'ContextSpeccedMusic - context-id "two" - context-type 'Voice - element ?sequence2))))) - (format #f "\\partcombine~a ~a~a~a" - (cond ((equal? ?dir UP) "Up") - ((equal? ?dir DOWN) "Down") - (else "")) - (music->lily-string ?sequence1) - (new-line->lily-string) - (music->lily-string ?sequence2)))) - -(define-extra-display-method ContextSpeccedMusic (expr parser) +(define-display-method PartCombineMusic (expr) + (let ((dir (ly:music-property expr 'direction))) + (format #f "\\partcombine~a ~a~a~a" + (cond ((equal? dir UP) "Up") + ((equal? dir DOWN) "Down") + (else "")) + (music->lily-string (car (ly:music-property expr 'elements))) + (new-line->lily-string) + (music->lily-string (cadr (ly:music-property expr 'elements)))))) + +(define-display-method PartCombinePartMusic (expr) + (with-music-match ((ly:music-property expr 'element) + (music 'ContextSpeccedMusic element ?part)) + (format #f "~a" (music->lily-string ?part)))) + +(define-extra-display-method ContextSpeccedMusic (expr) "If `expr' is a \\partcombine expression, return \"\\partcombine ...\". Otherwise, return #f." (with-music-match @@ -1054,16 +1053,17 @@ Otherwise, return #f." (music 'ContextSpeccedMusic context-id "null" context-type 'NullVoice) - ?pc-music)))) + ?pc-music + ?pc-marks)))) (with-music-match (?pc-music (music 'PartCombineMusic)) (format #f "~a" (music->lily-string ?pc-music))))) -(define-display-method UnrelativableMusic (expr parser) +(define-display-method UnrelativableMusic (expr) (music->lily-string (ly:music-property expr 'element))) ;;; Cue notes -(define-display-method QuoteMusic (expr parser) +(define-display-method QuoteMusic (expr) (or (with-music-match (expr (music 'QuoteMusic quoted-voice-direction ?quoted-voice-direction @@ -1082,22 +1082,22 @@ Otherwise, return #f." ;;; ;;; Breaks ;;; -(define-display-method LineBreakEvent (expr parser) +(define-display-method LineBreakEvent (expr) (if (null? (ly:music-property expr 'break-permission)) "\\noBreak" "\\break")) -(define-display-method PageBreakEvent (expr parser) +(define-display-method PageBreakEvent (expr) (if (null? (ly:music-property expr 'break-permission)) "\\noPageBreak" "\\pageBreak")) -(define-display-method PageTurnEvent (expr parser) +(define-display-method PageTurnEvent (expr) (if (null? (ly:music-property expr 'break-permission)) "\\noPageTurn" "\\pageTurn")) -(define-extra-display-method EventChord (expr parser) +(define-extra-display-method EventChord (expr) (with-music-match (expr (music 'EventChord elements ((music 'LineBreakEvent break-permission 'force) @@ -1105,7 +1105,7 @@ Otherwise, return #f." break-permission 'force)))) "\\pageBreak")) -(define-extra-display-method EventChord (expr parser) +(define-extra-display-method EventChord (expr) (with-music-match (expr (music 'EventChord elements ((music 'LineBreakEvent break-permission 'force) @@ -1120,15 +1120,32 @@ Otherwise, return #f." ;;; ;;; \lyricsto -(define-display-method LyricCombineMusic (expr parser) +(define-display-method LyricCombineMusic (expr) (format #f "\\lyricsto ~s ~a" (ly:music-property expr 'associated-context) (parameterize ((*explicit-mode* #f) (*omit-duration* #t)) (music->lily-string (ly:music-property expr 'element))))) +;; \autochange +(define-extra-display-method SimultaneousMusic (expr) + (with-music-match (expr (music 'SimultaneousMusic + elements ((music 'ContextSpeccedMusic + context-id "up" + context-type 'Staff + element ?ac-music) + (music 'ContextSpeccedMusic + context-id "up" + context-type 'Staff) + (music 'ContextSpeccedMusic + context-id "down" + context-type 'Staff)))) + (with-music-match (?ac-music (music 'AutoChangeMusic)) + (format #f "~a" + (music->lily-string ?ac-music))))) + ;; \addlyrics -(define-extra-display-method SimultaneousMusic (expr parser) +(define-extra-display-method SimultaneousMusic (expr) (with-music-match (expr (music 'SimultaneousMusic elements ((music 'ContextSpeccedMusic context-id ?id @@ -1150,5 +1167,5 @@ Otherwise, return #f." #f))) ;; Silence internal event sent at end of each lyrics block -(define-display-method CompletizeExtenderEvent (expr parser) +(define-display-method CompletizeExtenderEvent (expr) "")