ly/music-functions-init.ly

   1 %%%% -*- Mode: Scheme -*-
   2
   3 %%%% This file is part of LilyPond, the GNU music typesetter.
   4 %%%%
   5 %%%% Copyright (C) 2003--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 %%%%                          Jan Nieuwenhuizen <janneke@gnu.org>
   7 %%%%
   8 %%%% LilyPond is free software: you can redistribute it and/or modify
   9 %%%% it under the terms of the GNU General Public License as published by
  10 %%%% the Free Software Foundation, either version 3 of the License, or
  11 %%%% (at your option) any later version.
  12 %%%%
  13 %%%% LilyPond is distributed in the hope that it will be useful,
  14 %%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 %%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 %%%% GNU General Public License for more details.
  17 %%%%
  18 %%%% You should have received a copy of the GNU General Public License
  19 %%%% along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 \version "2.13.29"
  22
  23
  24 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  25 %% this file is alphabetically sorted.
  26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  27
  28 %% need SRFI-1 for filter; optargs for lambda*
  29 #(use-modules (srfi srfi-1)
  30               (ice-9 optargs))
  31
  32 %% TODO: using define-music-function in a .scm causes crash.
  33
  34 acciaccatura =
  35 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic
  36    (_i "Create an acciaccatura from the following music expression"))
  37
  38 %% keep these two together
  39 "instrument-definitions" = #'()
  40 addInstrumentDefinition =
  41 #(define-music-function
  42    (parser location name lst) (string? list?)
  43    (_i "Create instrument @var{name} with properties @var{list}.")
  44    (set! instrument-definitions (acons name lst instrument-definitions))
  45    (make-music 'SequentialMusic 'void #t))
  46
  47 addQuote =
  48 #(define-music-function (parser location name music) (string? ly:music?)
  49    (_i "Define @var{music} as a quotable music expression named
  50 @var{name}")
  51    (add-quotable parser name music)
  52    (make-music 'SequentialMusic 'void #t))
  53
  54 %% keep these two together
  55 afterGraceFraction = #(cons 6 8)
  56 afterGrace =
  57 #(define-music-function (parser location main grace) (ly:music? ly:music?)
  58    (_i "Create @var{grace} note(s) after a @var{main} music expression.")
  59    (let ((main-length (ly:music-length main))
  60          (fraction  (ly:parser-lookup parser 'afterGraceFraction)))
  61      (make-simultaneous-music
  62       (list
  63        main
  64        (make-sequential-music
  65         (list
  66
  67          (make-music 'SkipMusic
  68                      'duration (ly:make-duration
  69                                 0 0
  70                                 (* (ly:moment-main-numerator main-length)
  71                                    (car fraction))
  72                                 (* (ly:moment-main-denominator main-length)
  73                                    (cdr fraction))))
  74          (make-music 'GraceMusic
  75                      'element grace)))))))
  76
  77
  78 %% music identifiers not allowed at top-level,
  79 %% so this is a music-function instead.
  80 allowPageTurn =
  81 #(define-music-function (location parser) ()
  82    (_i "Allow a page turn. May be used at toplevel (ie between scores or
  83 markups), or inside a score.")
  84    (make-music 'EventChord
  85                'page-marker #t
  86                'page-turn-permission 'allow
  87                'elements (list (make-music 'PageTurnEvent
  88                                            'break-permission 'allow))))
  89
  90 applyContext =
  91 #(define-music-function (parser location proc) (procedure?)
  92    (_i "Modify context properties with Scheme procedure @var{proc}.")
  93    (make-music 'ApplyContext
  94                'origin location
  95                'procedure proc))
  96
  97 applyMusic =
  98 #(define-music-function (parser location func music) (procedure? ly:music?)
  99    (_i"Apply procedure @var{func} to @var{music}.")
 100    (func music))
 101
 102 applyOutput =
 103 #(define-music-function (parser location ctx proc) (symbol? procedure?)
 104    (_i "Apply function @code{proc} to every layout object in context @code{ctx}")
 105    (make-music 'ApplyOutputEvent
 106                'origin location
 107                'procedure proc
 108                'context-type ctx))
 109
 110 appoggiatura =
 111 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic
 112    (_i "Create an appoggiatura from @var{music}"))
 113
 114 % for regression testing purposes.
 115 assertBeamQuant =
 116 #(define-music-function (parser location l r) (pair? pair?)
 117    (_i "Testing function: check whether the beam quants @var{l} and @var{r} are correct")
 118    (make-grob-property-override 'Beam 'positions
 119                                 (ly:make-simple-closure
 120                                  (ly:make-simple-closure
 121                                   (append
 122                                    (list chain-grob-member-functions `(,cons 0 0))
 123                                    (check-quant-callbacks l r))))))
 124
 125 % for regression testing purposes.
 126 assertBeamSlope =
 127 #(define-music-function (parser location comp) (procedure?)
 128    (_i "Testing function: check whether the slope of the beam is the same as @code{comp}")
 129    (make-grob-property-override 'Beam 'positions
 130                                 (ly:make-simple-closure
 131                                  (ly:make-simple-closure
 132                                   (append
 133                                    (list chain-grob-member-functions `(,cons 0 0))
 134                                    (check-slope-callbacks comp))))))
 135
 136 autochange =
 137 #(define-music-function (parser location music) (ly:music?)
 138    (_i "Make voices that switch between staves automatically")
 139    (make-autochange-music parser music))
 140
 141
 142
 143 balloonGrobText =
 144 #(define-music-function (parser location grob-name offset text)
 145    (symbol? number-pair? markup?)
 146    (_i "Attach @var{text} to @var{grob-name} at offset @var{offset}
 147  (use like @code{\\once})")
 148    (make-music 'AnnotateOutputEvent
 149                'symbol grob-name
 150                'X-offset (car offset)
 151                'Y-offset (cdr offset)
 152                'text text))
 153
 154 balloonText =
 155 #(define-music-function (parser location offset text) (number-pair? markup?)
 156    (_i "Attach @var{text} at @var{offset} (use like @code{\\tweak})")
 157    (make-music 'AnnotateOutputEvent
 158                'X-offset (car offset)
 159                'Y-offset (cdr offset)
 160                'text text))
 161
 162 bar =
 163 #(define-music-function (parser location type) (string?)
 164    (_i "Insert a bar line of type @var{type}")
 165    (context-spec-music
 166     (make-property-set 'whichBar type)
 167     'Timing))
 168
 169 barNumberCheck =
 170 #(define-music-function (parser location n) (integer?)
 171    (_i "Print a warning if the current bar number is not @var{n}.")
 172    (make-music 'ApplyContext
 173                'origin location
 174                'procedure
 175                (lambda (c)
 176                  (let ((cbn (ly:context-property c 'currentBarNumber)))
 177                    (if (and  (number? cbn) (not (= cbn n)))
 178                        (ly:input-message location
 179                                          "Barcheck failed got ~a expect ~a"
 180                                          cbn n))))))
 181
 182 bendAfter =
 183 #(define-music-function (parser location delta) (real?)
 184    (_i "Create a fall or doit of pitch interval @var{delta}.")
 185    (make-music 'BendAfterEvent
 186                'delta-step delta))
 187
 188 bookOutputName =
 189 #(define-music-function (parser location newfilename) (string?)
 190    (_i "Direct output for the current book block to @var{newfilename}.")
 191    (set! book-filename newfilename)
 192    (make-music 'SequentialMusic 'void #t))
 193
 194 bookOutputSuffix =
 195 #(define-music-function (parser location newsuffix) (string?)
 196    (_i "Set the output filename suffix for the current book block to
 197 @var{newsuffix}.")
 198    (set! book-output-suffix newsuffix)
 199    (make-music 'SequentialMusic 'void #t))
 200
 201 %% \breathe is defined as a music function rather than an event identifier to
 202 %% ensure it gets useful input location information: as an event identifier,
 203 %% it would have to be wrapped in an EventChord to prevent it from being
 204 %% treated as a post_event by the parser
 205 breathe =
 206 #(define-music-function (parser location) ()
 207    (_i "Insert a breath mark.")
 208    (make-music 'BreathingEvent))
 209
 210
 211
 212 clef =
 213 #(define-music-function (parser location type) (string?)
 214    (_i "Set the current clef to @var{type}.")
 215    (make-clef-set type))
 216
 217
 218 compoundMeter =
 219 #(define-music-function (parser location args) (pair?)
 220   (_i "Create compound time signatures. The argument is a Scheme list of
 221 lists. Each list describes one fraction, with the last entry being the
 222 denominator, while the first entries describe the summands in the
 223 enumerator. If the time signature consists of just one fraction,
 224 the list can be given directly, i.e. not as a list containing a single list.
 225 For example, a time signature of (3+1)/8 + 2/4 would be created as
 226 @code{\\compoundMeter #'((3 1 8) (2 4))}, and a time signature of (3+2)/8
 227 as @code{\\compoundMeter #'((3 2 8))} or shorter
 228 @code{\\compoundMeter #'(3 2 8)}.")
 229   (let* ((mlen (calculate-compound-measure-length args))
 230          (beat (calculate-compound-base-beat args))
 231          (beatGrouping (calculate-compound-beat-grouping args))
 232          (timesig (cons (ly:moment-main-numerator mlen)
 233                         (ly:moment-main-denominator mlen))))
 234   #{
 235     \once \override Staff.TimeSignature #'stencil = #(lambda (grob)
 236                 (grob-interpret-markup grob (format-compound-time $args)))
 237     \set Timing.timeSignatureFraction = $timesig
 238     \set Timing.baseMoment = $beat
 239     \set Timing.beatStructure = $beatGrouping
 240     \set Timing.beamExceptions = #'()
 241     \set Timing.measureLength = $mlen
 242   #} ))
 243
 244
 245 cueClef =
 246 #(define-music-function (parser location type) (string?)
 247   (_i "Set the current cue clef to @var{type}.")
 248   (make-cue-clef-set type))
 249 cueClefUnset =
 250 #(define-music-function (parser location) ()
 251   (_i "Unset the current cue clef.")
 252   (make-cue-clef-unset))
 253
 254 cueDuring =
 255 #(define-music-function
 256    (parser location what dir main-music) (string? ly:dir? ly:music?)
 257    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 258 in a CueVoice oriented by @var{dir}.")
 259    (make-music 'QuoteMusic
 260                'element main-music
 261                'quoted-context-type 'Voice
 262                'quoted-context-id "cue"
 263                'quoted-music-name what
 264                'quoted-voice-direction dir))
 265
 266 cueDuringWithClef =
 267 #(define-music-function
 268    (parser location what dir clef main-music) (string? ly:dir? string? ly:music?)
 269    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 270 in a CueVoice oriented by @var{dir}.")
 271    (make-music 'QuoteMusic
 272                'element main-music
 273                'quoted-context-type 'Voice
 274                'quoted-context-id "cue"
 275                'quoted-music-name what
 276                'quoted-music-clef clef
 277                'quoted-voice-direction dir))
 278
 279
 280
 281 displayLilyMusic =
 282 #(define-music-function (parser location music) (ly:music?)
 283    (_i "Display the LilyPond input representation of @var{music}
 284 to the console.")
 285    (newline)
 286    (display-lily-music music parser)
 287    music)
 288
 289 displayMusic =
 290 #(define-music-function (parser location music) (ly:music?)
 291    (_i "Display the internal representation of @var{music} to the console.")
 292    (newline)
 293    (display-scheme-music music)
 294    music)
 295
 296
 297
 298 endSpanners =
 299 #(define-music-function (parser location music) (ly:music?)
 300    (_i "Terminate the next spanner prematurely after exactly one note
 301 without the need of a specific end spanner.")
 302    (if (eq? (ly:music-property music 'name) 'EventChord)
 303        (let* ((elts (ly:music-property music 'elements))
 304               (start-span-evs (filter (lambda (ev)
 305                                         (and (music-has-type ev 'span-event)
 306                                              (equal? (ly:music-property ev 'span-direction)
 307                                                      START)))
 308                                       elts))
 309               (stop-span-evs
 310                (map (lambda (m)
 311                       (let ((c (music-clone m)))
 312                         (set! (ly:music-property c 'span-direction) STOP)
 313                         c))
 314                     start-span-evs))
 315               (end-ev-chord (make-music 'EventChord
 316                                         'elements stop-span-evs))
 317               (total (make-music 'SequentialMusic
 318                                  'elements (list music
 319                                                  end-ev-chord))))
 320          total)
 321
 322        (ly:input-message location (_ "argument endSpanners is not an EventChord: ~a" music))))
 323
 324
 325
 326 featherDurations=
 327 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
 328    (_i "Adjust durations of music in @var{argument} by rational @var{factor}.")
 329    (let ((orig-duration (ly:music-length argument))
 330          (multiplier (ly:make-moment 1 1)))
 331
 332      (music-map
 333       (lambda (mus)
 334         (if (and (eq? (ly:music-property mus 'name) 'EventChord)
 335                  (< 0 (ly:moment-main-denominator (ly:music-length mus))))
 336             (begin
 337               (ly:music-compress mus multiplier)
 338               (set! multiplier (ly:moment-mul factor multiplier))))
 339         mus)
 340       argument)
 341
 342      (ly:music-compress
 343       argument
 344       (ly:moment-div orig-duration (ly:music-length argument)))
 345
 346      argument))
 347
 348
 349
 350 grace =
 351 #(def-grace-function startGraceMusic stopGraceMusic
 352    (_i "Insert @var{music} as grace notes."))
 353
 354 harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?)
 355   (let* ((fret (number->string fret))
 356          (pitch (fret->pitch fret)))
 357         (make-sequential-music
 358          (list
 359           #{
 360             \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
 361           #}
 362           (make-harmonic
 363             (calc-harmonic-pitch pitch music))
 364           #{
 365             \revert TabNoteHead #'stencil
 366           #}))))
 367
 368 harmonicByRatio = #(define-music-function (parser location ratio music) (number? ly:music?)
 369   (let ((pitch (ratio->pitch ratio))
 370         (fret (ratio->fret ratio)))
 371        (make-sequential-music
 372         (list
 373          #{
 374            \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret)
 375          #}
 376          (make-harmonic
 377            (calc-harmonic-pitch pitch music))
 378          #{
 379             \revert TabNoteHead #'stencil
 380          #}))))
 381
 382 instrumentSwitch =
 383 #(define-music-function
 384    (parser location name) (string?)
 385    (_i "Switch instrument to @var{name}, which must be predefined with
 386 @code{\\addInstrumentDefinition}.")
 387    (let* ((handle (assoc name instrument-definitions))
 388           (instrument-def (if handle (cdr handle) '())))
 389
 390      (if (not handle)
 391          (ly:input-message location "No such instrument: ~a" name))
 392      (context-spec-music
 393       (make-music 'SimultaneousMusic
 394                   'elements
 395                   (map (lambda (kv)
 396                          (make-property-set
 397                           (car kv)
 398                           (cdr kv)))
 399                        instrument-def))
 400       'Staff)))
 401
 402
 403
 404 keepWithTag =
 405 #(define-music-function (parser location tag music) (symbol? ly:music?)
 406    (_i "Include only elements of @var{music} that are tagged with @var{tag}.")
 407    (music-filter
 408     (lambda (m)
 409       (let* ((tags (ly:music-property m 'tags))
 410              (res (memq tag tags)))
 411         (or
 412          (eq? tags '())
 413          res)))
 414     music))
 415
 416 killCues =
 417 #(define-music-function (parser location music) (ly:music?)
 418    (_i "Remove cue notes from @var{music}.")
 419    (music-map
 420     (lambda (mus)
 421       (if (and (string? (ly:music-property mus 'quoted-music-name))
 422                (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
 423           (ly:music-property mus 'element)
 424           mus))
 425     music))
 426
 427
 428
 429 label =
 430 #(define-music-function (parser location label) (symbol?)
 431    (_i "Create @var{label} as a bookmarking label.")
 432    (make-music 'EventChord
 433                'page-marker #t
 434                'page-label label
 435                'elements (list (make-music 'LabelEvent
 436                                            'page-label label))))
 437
 438
 439 language =
 440 #(define-music-function (parser location language) (string?)
 441    (_i "Set note names for language @var{language}.")
 442    (note-names-language parser language)
 443    (make-music 'Music 'void #t))
 444
 445 languageSaveAndChange =
 446 #(define-music-function (parser location language) (string?)
 447   (_i "Store the previous pitchnames alist, and set a new one.")
 448   (set! previous-pitchnames pitchnames)
 449   (note-names-language parser language)
 450   (make-music 'Music 'void #t))
 451
 452 languageRestore =
 453 #(define-music-function (parser location) ()
 454    (_i "Restore a previously-saved pitchnames alist.")
 455    (if previous-pitchnames
 456        (begin
 457         (set! pitchnames previous-pitchnames)
 458         (ly:parser-set-note-names parser pitchnames))
 459       (ly:warning (_ "No other language was defined previously. Ignoring.")))
 460    (make-music 'Music 'void #t))
 461
 462
 463 makeClusters =
 464 #(define-music-function (parser location arg) (ly:music?)
 465    (_i "Display chords in @var{arg} as clusters.")
 466    (music-map note-to-cluster arg))
 467
 468 musicMap =
 469 #(define-music-function (parser location proc mus) (procedure? ly:music?)
 470    (_i "Apply @var{proc} to @var{mus} and all of the music it contains.")
 471    (music-map proc mus))
 472
 473
 474
 475 %% noPageBreak and noPageTurn are music functions (not music indentifiers),
 476 %% because music identifiers are not allowed at top-level.
 477 noPageBreak =
 478 #(define-music-function (location parser) ()
 479    (_i "Forbid a page break.  May be used at toplevel (i.e., between scores or
 480 markups), or inside a score.")
 481    (make-music 'EventChord
 482                'page-marker #t
 483                'page-break-permission 'forbid
 484                'elements (list (make-music 'PageBreakEvent
 485                                            'break-permission '()))))
 486
 487 noPageTurn =
 488 #(define-music-function (location parser) ()
 489    (_i "Forbid a page turn.  May be used at toplevel (i.e., between scores or
 490 markups), or inside a score.")
 491    (make-music 'EventChord
 492                'page-marker #t
 493                'page-turn-permission 'forbid
 494                'elements (list (make-music 'PageTurnEvent
 495                                            'break-permission '()))))
 496
 497
 498
 499 octaveCheck =
 500 #(define-music-function (parser location pitch-note) (ly:music?)
 501    (_i "Octave check.")
 502    (make-music 'RelativeOctaveCheck
 503                'origin location
 504                'pitch (pitch-of-note pitch-note)))
 505
 506 ottava =
 507 #(define-music-function (parser location octave) (integer?)
 508    (_i "Set the octavation.")
 509    (make-music 'OttavaMusic
 510                'ottava-number octave))
 511
 512 overrideTimeSignatureSettings =
 513 #(define-music-function
 514    (parser location time-signature base-moment beat-structure beam-exceptions)
 515    (pair? pair? cheap-list? cheap-list?)
 516
 517    (_i "Override @code{timeSignatureSettings}
 518 for time signatures of @var{time-signature} to have settings
 519 of @var{base-moment}, @var{beat-structure}, and @var{beam-exceptions}.")
 520
 521    ;; TODO -- add warning if largest value of grouping is
 522    ;;       greater than time-signature.
 523   (let ((setting (make-setting base-moment beat-structure beam-exceptions)))
 524     (override-time-signature-setting time-signature setting)))
 525
 526 overrideProperty =
 527 #(define-music-function (parser location name property value)
 528    (string? symbol? scheme?)
 529
 530    (_i "Set @var{property} to @var{value} in all grobs named @var{name}.
 531 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
 532 or @code{\"GrobName\"}.")
 533
 534    (let ((name-components (string-split name #\.))
 535          (context-name 'Bottom)
 536          (grob-name #f))
 537
 538      (if (> 2 (length name-components))
 539          (set! grob-name (string->symbol (car name-components)))
 540          (begin
 541            (set! grob-name (string->symbol (list-ref name-components 1)))
 542            (set! context-name (string->symbol (list-ref name-components 0)))))
 543
 544      (make-music 'ApplyOutputEvent
 545                  'origin location
 546                  'context-type context-name
 547                  'procedure
 548                  (lambda (grob orig-context context)
 549                    (if (equal?
 550                         (cdr (assoc 'name (ly:grob-property grob 'meta)))
 551                         grob-name)
 552                        (set! (ly:grob-property grob property) value))))))
 553
 554
 555
 556 %% pageBreak and pageTurn are music functions (iso music indentifiers),
 557 %% because music identifiers are not allowed at top-level.
 558 pageBreak =
 559 #(define-music-function (location parser) ()
 560    (_i "Force a page break.  May be used at toplevel (i.e., between scores or
 561 markups), or inside a score.")
 562    (make-music 'EventChord
 563                'page-marker #t
 564                'line-break-permission 'force
 565                'page-break-permission 'force
 566                'elements (list (make-music 'LineBreakEvent
 567                                            'break-permission 'force)
 568                                (make-music 'PageBreakEvent
 569                                            'break-permission 'force))))
 570
 571 pageTurn =
 572 #(define-music-function (location parser) ()
 573    (_i "Force a page turn between two scores or top-level markups.")
 574    (make-music 'EventChord
 575                'page-marker #t
 576                'line-break-permission 'force
 577                'page-break-permission 'force
 578                'page-turn-permission 'force
 579                'elements (list (make-music 'LineBreakEvent
 580                                            'break-permission 'force)
 581                                (make-music 'PageBreakEvent
 582                                            'break-permission 'force)
 583                                (make-music 'PageTurnEvent
 584                                            'break-permission 'force))))
 585
 586 parallelMusic =
 587 #(define-music-function (parser location voice-ids music) (list? ly:music?)
 588    (_i "Define parallel music sequences, separated by '|' (bar check signs),
 589 and assign them to the identifiers provided in @var{voice-ids}.
 590
 591 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
 592
 593 @var{music}: a music sequence, containing BarChecks as limiting expressions.
 594
 595 Example:
 596
 597 @verbatim
 598   \\parallelMusic #'(A B C) {
 599     c c | d d | e e |
 600     d d | e e | f f |
 601   }
 602 <==>
 603   A = { c c | d d | }
 604   B = { d d | e e | }
 605   C = { e e | f f | }
 606 @end verbatim
 607 ")
 608    (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
 609           (current-voices voices)
 610           (current-sequence (list)))
 611      ;;
 612      ;; utilities
 613      (define (push-music m)
 614        "Push the music expression into the current sequence"
 615        (set! current-sequence (cons m current-sequence)))
 616      (define (change-voice)
 617        "Stores the previously built sequence into the current voice and
 618        change to the following voice."
 619        (list-set! current-voices 0 (cons (make-music 'SequentialMusic
 620                                                      'elements (reverse! current-sequence))
 621                                          (car current-voices)))
 622        (set! current-sequence (list))
 623        (set! current-voices (cdr current-voices)))
 624      (define (bar-check? m)
 625        "Checks whether m is a bar check."
 626        (eq? (ly:music-property m 'name) 'BarCheck))
 627      (define (music-origin music)
 628        "Recursively search an origin location stored in music."
 629        (cond ((null? music) #f)
 630              ((not (null? (ly:music-property music 'origin)))
 631               (ly:music-property music 'origin))
 632              (else (or (music-origin (ly:music-property music 'element))
 633                        (let ((origins (remove not (map music-origin
 634                                                        (ly:music-property music 'elements)))))
 635                          (and (not (null? origins)) (car origins)))))))
 636      ;;
 637      ;; first, split the music and fill in voices
 638      (map-in-order (lambda (m)
 639                      (push-music m)
 640                      (if (bar-check? m) (change-voice)))
 641                    (ly:music-property music 'elements))
 642      (if (not (null? current-sequence)) (change-voice))
 643      ;; un-circularize `voices' and reorder the voices
 644      (set! voices (map-in-order (lambda (dummy seqs)
 645                                   (reverse! seqs))
 646                                 voice-ids voices))
 647      ;;
 648      ;; set origin location of each sequence in each voice
 649      ;; for better type error tracking
 650      (for-each (lambda (voice)
 651                  (for-each (lambda (seq)
 652                              (set! (ly:music-property seq 'origin)
 653                                    (or (music-origin seq) location)))
 654                            voice))
 655                voices)
 656      ;;
 657      ;; check sequence length
 658      (apply for-each (lambda* (#:rest seqs)
 659                               (let ((moment-reference (ly:music-length (car seqs))))
 660                                 (for-each (lambda (seq moment)
 661                                             (if (not (equal? moment moment-reference))
 662                                                 (ly:music-message seq
 663                                                                   "Bars in parallel music don't have the same length")))
 664                                           seqs (map-in-order ly:music-length seqs))))
 665             voices)
 666      ;;
 667      ;; bind voice identifiers to the voices
 668      (map (lambda (voice-id voice)
 669             (ly:parser-define! parser voice-id
 670                                (make-music 'SequentialMusic
 671                                            'origin location
 672                                            'elements voice)))
 673           voice-ids voices))
 674    ;; Return an empty sequence.  This function is actually a "void" function.
 675    (make-music 'SequentialMusic 'void #t))
 676
 677 parenthesize =
 678 #(define-music-function (parser loc arg) (ly:music?)
 679    (_i "Tag @var{arg} to be parenthesized.")
 680
 681    (if (memq 'event-chord (ly:music-property arg 'types))
 682        ;; arg is an EventChord -> set the parenthesize property
 683        ;; on all child notes and rests
 684        (map
 685         (lambda (ev)
 686           (if (or (memq 'note-event (ly:music-property ev 'types))
 687                   (memq 'rest-event (ly:music-property ev 'types)))
 688               (set! (ly:music-property ev 'parenthesize) #t)))
 689         (ly:music-property arg 'elements))
 690        ;; No chord, simply set property for this expression:
 691        (set! (ly:music-property arg 'parenthesize) #t))
 692    arg)
 693
 694 partcombine =
 695 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
 696    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 697 that they share a staff.")
 698    (make-part-combine-music parser
 699                             (list part1 part2)))
 700
 701 partcombineForce =
 702 #(define-music-function (location parser type once) (symbol-or-boolean? boolean?)
 703    (_i "Override the part-combiner.")
 704    (make-music 'EventChord
 705                'elements (list (make-music 'PartCombineForceEvent
 706                                            'forced-type type
 707                                            'once once))))
 708 partcombineApart = \partcombineForce #'apart ##f
 709 partcombineApartOnce = \partcombineForce #'apart ##t
 710 partcombineChords = \partcombineForce #'chords ##f
 711 partcombineChordsOnce = \partcombineForce #'chords ##t
 712 partcombineUnisono = \partcombineForce #'unisono ##f
 713 partcombineUnisonoOnce = \partcombineForce #'unisono ##t
 714 partcombineSoloI = \partcombineForce #'solo1 ##f
 715 partcombineSoloIOnce = \partcombineForce #'solo1 ##t
 716 partcombineSoloII = \partcombineForce #'solo2 ##f
 717 partcombineSoloIIOnce = \partcombineForce #'solo2 ##t
 718 partcombineAutomatic = \partcombineForce ##f ##f
 719 partcombineAutomaticOnce = \partcombineForce ##f ##t
 720
 721
 722 pitchedTrill =
 723 #(define-music-function
 724    (parser location main-note secondary-note)
 725    (ly:music? ly:music?)
 726    (_i "Print a trill with @var{main-note} as the main note of the trill and
 727 print @var{secondary-note} as a stemless note head in parentheses.")
 728    (let* ((get-notes (lambda (ev-chord)
 729                        (filter
 730                         (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
 731                         (ly:music-property ev-chord 'elements))))
 732           (sec-note-events (get-notes secondary-note))
 733           (trill-events (filter (lambda (m) (music-has-type m 'trill-span-event))
 734                                 (ly:music-property main-note 'elements))))
 735
 736      (if (pair? sec-note-events)
 737          (begin
 738            (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch))
 739                   (forced (ly:music-property (car sec-note-events) 'force-accidental)))
 740
 741              (if (ly:pitch? trill-pitch)
 742                  (for-each (lambda (m)
 743                              (ly:music-set-property! m 'pitch trill-pitch)) trill-events)
 744                  (begin
 745                    (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
 746                    (display sec-note-events)))
 747
 748              (if (eq? forced #t)
 749                  (for-each (lambda (m)
 750                              (ly:music-set-property! m 'force-accidental forced))
 751                            trill-events)))))
 752      main-note))
 753
 754 quoteDuring =
 755 #(define-music-function (parser location what main-music) (string? ly:music?)
 756    (_i "Indicate a section of music to be quoted.  @var{what} indicates the name
 757 of the quoted voice, as specified in an @code{\\addQuote} command.
 758 @var{main-music} is used to indicate the length of music to be quoted;
 759 usually contains spacers or multi-measure rests.")
 760    (make-music 'QuoteMusic
 761                'element main-music
 762                'quoted-music-name what
 763                'origin location))
 764
 765 removeWithTag =
 766 #(define-music-function (parser location tag music) (symbol? ly:music?)
 767    (_i "Remove elements of @var{music} that are tagged with @var{tag}.")
 768    (music-filter
 769     (lambda (m)
 770       (let* ((tags (ly:music-property m 'tags))
 771              (res (memq tag tags)))
 772         (not res)))
 773     music))
 774
 775 resetRelativeOctave =
 776 #(define-music-function (parser location reference-note) (ly:music?)
 777    (_i "Set the octave inside a \\relative section.")
 778
 779    (let* ((notes (ly:music-property reference-note 'elements))
 780           (pitch (ly:music-property (car notes) 'pitch)))
 781
 782      (set! (ly:music-property reference-note 'elements) '())
 783      (set! (ly:music-property reference-note 'to-relative-callback)
 784            (lambda (music last-pitch)
 785              pitch))
 786
 787      reference-note))
 788
 789 revertTimeSignatureSettings =
 790 #(define-music-function
 791    (parser location time-signature)
 792    (pair?)
 793
 794    (_i "Revert @code{timeSignatureSettings}
 795 for time signatures of @var{time-signature}.")
 796    (revert-time-signature-setting time-signature))
 797
 798 rightHandFinger =
 799 #(define-music-function (parser location finger) (number-or-string?)
 800    (_i "Apply @var{finger} as a fingering indication.")
 801
 802    (apply make-music
 803           (append
 804            (list
 805             'StrokeFingerEvent
 806             'origin location)
 807            (if  (string? finger)
 808                 (list 'text finger)
 809                 (list 'digit finger)))))
 810
 811
 812
 813 scaleDurations =
 814 #(define-music-function (parser location fraction music)
 815    (number-pair? ly:music?)
 816    (_i "Multiply the duration of events in @var{music} by @var{fraction}.")
 817    (ly:music-compress music
 818                       (ly:make-moment (car fraction) (cdr fraction))))
 819
 820 shiftDurations =
 821 #(define-music-function (parser location dur dots arg)
 822    (integer? integer? ly:music?)
 823    (_i "Scale @var{arg} up by a factor of @var{2^dur*(2-(1/2)^dots)}.")
 824
 825    (music-map
 826     (lambda (x)
 827       (shift-one-duration-log x dur dots)) arg))
 828
 829 spacingTweaks =
 830 #(define-music-function (parser location parameters) (list?)
 831    (_i "Set the system stretch, by reading the 'system-stretch property of
 832 the `parameters' assoc list.")
 833    #{
 834      \overrideProperty #"Score.NonMusicalPaperColumn"
 835      #'line-break-system-details
 836      #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters)))
 837              (cons 'system-Y-extent (cdr (assoc 'system-Y-extent parameters))))
 838    #})
 839
 840 styledNoteHeads =
 841 #(define-music-function (parser location style heads music)
 842    (symbol? list-or-symbol? ly:music?)
 843    (_i "Set @var{heads} in @var{music} to @var{style}.")
 844    (style-note-heads heads style music))
 845
 846
 847
 848 tabChordRepetition =
 849 #(define-music-function (parser location) ()
 850    (_i "Include the string information in a chord repetition.")
 851    (ly:parser-set-repetition-function parser tab-repeat-chord)
 852    (make-music 'SequentialMusic 'void #t))
 853
 854 tag =
 855 #(define-music-function (parser location tag arg) (symbol? ly:music?)
 856
 857    (_i "Add @var{tag} to the @code{tags} property of @var{arg}.")
 858
 859    (set!
 860     (ly:music-property arg 'tags)
 861     (cons tag
 862           (ly:music-property arg 'tags)))
 863    arg)
 864
 865 transposedCueDuring =
 866 #(define-music-function
 867    (parser location what dir pitch-note main-music)
 868    (string? ly:dir? ly:music? ly:music?)
 869
 870    (_i "Insert notes from the part @var{what} into a voice called @code{cue},
 871 using the transposition defined by @var{pitch-note}.  This happens
 872 simultaneously with @var{main-music}, which is usually a rest.  The
 873 argument @var{dir} determines whether the cue notes should be notated
 874 as a first or second voice.")
 875
 876    (make-music 'QuoteMusic
 877                'element main-music
 878                'quoted-context-type 'Voice
 879                'quoted-context-id "cue"
 880                'quoted-music-name what
 881                'quoted-voice-direction dir
 882                'quoted-transposition (pitch-of-note pitch-note)
 883                'origin location))
 884
 885 transposition =
 886 #(define-music-function (parser location pitch-note) (ly:music?)
 887    (_i "Set instrument transposition")
 888
 889    (context-spec-music
 890     (make-property-set 'instrumentTransposition
 891                        (ly:pitch-negate (pitch-of-note pitch-note)))
 892     'Staff))
 893
 894 tweak =
 895 #(define-music-function (parser location sym val arg)
 896    (symbol? scheme? ly:music?)
 897    (_i "Add @code{sym . val} to the @code{tweaks} property of @var{arg}.")
 898
 899    (if (equal? (object-property sym 'backend-type?) #f)
 900        (begin
 901          (ly:warning (_ "cannot find property type-check for ~a") sym)
 902          (ly:warning (_ "doing assignment anyway"))))
 903    (set!
 904     (ly:music-property arg 'tweaks)
 905     (acons sym val
 906            (ly:music-property arg 'tweaks)))
 907    arg)
 908
 909
 910
 911 unfoldRepeats =
 912 #(define-music-function (parser location music) (ly:music?)
 913    (_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or
 914 @code{\\repeat percent} commands in @var{music} to be interpreted
 915 as @code{\\repeat unfold}.")
 916    (unfold-repeats music))
 917
 918
 919
 920 withMusicProperty =
 921 #(define-music-function (parser location sym val music)
 922    (symbol? scheme? ly:music?)
 923    (_i "Set @var{sym} to @var{val} in @var{music}.")
 924
 925    (set! (ly:music-property music sym) val)
 926    music)