scm/define-music-display-methods.scm

   1 ;;; define-music-display-methods.scm -- data for displaying music
   2 ;;; expressions using LilyPond notation.
   3 ;;;
   4 ;;; Copyright (C) 2005--2010 Nicolas Sceaux  <nicolas.sceaux@free.fr>
   5 ;;;
   6
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;;;
   9 ;;; Display method implementation
  10 ;;;
  11
  12 (define-module (scm display-lily))
  13
  14 ;;;
  15 ;;; Scheme forms
  16 ;;;
  17 (define (scheme-expr->lily-string scm-arg)
  18   (cond ((or (number? scm-arg)
  19              (string? scm-arg))
  20          (format #f "~s" scm-arg))
  21         ((or (symbol? scm-arg)
  22              (list? scm-arg))
  23          (format #f "'~s" scm-arg))
  24         ((procedure? scm-arg)
  25          (format #f "~a"
  26                  (or (procedure-name scm-arg)
  27                      (with-output-to-string
  28                        (lambda ()
  29                          (pretty-print (procedure-source scm-arg)))))))
  30         (else
  31          (format #f "~a"
  32                  (with-output-to-string
  33                    (lambda ()
  34                      (display-scheme-music scm-arg)))))))
  35 ;;;
  36 ;;; Markups
  37 ;;;
  38
  39 (define-public (markup->lily-string markup-expr)
  40   "Return a string describing, in LilyPond syntax, the given markup expression."
  41   (define (proc->command proc)
  42     (let ((cmd-markup (symbol->string (procedure-name proc))))
  43       (substring cmd-markup 0 (- (string-length cmd-markup)
  44                                  (string-length "-markup")))))
  45   (define (arg->string arg)
  46     (cond ((string? arg)
  47            (format #f "~s" arg))
  48           ((markup? arg) ;; a markup
  49            (markup->lily-string-aux arg))
  50           ((and (pair? arg) (every markup? arg)) ;; a markup list
  51            (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg)))
  52           (else          ;; a scheme argument
  53            (format #f "#~a" (scheme-expr->lily-string arg)))))
  54   (define (markup->lily-string-aux expr)
  55     (if (string? expr)
  56         (format #f "~s" expr)
  57         (let ((cmd (car expr))
  58               (args (cdr expr)))
  59           (if (eqv? cmd simple-markup) ;; a simple markup
  60               (format #f "~s" (car args))
  61               (format #f "\\~a~{ ~a~}"
  62                       (proc->command cmd)
  63                       (map-in-order arg->string args))))))
  64   (cond ((string? markup-expr)
  65          (format #f "~s" markup-expr))
  66         ((eqv? (car markup-expr) simple-markup)
  67          (format #f "~s" (second markup-expr)))
  68         (else
  69          (format #f "\\markup ~a"
  70                  (markup->lily-string-aux markup-expr)))))
  71
  72 ;;;
  73 ;;; pitch names
  74 ;;;
  75
  76 ;; It is a pity that there is no rassoc in Scheme.
  77 (define* (rassoc item alist #:optional (test equal?))
  78   (do ((alist alist (cdr alist))
  79        (result #f result))
  80       ((or result (null? alist)) result)
  81     (if (and (car alist) (test item (cdar alist)))
  82         (set! result (car alist)))))
  83
  84 (define-public (note-name->lily-string ly-pitch parser)
  85   ;; here we define a custom pitch= function, since we do not want to
  86   ;; test whether octaves are also equal. (otherwise, we would be using equal?)
  87   (define (pitch= pitch1 pitch2)
  88     (and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2))
  89          (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
  90   (let ((result (rassoc ly-pitch (ly:parser-lookup parser 'pitchnames) pitch=)))
  91     (if result
  92         (car result)
  93         #f)))
  94
  95 (define-public (octave->lily-string pitch)
  96   (let ((octave (ly:pitch-octave pitch)))
  97     (cond ((>= octave 0)
  98            (make-string (1+ octave) #\'))
  99           ((< octave -1)
 100            (make-string (1- (* -1 octave)) #\,))
 101           (else ""))))
 102
 103 ;;;
 104 ;;; durations
 105 ;;;
 106 (define*-public (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
 107                         (force-duration (*force-duration*))
 108                         (time-factor-numerator (*time-factor-numerator*))
 109                         (time-factor-denominator (*time-factor-denominator*)))
 110   (let ((log2    (ly:duration-log ly-duration))
 111         (dots    (ly:duration-dot-count ly-duration))
 112         (num+den (ly:duration-factor ly-duration)))
 113     (if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
 114         (string-append (case log2
 115                          ((-1) "\\breve")
 116                          ((-2) "\\longa")
 117                          ((-3) "\\maxima")
 118                          (else (number->string (expt 2 log2))))
 119                        (make-string dots #\.)
 120                        (let ((num? (not (or (= 1 (car num+den))
 121                                             (and time-factor-numerator
 122                                                  (= (car num+den) time-factor-numerator)))))
 123                              (den? (not (or (= 1 (cdr num+den))
 124                                             (and time-factor-denominator
 125                                                  (= (cdr num+den) time-factor-denominator))))))
 126                          (cond (den?
 127                                 (format #f "*~a/~a" (car num+den) (cdr num+den)))
 128                                (num?
 129                                 (format #f "*~a" (car num+den)))
 130                                (else ""))))
 131         "")))
 132
 133 ;;;
 134 ;;; post events
 135 ;;;
 136
 137 (define post-event?
 138   (make-music-type-predicate
 139     'AbsoluteDynamicEvent
 140     'ArpeggioEvent
 141     'ArticulationEvent
 142     'BeamEvent
 143     'BeamForbidEvent
 144     'BendAfterEvent
 145     'CrescendoEvent
 146     'DecrescendoEvent
 147     'EpisemaEvent
 148     'ExtenderEvent
 149     'FingeringEvent
 150     'GlissandoEvent
 151     'HarmonicEvent
 152     'HyphenEvent
 153     'MultiMeasureTextEvent
 154     'NoteGroupingEvent
 155     'PhrasingSlurEvent
 156     'SlurEvent
 157     'SostenutoEvent
 158     'StringNumberEvent
 159     'SustainEvent
 160     'TextScriptEvent
 161     'TextSpanEvent
 162     'TieEvent
 163     'TremoloEvent
 164     'TrillSpanEvent
 165     'TupletSpanEvent
 166     'UnaCordaEvent))
 167
 168 (define* (event-direction->lily-string event #:optional (required #t))
 169   (let ((direction (ly:music-property event 'direction)))
 170     (cond ((or (not direction) (null? direction) (= CENTER direction))
 171            (if required "-" ""))
 172           ((= UP direction) "^")
 173           ((= DOWN direction) "_")
 174           (else ""))))
 175
 176 (define-macro (define-post-event-display-method type vars direction-required str)
 177   `(define-display-method ,type ,vars
 178      (format #f "~a~a"
 179              (event-direction->lily-string ,(car vars) ,direction-required)
 180              ,str)))
 181
 182 (define-macro (define-span-event-display-method type vars direction-required str-start str-stop)
 183   `(define-display-method ,type ,vars
 184      (format #f "~a~a"
 185              (event-direction->lily-string ,(car vars) ,direction-required)
 186              (if (= START (ly:music-property ,(car vars) 'span-direction))
 187                  ,str-start
 188                  ,str-stop))))
 189
 190 (define-display-method HyphenEvent (event parser)
 191   " --")
 192 (define-display-method ExtenderEvent (event parser)
 193   " __")
 194 (define-display-method TieEvent (event parser)
 195   " ~")
 196 (define-display-method BeamForbidEvent (event parser)
 197   "\\noBeam")
 198 (define-display-method StringNumberEvent (event parser)
 199   (format #f "\\~a" (ly:music-property event 'string-number)))
 200
 201
 202 (define-display-method TremoloEvent (event parser)
 203   (let ((tremolo-type (ly:music-property event 'tremolo-type)))
 204     (format #f ":~a" (if (= 0 tremolo-type)
 205                          ""
 206                          tremolo-type))))
 207
 208 (define-post-event-display-method ArticulationEvent (event parser) #t
 209   (let ((articulation  (ly:music-property event 'articulation-type)))
 210     (case (string->symbol articulation)
 211       ((marcato) "^")
 212       ((stopped) "+")
 213       ((tenuto)  "-")
 214       ((staccatissimo) "|")
 215       ((accent) ">")
 216       ((staccato) ".")
 217       ((portato) "_")
 218       (else (format #f "\\~a" articulation)))))
 219
 220 (define-post-event-display-method FingeringEvent (event parser) #t
 221   (ly:music-property event 'digit))
 222
 223 (define-post-event-display-method TextScriptEvent (event parser) #t
 224   (markup->lily-string (ly:music-property event 'text)))
 225
 226 (define-post-event-display-method MultiMeasureTextEvent (event parser) #t
 227   (markup->lily-string (ly:music-property event 'text)))
 228
 229 (define-post-event-display-method BendAfterEvent (event parser) #t
 230   (format #f "\\bendAfter #~a" (ly:music-property event 'delta-step)))
 231
 232 (define-post-event-display-method HarmonicEvent (event parser) #f "\\harmonic")
 233 (define-post-event-display-method GlissandoEvent (event parser) #t "\\glissando")
 234 (define-post-event-display-method ArpeggioEvent (event parser) #t "\\arpeggio")
 235 (define-post-event-display-method AbsoluteDynamicEvent (event parser) #f
 236   (format #f "\\~a" (ly:music-property event 'text)))
 237
 238 (define-span-event-display-method BeamEvent (event parser) #f "[" "]")
 239 (define-span-event-display-method SlurEvent (event parser) #f "(" ")")
 240 (define-span-event-display-method CrescendoEvent (event parser) #f "\\<" "\\!")
 241 (define-span-event-display-method DecrescendoEvent (event parser) #f "\\>" "\\!")
 242 (define-span-event-display-method EpisemaEvent (event parser) #f "\\episemInitium" "\\episemFinis")
 243 (define-span-event-display-method PhrasingSlurEvent (event parser) #f "\\(" "\\)")
 244 (define-span-event-display-method SustainEvent (event parser) #f "\\sustainOn" "\\sustainOff")
 245 (define-span-event-display-method SostenutoEvent (event parser) #f "\\sostenutoOn" "\\sostenutoOff")
 246 (define-span-event-display-method TextSpanEvent (event parser) #f "\\startTextSpan" "\\stopTextSpan")
 247 (define-span-event-display-method TrillSpanEvent (event parser) #f "\\startTrillSpan" "\\stopTrillSpan")
 248 (define-span-event-display-method StaffSpanEvent (event parser) #f "\\startStaff" "\\stopStaff")
 249 (define-span-event-display-method NoteGroupingEvent (event parser) #f "\\startGroup" "\\stopGroup")
 250 (define-span-event-display-method UnaCordaEvent (event parser) #f "\\unaCorda" "\\treCorde")
 251
 252 ;;;
 253 ;;; Graces
 254 ;;;
 255
 256 (define-display-method GraceMusic (expr parser)
 257   (format #f "\\grace ~a"
 258           (music->lily-string (ly:music-property expr 'element) parser)))
 259
 260 ;; \acciaccatura \appoggiatura \grace
 261 ;; TODO: it would be better to compare ?start and ?stop
 262 ;; with startAppoggiaturaMusic and stopAppoggiaturaMusic,
 263 ;; using a custom music equality predicate.
 264 (define-extra-display-method GraceMusic (expr parser)
 265   "Display method for appoggiatura."
 266   (with-music-match (expr (music
 267                            'GraceMusic
 268                            element (music
 269                                     'SequentialMusic
 270                                     elements (?start
 271                                               ?music
 272                                               ?stop))))
 273     ;; we check whether ?start and ?stop look like
 274     ;; startAppoggiaturaMusic stopAppoggiaturaMusic
 275     (and (with-music-match (?start (music
 276                                     'SequentialMusic
 277                                     elements ((music
 278                                                'EventChord
 279                                                elements ((music
 280                                                           'SkipEvent
 281                                                           duration (ly:make-duration 0 0 0 1))
 282                                                          (music
 283                                                           'SlurEvent
 284                                                           span-direction START))))))
 285                            #t)
 286           (with-music-match (?stop (music
 287                                     'SequentialMusic
 288                                     elements ((music
 289                                                'EventChord
 290                                                elements ((music
 291                                                           'SkipEvent
 292                                                           duration (ly:make-duration 0 0 0 1))
 293                                                          (music
 294                                                           'SlurEvent
 295                                                           span-direction STOP))))))
 296             (format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
 297
 298
 299 (define-extra-display-method GraceMusic (expr parser)
 300   "Display method for acciaccatura."
 301   (with-music-match (expr (music
 302                            'GraceMusic
 303                            element (music
 304                                     'SequentialMusic
 305                                     elements (?start
 306                                               ?music
 307                                               ?stop))))
 308     ;; we check whether ?start and ?stop look like
 309     ;; startAcciaccaturaMusic stopAcciaccaturaMusic
 310     (and (with-music-match (?start (music
 311                                     'SequentialMusic
 312                                     elements ((music
 313                                                'EventChord
 314                                                elements ((music
 315                                                           'SkipEvent
 316                                                           duration (ly:make-duration 0 0 0 1))
 317                                                          (music
 318                                                           'SlurEvent
 319                                                           span-direction START)))
 320                                               (music
 321                                                'ContextSpeccedMusic
 322                                                element (music
 323                                                         'OverrideProperty
 324                                                         grob-property-path '(stroke-style)
 325                                                         grob-value "grace"
 326                                                         symbol 'Stem)))))
 327                            #t)
 328          (with-music-match (?stop (music
 329                                    'SequentialMusic
 330                                    elements ((music
 331                                               'ContextSpeccedMusic
 332                                               element (music
 333                                                        'RevertProperty
 334                                                        grob-property-path '(stroke-style)
 335                                                        symbol 'Stem))
 336                                              (music
 337                                               'EventChord
 338                                               elements ((music
 339                                                          'SkipEvent
 340                                                          duration (ly:make-duration 0 0 0 1))
 341                                                         (music
 342                                                          'SlurEvent
 343                                                          span-direction STOP))))))
 344            (format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
 345
 346 (define-extra-display-method GraceMusic (expr parser)
 347   "Display method for grace."
 348   (with-music-match (expr (music
 349                            'GraceMusic
 350                            element (music
 351                                     'SequentialMusic
 352                                     elements (?start
 353                                               ?music
 354                                               ?stop))))
 355     ;; we check whether ?start and ?stop look like
 356     ;; startGraceMusic stopGraceMusic
 357     (and (null? (ly:music-property ?start 'elements))
 358          (null? (ly:music-property ?stop 'elements))
 359          (format #f "\\grace ~a" (music->lily-string ?music parser)))))
 360
 361 ;;;
 362 ;;; Music sequences
 363 ;;;
 364
 365 (define-display-method SequentialMusic (seq parser)
 366   (let ((force-line-break (and (*force-line-break*)
 367                                ;; hm
 368                                (> (length (ly:music-property seq 'elements))
 369                                   (*max-element-number-before-break*))))
 370         (elements (ly:music-property seq 'elements))
 371         (chord? (make-music-type-predicate 'EventChord))
 372         (cluster? (make-music-type-predicate 'ClusterNoteEvent))
 373         (note? (make-music-type-predicate 'NoteEvent)))
 374     (format #f "~a~a{~v%~v_~{~a ~}~v%~v_}"
 375             (if (any (lambda (e)
 376                        (and (chord? e)
 377                             (any cluster? (ly:music-property e 'elements))))
 378                      elements)
 379                 "\\makeClusters "
 380                 "")
 381             (if (*explicit-mode*)
 382                 ;; if the sequence contains EventChord which contains figures ==> figuremode
 383                 ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
 384                 ;; if the sequence contains EventChord which contains drum notes ==> drummode
 385                 (cond ((any (lambda (chord)
 386                               (any (make-music-type-predicate 'BassFigureEvent)
 387                                    (ly:music-property chord 'elements)))
 388                             (filter chord? elements))
 389                        "\\figuremode ")
 390                       ((any (lambda (chord)
 391                               (any (make-music-type-predicate 'LyricEvent)
 392                                    (ly:music-property chord 'elements)))
 393                             (filter chord? elements))
 394                        "\\lyricmode ")
 395                       ((any (lambda (chord)
 396                               (any (lambda (event)
 397                                      (and (note? event)
 398                                           (not (null? (ly:music-property event 'drum-type)))))
 399                                    (ly:music-property chord 'elements)))
 400                             (filter chord? elements))
 401                        "\\drummode ")
 402                       (else ;; TODO: other modes?
 403                        ""))
 404                 "")
 405             (if force-line-break 1 0)
 406             (if force-line-break (+ 2 (*indent*)) 1)
 407             (parameterize ((*indent* (+ 2 (*indent*))))
 408                           (map-in-order (lambda (music)
 409                                           (music->lily-string music parser))
 410                                         elements))
 411             (if force-line-break 1 0)
 412             (if force-line-break (*indent*) 0))))
 413
 414 (define-display-method SimultaneousMusic (sim parser)
 415   (parameterize ((*indent* (+ 3 (*indent*))))
 416     (format #f "<< ~{~a ~}>>"
 417             (map-in-order (lambda (music)
 418                             (music->lily-string music parser))
 419                           (ly:music-property sim 'elements)))))
 420
 421 (define-extra-display-method SimultaneousMusic (expr parser)
 422   "If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
 423 Otherwise, return #f."
 424   ;; TODO: do something with afterGraceFraction?
 425   (with-music-match (expr (music 'SimultaneousMusic
 426                                  elements (?before-grace
 427                                            (music 'SequentialMusic
 428                                                   elements ((music 'SkipMusic)
 429                                                             (music 'GraceMusic
 430                                                                    element ?grace))))))
 431     (format #f "\\afterGrace ~a ~a"
 432             (music->lily-string ?before-grace parser)
 433             (music->lily-string ?grace parser))))
 434
 435 ;;;
 436 ;;; Chords
 437 ;;;
 438
 439 (define-display-method EventChord (chord parser)
 440   ;; event_chord : simple_element post_events
 441   ;;               | command_element
 442   ;;               | note_chord_element
 443
 444   ;; TODO : tagged post_events
 445   ;; post_events : ( post_event | tagged_post_event )*
 446   ;; tagged_post_event: '-' \tag embedded_scm post_event
 447
 448   (let* ((elements (ly:music-property chord 'elements))
 449          (simple-elements (filter (make-music-type-predicate
 450                                    'NoteEvent 'ClusterNoteEvent 'RestEvent
 451                                    'MultiMeasureRestEvent 'SkipEvent 'LyricEvent)
 452                                   elements)))
 453     (if ((make-music-type-predicate 'StaffSpanEvent 'BreathingEvent) (car elements))
 454         ;; first, a special case: StaffSpanEvent (\startStaff, \stopStaff)
 455         ;; and BreathingEvent (\breathe)
 456         (music->lily-string (car elements) parser)
 457         (if (and (not (null? simple-elements))
 458                  (null? (cdr simple-elements))
 459                  ;; special case: if this simple_element has a HarmonicEvent in its
 460                  ;; 'articulations list, it should be interpreted instead as a
 461                  ;; note_chord_element, since \harmonic only works inside chords,
 462                  ;; even for single notes, e.g., < c\harmonic >
 463                  (null? (filter (make-music-type-predicate 'HarmonicEvent)
 464                                 (ly:music-property (car simple-elements) 'articulations))))
 465             ;; simple_element : note | figure | rest | mmrest | lyric_element | skip
 466             (let* ((simple-element (car simple-elements))
 467                    (duration (ly:music-property simple-element 'duration))
 468                    (lily-string (format #f "~a~a~a~{~a ~}"
 469                                         (music->lily-string simple-element parser)
 470                                         (duration->lily-string duration)
 471                                         (if (and ((make-music-type-predicate 'RestEvent) simple-element)
 472                                                  (ly:pitch? (ly:music-property simple-element 'pitch)))
 473                                             "\\rest"
 474                                             "")
 475                                         (map-in-order (lambda (music)
 476                                                         (music->lily-string music parser))
 477                                                       (filter post-event? elements)))))
 478               (*previous-duration* duration)
 479               lily-string)
 480             (let ((chord-elements (filter (make-music-type-predicate
 481                                            'NoteEvent 'ClusterNoteEvent 'BassFigureEvent)
 482                                           elements))
 483                   (post-events (filter post-event? elements)))
 484               (if (not (null? chord-elements))
 485                   ;; note_chord_element : '<' (notepitch | drumpitch)* '>" duration post_events
 486                   (let ((lily-string (format #f "< ~{~a ~}>~a~{~a ~}"
 487                                              (map-in-order (lambda (music)
 488                                                              (music->lily-string music parser))
 489                                                            chord-elements)
 490                                              (duration->lily-string (ly:music-property (car chord-elements)
 491                                                                                        'duration))
 492                                              (map-in-order (lambda (music)
 493                                                              (music->lily-string music parser))
 494                                                            post-events))))
 495                     (*previous-duration* (ly:music-property (car chord-elements) 'duration))
 496                     lily-string)
 497                   ;; command_element
 498                   (format #f "~{~a ~}" (map-in-order (lambda (music)
 499                                                        (music->lily-string music parser))
 500                                                      elements))))))))
 501
 502 (define-display-method MultiMeasureRestMusic (mmrest parser)
 503   (let* ((dur (ly:music-property mmrest 'duration))
 504          (ly (format #f "R~a~{~a ~}"
 505                      (duration->lily-string dur)
 506                      (map-in-order (lambda (music)
 507                                      (music->lily-string music parser))
 508                                    (ly:music-property mmrest 'articulations)))))
 509     (*previous-duration* dur)
 510     ly))
 511
 512 (define-display-method SkipMusic (skip parser)
 513   (format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
 514
 515 (define-display-method OttavaMusic (ottava parser)
 516   (format #f "\\ottava #~a" (ly:music-property ottava 'ottava-number)))
 517
 518 ;;;
 519 ;;; Notes, rests, skips...
 520 ;;;
 521
 522 (define (simple-note->lily-string event parser)
 523   (format #f "~a~a~a~a~{~a~}" ; pitchname octave !? octave-check articulations
 524           (note-name->lily-string (ly:music-property event 'pitch) parser)
 525           (octave->lily-string (ly:music-property event 'pitch))
 526           (let ((forced (ly:music-property event 'force-accidental))
 527                 (cautionary (ly:music-property event 'cautionary)))
 528             (cond ((and (not (null? forced))
 529                         forced
 530                         (not (null? cautionary))
 531                         cautionary)
 532                    "?")
 533                   ((and (not (null? forced)) forced) "!")
 534                   (else "")))
 535           (let ((octave-check (ly:music-property event 'absolute-octave)))
 536             (if (not (null? octave-check))
 537                 (format #f "=~a" (cond ((>= octave-check 0)
 538                                         (make-string (1+ octave-check) #\'))
 539                                        ((< octave-check -1)
 540                                         (make-string (1- (* -1 octave-check)) #\,))
 541                                        (else "")))
 542                 ""))
 543           (map-in-order (lambda (event)
 544                           (music->lily-string event parser))
 545                         (ly:music-property event 'articulations))))
 546
 547 (define-display-method NoteEvent (note parser)
 548   (cond ((not (null? (ly:music-property note 'pitch))) ;; note
 549          (simple-note->lily-string note parser))
 550         ((not (null? (ly:music-property note 'drum-type))) ;; drum
 551          (format #f "~a" (ly:music-property note 'drum-type)))
 552         (else ;; unknown?
 553          "")))
 554
 555 (define-display-method ClusterNoteEvent (note parser)
 556   (simple-note->lily-string note parser))
 557
 558 (define-display-method RestEvent (rest parser)
 559   (if (not (null? (ly:music-property rest 'pitch)))
 560       (simple-note->lily-string rest parser)
 561       "r"))
 562
 563 (define-display-method MultiMeasureRestEvent (rest parser)
 564   "R")
 565
 566 (define-display-method SkipEvent (rest parser)
 567   "s")
 568
 569 (define-display-method RepeatedChord (chord parser)
 570   (music->lily-string (ly:music-property chord 'element) parser))
 571
 572 (define-display-method MarkEvent (mark parser)
 573   (let ((label (ly:music-property mark 'label)))
 574     (if (null? label)
 575         "\\mark \\default"
 576         (format #f "\\mark ~a" (markup->lily-string label)))))
 577
 578 (define-display-method KeyChangeEvent (key parser)
 579   (let ((pitch-alist (ly:music-property key 'pitch-alist))
 580         (tonic (ly:music-property key 'tonic)))
 581     (if (or (null? pitch-alist)
 582             (null? tonic))
 583         "\\key \\default"
 584         (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
 585                                                      (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
 586           (format #f "\\key ~a \\~a~a"
 587                   (note-name->lily-string (ly:music-property key 'tonic) parser)
 588                   (any (lambda (mode)
 589                          (if (and parser
 590                                   (equal? (ly:parser-lookup parser mode) c-pitch-alist))
 591                              (symbol->string mode)
 592                              #f))
 593                        '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
 594                   (new-line->lily-string))))))
 595
 596 (define-display-method RelativeOctaveCheck (octave parser)
 597   (let ((pitch (ly:music-property octave 'pitch)))
 598     (format #f "\\octaveCheck ~a~a"
 599             (note-name->lily-string pitch parser)
 600             (octave->lily-string pitch))))
 601
 602 (define-display-method VoiceSeparator (sep parser)
 603   "\\\\")
 604
 605 (define-display-method LigatureEvent (ligature parser)
 606   (if (= START (ly:music-property ligature 'span-direction))
 607       "\\["
 608       "\\]"))
 609
 610 (define-display-method BarCheck (check parser)
 611   (format #f "|~a" (new-line->lily-string)))
 612
 613 (define-display-method PesOrFlexaEvent (expr parser)
 614   "\\~")
 615
 616 (define-display-method BassFigureEvent (figure parser)
 617   (let ((alteration (ly:music-property figure 'alteration))
 618         (fig (ly:music-property figure 'figure))
 619         (bracket-start (ly:music-property figure 'bracket-start))
 620         (bracket-stop (ly:music-property figure 'bracket-stop)))
 621
 622     (format #f "~a~a~a~a"
 623             (if (null? bracket-start) "" "[")
 624             (cond ((null? fig) "_")
 625                   ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
 626                   (else fig))
 627             (if (null? alteration)
 628                 ""
 629                 (cond
 630                   ((= alteration DOUBLE-FLAT) "--")
 631                   ((= alteration FLAT) "-")
 632                   ((= alteration NATURAL) "!")
 633                   ((= alteration SHARP) "+")
 634                   ((= alteration DOUBLE-SHARP) "++")
 635                   (else "")))
 636             (if (null? bracket-stop) "" "]"))))
 637
 638 (define-display-method LyricEvent (lyric parser)
 639   (let ((text (ly:music-property lyric 'text)))
 640     (if (or (string? text)
 641             (eqv? (first text) simple-markup))
 642         ;; a string or a simple markup
 643         (let ((string (if (string? text)
 644                           text
 645                           (second text))))
 646           (if (string-match "(\"| |[0-9])" string)
 647               ;; TODO check exactly in which cases double quotes should be used
 648               (format #f "~s" string)
 649               string))
 650         (markup->lily-string text))))
 651
 652 (define-display-method BreathingEvent (event parser)
 653   "\\breathe")
 654
 655 ;;;
 656 ;;; Staff switches
 657 ;;;
 658
 659 (define-display-method AutoChangeMusic (m parser)
 660   (format #f "\\autochange ~a"
 661           (music->lily-string (ly:music-property m 'element) parser)))
 662
 663 (define-display-method ContextChange (m parser)
 664   (format #f "\\change ~a = \"~a\""
 665           (ly:music-property m 'change-to-type)
 666           (ly:music-property m 'change-to-id)))
 667
 668 ;;;
 669
 670 (define-display-method TimeScaledMusic (times parser)
 671   (let* ((num (ly:music-property times 'numerator))
 672          (den (ly:music-property times 'denominator))
 673          (nd-gcd (gcd num den)))
 674     (parameterize ((*force-line-break* #f)
 675                    (*time-factor-numerator* (/ num nd-gcd))
 676                    (*time-factor-denominator* (/ den nd-gcd)))
 677       (format #f "\\times ~a/~a ~a"
 678               num
 679               den
 680               (music->lily-string (ly:music-property times 'element) parser)))))
 681
 682 (define-display-method RelativeOctaveMusic (m parser)
 683   (music->lily-string (ly:music-property m 'element) parser))
 684
 685 (define-display-method TransposedMusic (m parser)
 686   (music->lily-string (ly:music-property m 'element) parser))
 687
 688 ;;;
 689 ;;; Repeats
 690 ;;;
 691
 692 (define (repeat->lily-string expr repeat-type parser)
 693   (format #f "\\repeat ~a ~a ~a ~a"
 694           repeat-type
 695           (ly:music-property expr 'repeat-count)
 696           (music->lily-string (ly:music-property expr 'element) parser)
 697           (let ((alternatives (ly:music-property expr 'elements)))
 698             (if (null? alternatives)
 699                 ""
 700                 (format #f "\\alternative { ~{~a ~}}"
 701                         (map-in-order (lambda (music)
 702                                         (music->lily-string music parser))
 703                                       alternatives))))))
 704
 705 (define-display-method VoltaRepeatedMusic (expr parser)
 706   (repeat->lily-string expr "volta" parser))
 707
 708 (define-display-method UnfoldedRepeatedMusic (expr parser)
 709   (repeat->lily-string expr "unfold" parser))
 710
 711 (define-display-method PercentRepeatedMusic (expr parser)
 712   (repeat->lily-string expr "percent" parser))
 713
 714 (define-display-method TremoloRepeatedMusic (expr parser)
 715   (let* ((count (ly:music-property expr 'repeat-count))
 716          (dots (if (= 0 (modulo count 3)) 0 1))
 717          (shift (- (log2 (if (= 0 dots)
 718                              (/ (* count 2) 3)
 719                              count))))
 720          (element (ly:music-property expr 'element))
 721          (den-mult 1))
 722     (if (eqv? (ly:music-property element 'name) 'SequentialMusic)
 723         (begin
 724           (set! shift (1- shift))
 725           (set! den-mult (length (ly:music-property element 'elements)))))
 726     (music-map (lambda (m)
 727                  (let ((duration (ly:music-property m 'duration)))
 728                    (if (ly:duration? duration)
 729                        (let* ((dlog (ly:duration-log duration))
 730                               (ddots (ly:duration-dot-count duration))
 731                               (dfactor (ly:duration-factor duration))
 732                               (dnum (car dfactor))
 733                               (dden (cdr dfactor)))
 734                          (set! (ly:music-property m 'duration)
 735                                (ly:make-duration (- dlog shift)
 736                                                  ddots ;;(- ddots dots) ; ????
 737                                                  dnum
 738                                                  (/ dden den-mult))))))
 739                  m)
 740                element)
 741     (format #f "\\repeat tremolo ~a ~a"
 742             count
 743             (music->lily-string element parser))))
 744
 745 ;;;
 746 ;;; Contexts
 747 ;;;
 748
 749 (define-display-method ContextSpeccedMusic (expr parser)
 750   (let ((id    (ly:music-property expr 'context-id))
 751         (create-new (ly:music-property expr 'create-new))
 752         (music (ly:music-property expr 'element))
 753         (operations (ly:music-property expr 'property-operations))
 754         (ctype (ly:music-property expr 'context-type)))
 755     (format #f "~a ~a~a~a ~a"
 756             (if (and (not (null? create-new)) create-new)
 757                 "\\new"
 758                 "\\context")
 759             ctype
 760             (if (null? id)
 761                 ""
 762                 (format #f " = ~s" id))
 763             (if (null? operations)
 764                 ""
 765                 (format #f " \\with {~{~a~}~%~v_}"
 766                         (parameterize ((*indent* (+ (*indent*) 2)))
 767                           (map (lambda (op)
 768                                  (format #f "~%~v_\\~a ~s"
 769                                          (*indent*)
 770                                          (first op)
 771                                          (second op)))
 772                                operations))
 773                         (*indent*)))
 774             (parameterize ((*current-context* ctype))
 775               (music->lily-string music parser)))))
 776
 777 ;; special cases: \figures \lyrics \drums
 778 (define-extra-display-method ContextSpeccedMusic (expr parser)
 779   (with-music-match (expr (music 'ContextSpeccedMusic
 780                                  create-new #t
 781                                  property-operations ?op
 782                                  context-type ?context-type
 783                                  element ?sequence))
 784     (if (null? ?op)
 785         (parameterize ((*explicit-mode* #f))
 786           (case ?context-type
 787             ((FiguredBass)
 788              (format #f "\\figures ~a" (music->lily-string ?sequence parser)))
 789             ((Lyrics)
 790              (format #f "\\lyrics ~a" (music->lily-string ?sequence parser)))
 791             ((DrumStaff)
 792              (format #f "\\drums ~a" (music->lily-string ?sequence parser)))
 793             (else
 794              #f)))
 795         #f)))
 796
 797 ;;; Context properties
 798
 799 (define-extra-display-method ContextSpeccedMusic (expr parser)
 800   (let ((element (ly:music-property expr 'element))
 801         (property-tuning? (make-music-type-predicate 'PropertySet
 802                                                      'PropertyUnset
 803                                                      'OverrideProperty
 804                                                      'RevertProperty))
 805         (sequence? (make-music-type-predicate 'SequentialMusic)))
 806     (if (and (ly:music? element)
 807              (or (property-tuning? element)
 808                  (and (sequence? element)
 809                       (every property-tuning? (ly:music-property element 'elements)))))
 810         (parameterize ((*current-context* (ly:music-property expr 'context-type)))
 811           (music->lily-string element parser))
 812         #f)))
 813
 814 (define (property-value->lily-string arg parser)
 815   (cond ((ly:music? arg)
 816          (music->lily-string arg parser))
 817         ((string? arg)
 818          (format #f "#~s" arg))
 819         ((markup? arg)
 820          (markup->lily-string arg))
 821         (else
 822          (format #f "#~a" (scheme-expr->lily-string arg)))))
 823
 824 (define-display-method PropertySet (expr parser)
 825   (let ((property (ly:music-property expr 'symbol))
 826         (value (ly:music-property expr 'value))
 827         (once (ly:music-property expr 'once)))
 828     (format #f "~a\\set ~a~a = ~a~a"
 829             (if (and (not (null? once)))
 830                 "\\once "
 831                 "")
 832             (if (eqv? (*current-context*) 'Bottom)
 833                 ""
 834                 (format #f "~a . " (*current-context*)))
 835             property
 836             (property-value->lily-string value parser)
 837             (new-line->lily-string))))
 838
 839 (define-display-method PropertyUnset (expr parser)
 840   (format #f "\\unset ~a~a~a"
 841           (if (eqv? (*current-context*) 'Bottom)
 842               ""
 843               (format #f "~a . " (*current-context*)))
 844           (ly:music-property expr 'symbol)
 845           (new-line->lily-string)))
 846
 847 ;;; Layout properties
 848
 849 (define-display-method OverrideProperty (expr parser)
 850   (let* ((symbol          (ly:music-property expr 'symbol))
 851          (property-path   (ly:music-property expr 'grob-property-path))
 852          (properties      (if (pair? property-path)
 853                               property-path
 854                               (list (ly:music-property expr 'grob-property))))
 855          (value   (ly:music-property expr 'grob-value))
 856          (once    (ly:music-property expr 'once)))
 857
 858     (format #f "~a\\override ~a~a #'~a = ~a~a"
 859             (if (or (null? once)
 860                     (not once))
 861                 ""
 862                 "\\once ")
 863             (if (eqv? (*current-context*) 'Bottom)
 864                 ""
 865                 (format #f "~a . " (*current-context*)))
 866             symbol
 867             (if (null? (cdr properties))
 868                 (car properties)
 869                 properties)
 870             (property-value->lily-string value parser)
 871             (new-line->lily-string))))
 872
 873 (define-display-method RevertProperty (expr parser)
 874   (let ((symbol (ly:music-property expr 'symbol))
 875         (properties (ly:music-property expr 'grob-property-path)))
 876     (format #f "\\revert ~a~a #'~a~a"
 877             (if (eqv? (*current-context*) 'Bottom)
 878                 ""
 879                 (format #f "~a . " (*current-context*)))
 880             symbol
 881             (if (null? (cdr properties))
 882                 (car properties)
 883                 properties)
 884             (new-line->lily-string))))
 885
 886 ;;; \melisma and \melismaEnd
 887 (define-extra-display-method ContextSpeccedMusic (expr parser)
 888   "If expr is a melisma, return \"\\melisma\", otherwise, return #f."
 889   (with-music-match (expr (music 'ContextSpeccedMusic
 890                                  element (music 'PropertySet
 891                                                 value #t
 892                                                 symbol 'melismaBusy)))
 893     "\\melisma"))
 894
 895 (define-extra-display-method ContextSpeccedMusic (expr parser)
 896   "If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f."
 897   (with-music-match (expr (music 'ContextSpeccedMusic
 898                                  element (music 'PropertyUnset
 899                                                 symbol 'melismaBusy)))
 900     "\\melismaEnd"))
 901
 902 ;;; \tempo
 903 ;;; Check for all three different syntaxes of tempo:
 904 ;;; \tempo string duration=note, \tempo duration=note and \tempo string
 905 (define-extra-display-method ContextSpeccedMusic (expr parser)
 906   "If expr is a tempo, return \"\\tempo x = nnn\", otherwise return #f."
 907   (or   (with-music-match (expr (music 'ContextSpeccedMusic
 908                 element (music 'SequentialMusic
 909                               elements ((music 'PropertySet
 910                                           value ?unit-text
 911                                           symbol 'tempoText)
 912                                         (music 'PropertySet
 913                                           symbol 'tempoWholesPerMinute)
 914                                         (music 'PropertySet
 915                                           value ?unit-duration
 916                                           symbol 'tempoUnitDuration)
 917                                         (music 'PropertySet
 918                                           value ?unit-count
 919                                           symbol 'tempoUnitCount)))))
 920                 (format #f "\\tempo ~a ~a = ~a"
 921                         (scheme-expr->lily-string ?unit-text)
 922                         (duration->lily-string ?unit-duration #:force-duration #t)
 923                         ?unit-count))
 924         (with-music-match (expr (music 'ContextSpeccedMusic
 925                     element (music 'SequentialMusic
 926                               elements ((music 'PropertyUnset
 927                                           symbol 'tempoText)
 928                                         (music 'PropertySet
 929                                           symbol 'tempoWholesPerMinute)
 930                                         (music 'PropertySet
 931                                           value ?unit-duration
 932                                           symbol 'tempoUnitDuration)
 933                                         (music 'PropertySet
 934                                           value ?unit-count
 935                                           symbol 'tempoUnitCount)))))
 936                         (format #f "\\tempo ~a = ~a"
 937                                 (duration->lily-string ?unit-duration #:force-duration #t)
 938                                 ?unit-count))
 939         (with-music-match (expr (music 'ContextSpeccedMusic
 940                             element (music 'SequentialMusic
 941                                       elements ((music 'PropertySet
 942                                                   value ?tempo-text
 943                                                  symbol 'tempoText)))))
 944                         (format #f "\\tempo ~a" (scheme-expr->lily-string ?tempo-text)))))
 945
 946 ;;; \clef
 947 (define clef-name-alist #f)
 948 (define-public (memoize-clef-names clefs)
 949   "Initialize `clef-name-alist', if not already set."
 950   (if (not clef-name-alist)
 951       (set! clef-name-alist
 952             (map (lambda (name+vals)
 953                    (cons (cdr name+vals)
 954                          (car name+vals)))
 955                  clefs))))
 956
 957 (define-extra-display-method ContextSpeccedMusic (expr parser)
 958   "If `expr' is a clef change, return \"\\clef ...\"
 959 Otherwise, return #f."
 960   (with-music-match (expr (music 'ContextSpeccedMusic
 961                                  context-type 'Staff
 962                                  element (music 'SequentialMusic
 963                                                 elements ((music 'PropertySet
 964                                                                  value ?clef-glyph
 965                                                                  symbol 'clefGlyph)
 966                                                           (music 'PropertySet
 967                                                                  symbol 'middleCClefPosition)
 968                                                           (music 'PropertySet
 969                                                                  value ?clef-position
 970                                                                  symbol 'clefPosition)
 971                                                           (music 'PropertySet
 972                                                                  value ?clef-octavation
 973                                                                  symbol 'clefOctavation)
 974                                                           (music 'ApplyContext
 975                                                                  procedure ly:set-middle-C!)))))
 976     (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
 977                                  clef-name-alist)))
 978       (if clef-name
 979           (format #f "\\clef \"~a~{~a~a~}\"~a"
 980                   clef-name
 981                   (cond ((= 0 ?clef-octavation)
 982                          (list "" ""))
 983                         ((> ?clef-octavation 0)
 984                          (list "^" (1+ ?clef-octavation)))
 985                         (else
 986                          (list "_" (- 1 ?clef-octavation))))
 987                   (new-line->lily-string))
 988           #f))))
 989
 990 ;;; \time
 991 (define-extra-display-method ContextSpeccedMusic (expr parser)
 992   "If `expr' is a time signature set, return \"\\time ...\".
 993 Otherwise, return #f.  Note: default grouping is not available."
 994   (with-music-match
 995    (expr (music
 996            'ContextSpeccedMusic
 997            element (music
 998                     'ContextSpeccedMusic
 999                     context-type 'Timing
1000                     element (music
1001                              'SequentialMusic
1002                              elements ?elts))))
1003    (and
1004     (> (length ?elts) 2)
1005     (with-music-match ((cadr ?elts)
1006                        (music 'PropertySet
1007                               symbol 'baseMoment))
1008        #t)
1009     (with-music-match ((caddr ?elts)
1010                        (music 'PropertySet
1011                               symbol 'measureLength))
1012        #t)
1013     (with-music-match ((car ?elts)
1014                        (music 'PropertySet
1015                               value ?num+den
1016                               symbol 'timeSignatureFraction))
1017        (if (eq? (length ?elts) 3)
1018            (format
1019              #f "\\time ~a/~a~a"
1020              (car ?num+den) (cdr ?num+den) (new-line->lily-string))
1021            (format
1022              #f "#(set-time-signature ~a ~a '(<grouping-specifier>))~a"
1023              (car ?num+den) (cdr ?num+den)  (new-line->lily-string)))))))
1024
1025 ;;; \bar
1026 (define-extra-display-method ContextSpeccedMusic (expr parser)
1027   "If `expr' is a bar, return \"\\bar ...\".
1028 Otherwise, return #f."
1029   (with-music-match (expr (music 'ContextSpeccedMusic
1030                                  context-type 'Timing
1031                                  element (music 'PropertySet
1032                                                 value ?bar-type
1033                                                 symbol 'whichBar)))
1034      (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
1035
1036 ;;; \partial
1037 (define (duration->moment ly-duration)
1038   (let ((log2    (ly:duration-log ly-duration))
1039         (dots    (ly:duration-dot-count ly-duration))
1040         (num+den (ly:duration-factor ly-duration)))
1041     (let* ((m (expt 2 (- log2)))
1042            (factor (/ (car num+den) (cdr num+den))))
1043       (/ (do ((i 0 (1+ i))
1044               (delta (/ m 2) (/ delta 2)))
1045              ((= i dots) m)
1046            (set! m (+ m delta)))
1047          factor))))
1048
1049 (define moment-duration-alist (map (lambda (duration)
1050                                      (cons (duration->moment duration)
1051                                            duration))
1052                                    (append-map (lambda (log2)
1053                                                  (map (lambda (dots)
1054                                                         (ly:make-duration log2 dots 1 1))
1055                                                       (list 0 1 2 3)))
1056                                                (list 0 1 2 3 4))))
1057
1058 (define (moment->duration moment)
1059   (assoc-get (- moment) moment-duration-alist))
1060
1061 (define-extra-display-method ContextSpeccedMusic (expr parser)
1062   "If `expr' is a partial measure, return \"\\partial ...\".
1063 Otherwise, return #f."
1064   (with-music-match (expr (music
1065                            'ContextSpeccedMusic
1066                            element (music
1067                                     'ContextSpeccedMusic
1068                                     context-type 'Timing
1069                                     element (music
1070                                              'PropertySet
1071                                              value ?moment
1072                                              symbol 'measurePosition))))
1073      (let ((duration (moment->duration (/ (ly:moment-main-numerator ?moment)
1074                                           (ly:moment-main-denominator ?moment)))))
1075        (and duration (format #f "\\partial ~a" (duration->lily-string duration
1076                                                  #:force-duration #t))))))
1077
1078 ;;;
1079 ;;;
1080
1081 (define-display-method ApplyOutputEvent (applyoutput parser)
1082   (let ((proc (ly:music-property applyoutput 'procedure))
1083         (ctx  (ly:music-property applyoutput 'context-type)))
1084     (format #f "\\applyOutput #'~a #~a"
1085             ctx
1086             (or (procedure-name proc)
1087                 (with-output-to-string
1088                   (lambda ()
1089                     (pretty-print (procedure-source proc))))))))
1090
1091 (define-display-method ApplyContext (applycontext parser)
1092   (let ((proc (ly:music-property applycontext 'procedure)))
1093     (format #f "\\applyContext #~a"
1094             (or (procedure-name proc)
1095                 (with-output-to-string
1096                   (lambda ()
1097                     (pretty-print (procedure-source proc))))))))
1098
1099 ;;; \partcombine
1100 (define-display-method PartCombineMusic (expr parser)
1101   (format #f "\\partcombine ~{~a ~}"
1102           (map-in-order (lambda (music)
1103                           (music->lily-string music parser))
1104                         (ly:music-property expr 'elements))))
1105
1106 (define-extra-display-method PartCombineMusic (expr parser)
1107   (with-music-match (expr (music 'PartCombineMusic
1108                                  elements ((music 'UnrelativableMusic
1109                                                   element (music 'ContextSpeccedMusic
1110                                                                  context-id "one"
1111                                                                  context-type 'Voice
1112                                                                  element ?sequence1))
1113                                            (music 'UnrelativableMusic
1114                                                   element (music 'ContextSpeccedMusic
1115                                                                  context-id "two"
1116                                                                  context-type 'Voice
1117                                                                  element ?sequence2)))))
1118     (format #f "\\partcombine ~a~a~a"
1119             (music->lily-string ?sequence1 parser)
1120             (new-line->lily-string)
1121             (music->lily-string ?sequence2 parser))))
1122
1123 (define-display-method UnrelativableMusic (expr parser)
1124   (music->lily-string (ly:music-property expr 'element) parser))
1125
1126 ;;; Cue notes
1127 (define-display-method QuoteMusic (expr parser)
1128   (or (with-music-match (expr (music
1129                                'QuoteMusic
1130                                quoted-voice-direction ?quoted-voice-direction
1131                                quoted-music-name ?quoted-music-name
1132                                quoted-context-id "cue"
1133                                quoted-context-type 'Voice
1134                                element ?music))
1135         (format #f "\\cueDuring #~s #~a ~a"
1136                 ?quoted-music-name
1137                 ?quoted-voice-direction
1138                 (music->lily-string ?music parser)))
1139       (format #f "\\quoteDuring #~s ~a"
1140               (ly:music-property expr 'quoted-music-name)
1141               (music->lily-string (ly:music-property expr 'element) parser))))
1142
1143 ;;;
1144 ;;; Breaks
1145 ;;;
1146 (define-display-method LineBreakEvent (expr parser)
1147   (if (null? (ly:music-property expr 'break-permission))
1148       "\\noBreak"
1149       "\\break"))
1150
1151 (define-display-method PageBreakEvent (expr parser)
1152   (if (null? (ly:music-property expr 'break-permission))
1153       "\\noPageBreak"
1154       "\\pageBreak"))
1155
1156 (define-display-method PageTurnEvent (expr parser)
1157   (if (null? (ly:music-property expr 'break-permission))
1158       "\\noPageTurn"
1159       "\\pageTurn"))
1160
1161 (define-extra-display-method EventChord (expr parser)
1162   (with-music-match (expr (music 'EventChord
1163                             elements ((music 'LineBreakEvent
1164                                              break-permission 'force)
1165                                       (music 'PageBreakEvent
1166                                              break-permission 'force))))
1167     "\\pageBreak"))
1168
1169 (define-extra-display-method EventChord (expr parser)
1170   (with-music-match (expr (music 'EventChord
1171                             elements ((music 'LineBreakEvent
1172                                              break-permission 'force)
1173                                       (music 'PageBreakEvent
1174                                              break-permission 'force)
1175                                       (music 'PageTurnEvent
1176                                              break-permission 'force))))
1177     "\\pageTurn"))
1178
1179 ;;;
1180 ;;; Lyrics
1181 ;;;
1182
1183 ;;; \lyricsto
1184 (define-display-method LyricCombineMusic (expr parser)
1185   (format #f "\\lyricsto ~s ~a"
1186           (ly:music-property expr 'associated-context)
1187           (parameterize ((*explicit-mode* #f))
1188             (music->lily-string (ly:music-property expr 'element) parser))))
1189
1190 ;; \addlyrics
1191 (define-extra-display-method SimultaneousMusic (expr parser)
1192   (with-music-match (expr (music 'SimultaneousMusic
1193                                  elements ((music 'ContextSpeccedMusic
1194                                                   context-id ?id
1195                                                   context-type 'Voice
1196                                                   element ?note-sequence)
1197                                            (music 'ContextSpeccedMusic
1198                                                   context-type 'Lyrics
1199                                                   create-new #t
1200                                                   element (music 'LyricCombineMusic
1201                                                                  associated-context ?associated-id
1202                                                                  element ?lyric-sequence)))))
1203     (if (string=? ?id ?associated-id)
1204         (format #f "~a~a \\addlyrics ~a"
1205                 (music->lily-string ?note-sequence parser)
1206                 (new-line->lily-string)
1207                 (parameterize ((*explicit-mode* #f))
1208                   (music->lily-string ?lyric-sequence parser)))
1209         #f)))
1210
1211 ;; Silence internal event sent at end of each lyrics block
1212 (define-display-method CompletizeExtenderEvent (expr parser)
1213   "")