scm/define-music-display-methods.scm

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