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