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--2012 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.15.18"
  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-void-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
  46 addQuote =
  47 #(define-void-function (parser location name music) (string? ly:music?)
  48    (_i "Define @var{music} as a quotable music expression named
  49 @var{name}")
  50    (add-quotable parser name music))
  51
  52 %% keep these two together
  53 afterGraceFraction = #(cons 6 8)
  54 afterGrace =
  55 #(define-music-function (parser location main grace) (ly:music? ly:music?)
  56    (_i "Create @var{grace} note(s) after a @var{main} music expression.")
  57    (let ((main-length (ly:music-length main))
  58          (fraction  (ly:parser-lookup parser 'afterGraceFraction)))
  59      (make-simultaneous-music
  60       (list
  61        main
  62        (make-sequential-music
  63         (list
  64
  65          (make-music 'SkipMusic
  66                      'duration (ly:make-duration
  67                                 0 0
  68                                 (* (ly:moment-main-numerator main-length)
  69                                    (car fraction))
  70                                 (* (ly:moment-main-denominator main-length)
  71                                    (cdr fraction))))
  72          (make-music 'GraceMusic
  73                      'element grace)))))))
  74
  75
  76 %% music identifiers not allowed at top-level,
  77 %% so this is a music-function instead.
  78 allowPageTurn =
  79 #(define-music-function (location parser) ()
  80    (_i "Allow a page turn. May be used at toplevel (ie between scores or
  81 markups), or inside a score.")
  82    (make-music 'EventChord
  83                'page-marker #t
  84                'page-turn-permission 'allow
  85                'elements (list (make-music 'PageTurnEvent
  86                                            'break-permission 'allow))))
  87
  88 appendToTag =
  89 #(define-music-function (parser location tag more music)
  90    (symbol? ly:music? ly:music?)
  91    (_i "Append @var{more} to the @code{elements} of all music
  92 expressions in @var{music} that are tagged with @var{tag}.")
  93    (music-map (lambda (m)
  94                 (if (memq tag (ly:music-property m 'tags))
  95                     (set! (ly:music-property m 'elements)
  96                           (append (ly:music-property m 'elements)
  97                                   (list more))))
  98                 m)
  99               music))
 100
 101 applyContext =
 102 #(define-music-function (parser location proc) (procedure?)
 103    (_i "Modify context properties with Scheme procedure @var{proc}.")
 104    (make-music 'ApplyContext
 105                'procedure proc))
 106
 107 applyMusic =
 108 #(define-music-function (parser location func music) (procedure? ly:music?)
 109    (_i"Apply procedure @var{func} to @var{music}.")
 110    (func music))
 111
 112 applyOutput =
 113 #(define-music-function (parser location ctx proc) (symbol? procedure?)
 114    (_i "Apply function @code{proc} to every layout object in context @code{ctx}")
 115    (make-music 'ApplyOutputEvent
 116                'procedure proc
 117                'context-type ctx))
 118
 119 appoggiatura =
 120 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic
 121    (_i "Create an appoggiatura from @var{music}"))
 122
 123 % for regression testing purposes.
 124 assertBeamQuant =
 125 #(define-music-function (parser location l r) (pair? pair?)
 126    (_i "Testing function: check whether the beam quants @var{l} and @var{r} are correct")
 127    (make-grob-property-override 'Beam 'positions (check-quant-callbacks l r)))
 128
 129 % for regression testing purposes.
 130 assertBeamSlope =
 131 #(define-music-function (parser location comp) (procedure?)
 132    (_i "Testing function: check whether the slope of the beam is the same as @code{comp}")
 133    (make-grob-property-override 'Beam 'positions (check-slope-callbacks comp)))
 134
 135 autochange =
 136 #(define-music-function (parser location music) (ly:music?)
 137    (_i "Make voices that switch between staves automatically")
 138    (make-autochange-music parser music))
 139
 140
 141
 142 balloonGrobText =
 143 #(define-music-function (parser location grob-name offset text)
 144    (symbol? number-pair? markup?)
 145    (_i "Attach @var{text} to @var{grob-name} at offset @var{offset}
 146  (use like @code{\\once})")
 147    (make-music 'AnnotateOutputEvent
 148                'symbol grob-name
 149                'X-offset (car offset)
 150                'Y-offset (cdr offset)
 151                'text text))
 152
 153 balloonText =
 154 #(define-music-function (parser location offset text) (number-pair? markup?)
 155    (_i "Attach @var{text} at @var{offset} (use like @code{\\tweak})")
 156    (make-music 'AnnotateOutputEvent
 157                'X-offset (car offset)
 158                'Y-offset (cdr offset)
 159                'text text))
 160
 161 bar =
 162 #(define-music-function (parser location type) (string?)
 163    (_i "Insert a bar line of type @var{type}")
 164    (context-spec-music
 165     (make-property-set 'whichBar type)
 166     'Timing))
 167
 168 barNumberCheck =
 169 #(define-music-function (parser location n) (integer?)
 170    (_i "Print a warning if the current bar number is not @var{n}.")
 171    (make-music 'ApplyContext
 172                'procedure
 173                (lambda (c)
 174                  (let ((cbn (ly:context-property c 'currentBarNumber)))
 175                    (if (and  (number? cbn) (not (= cbn n)))
 176                        (ly:input-warning location
 177                                          "Barcheck failed got ~a expect ~a"
 178                                          cbn n))))))
 179
 180 bendAfter =
 181 #(define-music-function (parser location delta) (real?)
 182    (_i "Create a fall or doit of pitch interval @var{delta}.")
 183    (make-music 'BendAfterEvent
 184                'delta-step delta))
 185
 186 bookOutputName =
 187 #(define-void-function (parser location newfilename) (string?)
 188    (_i "Direct output for the current book block to @var{newfilename}.")
 189    (set! (paper-variable parser #f 'output-filename) newfilename))
 190
 191 bookOutputSuffix =
 192 #(define-void-function (parser location newsuffix) (string?)
 193    (_i "Set the output filename suffix for the current book block to
 194 @var{newsuffix}.")
 195    (set! (paper-variable parser #f 'output-suffix) newsuffix))
 196
 197 %% \breathe is defined as a music function rather than an event identifier to
 198 %% ensure it gets useful input location information: as an event identifier,
 199 %% it would have to be wrapped in an EventChord to prevent it from being
 200 %% treated as a post_event by the parser
 201 breathe =
 202 #(define-music-function (parser location) ()
 203    (_i "Insert a breath mark.")
 204    (make-music 'BreathingEvent))
 205
 206 clef =
 207 #(define-music-function (parser location type) (string?)
 208    (_i "Set the current clef to @var{type}.")
 209    (make-clef-set type))
 210
 211
 212 compoundMeter =
 213 #(define-music-function (parser location args) (pair?)
 214   (_i "Create compound time signatures. The argument is a Scheme list of
 215 lists. Each list describes one fraction, with the last entry being the
 216 denominator, while the first entries describe the summands in the
 217 enumerator. If the time signature consists of just one fraction,
 218 the list can be given directly, i.e. not as a list containing a single list.
 219 For example, a time signature of (3+1)/8 + 2/4 would be created as
 220 @code{\\compoundMeter #'((3 1 8) (2 4))}, and a time signature of (3+2)/8
 221 as @code{\\compoundMeter #'((3 2 8))} or shorter
 222 @code{\\compoundMeter #'(3 2 8)}.")
 223   (let* ((mlen (calculate-compound-measure-length args))
 224          (beat (calculate-compound-base-beat args))
 225          (beatGrouping (calculate-compound-beat-grouping args))
 226          (timesig (cons (ly:moment-main-numerator mlen)
 227                         (ly:moment-main-denominator mlen))))
 228   #{
 229     \once \override Staff.TimeSignature #'stencil = #(lambda (grob)
 230                 (grob-interpret-markup grob (format-compound-time args)))
 231     \set Timing.timeSignatureFraction = $timesig
 232     \set Timing.baseMoment = $beat
 233     \set Timing.beatStructure = $beatGrouping
 234     \set Timing.beamExceptions = #'()
 235     \set Timing.measureLength = $mlen
 236   #} ))
 237
 238
 239 cueClef =
 240 #(define-music-function (parser location type) (string?)
 241   (_i "Set the current cue clef to @var{type}.")
 242   (make-cue-clef-set type))
 243 cueClefUnset =
 244 #(define-music-function (parser location) ()
 245   (_i "Unset the current cue clef.")
 246   (make-cue-clef-unset))
 247
 248 cueDuring =
 249 #(define-music-function
 250    (parser location what dir main-music) (string? ly:dir? ly:music?)
 251    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 252 in a CueVoice oriented by @var{dir}.")
 253    (make-music 'QuoteMusic
 254                'element main-music
 255                'quoted-context-type 'Voice
 256                'quoted-context-id "cue"
 257                'quoted-music-name what
 258                'quoted-voice-direction dir))
 259
 260 cueDuringWithClef =
 261 #(define-music-function
 262    (parser location what dir clef main-music) (string? ly:dir? string? ly:music?)
 263    (_i "Insert contents of quote @var{what} corresponding to @var{main-music},
 264 in a CueVoice oriented by @var{dir}.")
 265    (make-music 'QuoteMusic
 266                'element main-music
 267                'quoted-context-type 'Voice
 268                'quoted-context-id "cue"
 269                'quoted-music-name what
 270                'quoted-music-clef clef
 271                'quoted-voice-direction dir))
 272
 273
 274
 275 displayLilyMusic =
 276 #(define-music-function (parser location music) (ly:music?)
 277    (_i "Display the LilyPond input representation of @var{music}
 278 to the console.")
 279    (newline)
 280    (display-lily-music music parser)
 281    music)
 282
 283 displayMusic =
 284 #(define-music-function (parser location music) (ly:music?)
 285    (_i "Display the internal representation of @var{music} to the console.")
 286    (newline)
 287    (display-scheme-music music)
 288    music)
 289
 290
 291
 292 endSpanners =
 293 #(define-music-function (parser location music) (ly:music?)
 294    (_i "Terminate the next spanner prematurely after exactly one note
 295 without the need of a specific end spanner.")
 296    (if (memq (ly:music-property music 'name) '(EventChord NoteEvent))
 297        (let* ((start-span-evs (filter (lambda (ev)
 298                                         (equal? (ly:music-property ev 'span-direction)
 299                                                 START))
 300                                       (extract-typed-music music 'span-event)))
 301               (stop-span-evs
 302                (map (lambda (m)
 303                       (let ((c (music-clone m)))
 304                         (set! (ly:music-property c 'span-direction) STOP)
 305                         c))
 306                     start-span-evs))
 307               (end-ev-chord (make-music 'EventChord
 308                                         'elements stop-span-evs))
 309               (total (make-music 'SequentialMusic
 310                                  'elements (list music
 311                                                  end-ev-chord))))
 312          total)
 313
 314        (begin
 315          (ly:input-message location (_ "argument endSpanners is not an EventChord: ~a") music)
 316          music)))
 317
 318 eventChords =
 319 #(define-music-function (parser location music) (ly:music?)
 320    (_i "Compatibility function wrapping @code{EventChord} around
 321 isolated rhythmic events occuring since version 2.15.28, after
 322 expanding repeat chords @samp{q}.")
 323    (event-chord-wrap! music parser))
 324
 325 featherDurations=
 326 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
 327    (_i "Adjust durations of music in @var{argument} by rational @var{factor}.")
 328    (let ((orig-duration (ly:music-length argument))
 329          (multiplier (ly:make-moment 1 1)))
 330
 331      (for-each
 332       (lambda (mus)
 333         (if (< 0 (ly:moment-main-denominator (ly:music-length mus)))
 334             (begin
 335               (ly:music-compress mus multiplier)
 336               (set! multiplier (ly:moment-mul factor multiplier)))))
 337       (extract-named-music argument '(EventChord NoteEvent RestEvent SkipEvent)))
 338      (ly:music-compress
 339       argument
 340       (ly:moment-div orig-duration (ly:music-length argument)))
 341
 342      argument))
 343
 344 footnote =
 345 #(define-music-function (parser location text offset grob-name footnote)
 346    ((markup?) number-pair? (symbol? '()) markup?)
 347    (_i "Attach @var{text} at @var{offset} with @var{text} referring to
 348 @var{footnote}.  If @var{text} is given as @code{\\default}, use
 349 autonumbering instead.  Note that, for this to take effect,
 350 auto-numbering must be turned on in the paper block.  Otherwise, no
 351 number will appear.  Footnotes are applied like articulations.  If a
 352 symbol @var{grob-name} is specified, all grobs of that kind at the
 353 current time step are affected.")
 354    (make-music
 355     'FootnoteEvent
 356     'X-offset (car offset)
 357     'Y-offset (cdr offset)
 358     'automatically-numbered (not text)
 359     'text (or text (make-null-markup))
 360     'footnote-text footnote
 361     'symbol grob-name))
 362
 363 grace =
 364 #(def-grace-function startGraceMusic stopGraceMusic
 365    (_i "Insert @var{music} as grace notes."))
 366
 367 grobdescriptions =
 368 #(define-scheme-function (parser location descriptions) (list?)
 369    (_i "Create a context modification from @var{descriptions}, a list
 370 in the format of @code{all-grob-descriptions}.")
 371    (ly:make-context-mod
 372     (map (lambda (p)
 373            (list 'assign (car p) (list (cdr p))))
 374          descriptions)))
 375
 376 harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?)
 377   (_i "Convert @var{music} into harmonics; the resulting notes resemble
 378 harmonics played on a fretted instrument by touching the strings above @var{fret}.")
 379   (let* ((fret (number->string fret))
 380          (pitch (fret->pitch fret)))
 381         (make-sequential-music
 382          (list
 383           #{
 384             \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label fret)
 385           #}
 386           (make-harmonic
 387             (calc-harmonic-pitch pitch music))
 388           #{
 389             \revert TabNoteHead #'stencil
 390           #}))))
 391
 392 harmonicByRatio = #(define-music-function (parser location ratio music) (number? ly:music?)
 393     (_i "Convert @var{music} into harmonics; the resulting notes resemble
 394 harmonics played on a fretted instrument by touching the strings above the point
 395 given through @var{ratio}.")
 396   (let ((pitch (ratio->pitch ratio))
 397         (fret (ratio->fret ratio)))
 398        (make-sequential-music
 399         (list
 400          #{
 401            \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label fret)
 402          #}
 403          (make-harmonic
 404            (calc-harmonic-pitch pitch music))
 405          #{
 406             \revert TabNoteHead #'stencil
 407          #}))))
 408
 409 instrumentSwitch =
 410 #(define-music-function
 411    (parser location name) (string?)
 412    (_i "Switch instrument to @var{name}, which must be predefined with
 413 @code{\\addInstrumentDefinition}.")
 414    (let* ((handle (assoc name instrument-definitions))
 415           (instrument-def (if handle (cdr handle) '())))
 416
 417      (if (not handle)
 418          (ly:input-warning location "No such instrument: ~a" name))
 419      (context-spec-music
 420       (make-music 'SimultaneousMusic
 421                   'elements
 422                   (map (lambda (kv)
 423                          (make-property-set
 424                           (car kv)
 425                           (cdr kv)))
 426                        instrument-def))
 427       'Staff)))
 428
 429
 430
 431 keepWithTag =
 432 #(define-music-function (parser location tag music) (symbol? ly:music?)
 433    (_i "Include only elements of @var{music} that are tagged with @var{tag}.")
 434    (music-filter
 435     (lambda (m)
 436       (let* ((tags (ly:music-property m 'tags))
 437              (res (memq tag tags)))
 438         (or
 439          (eq? tags '())
 440          res)))
 441     music))
 442
 443 key =
 444 #(define-music-function (parser location tonic pitch-alist)
 445    ((ly:pitch? '()) (list? '()))
 446    (_i "Set key to @var{tonic} and scale @var{pitch-alist}.
 447 If both are null, just generate @code{KeyChangeEvent}.")
 448    (cond ((null? tonic) (make-music 'KeyChangeEvent))
 449          ((null? pitch-alist)
 450           (ly:parser-error parser (_ "second argument must be pitch list")
 451                            location)
 452           (make-music 'SequentialMusic 'void #t))
 453          (else
 454           (ly:music-transpose
 455            (make-music 'KeyChangeEvent
 456                 'tonic (ly:make-pitch 0 0 0)
 457                 'pitch-alist pitch-alist)
 458            tonic))))
 459
 460 killCues =
 461 #(define-music-function (parser location music) (ly:music?)
 462    (_i "Remove cue notes from @var{music}.")
 463    (music-map
 464     (lambda (mus)
 465       (if (and (string? (ly:music-property mus 'quoted-music-name))
 466                (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
 467           (ly:music-property mus 'element)
 468           mus))
 469     music))
 470
 471
 472
 473 label =
 474 #(define-music-function (parser location label) (symbol?)
 475    (_i "Create @var{label} as a bookmarking label.")
 476    (make-music 'EventChord
 477                'page-marker #t
 478                'page-label label
 479                'elements (list (make-music 'LabelEvent
 480                                            'page-label label))))
 481
 482
 483 language =
 484 #(define-void-function (parser location language) (string?)
 485    (_i "Set note names for language @var{language}.")
 486    (note-names-language parser language))
 487
 488 languageSaveAndChange =
 489 #(define-void-function (parser location language) (string?)
 490   (_i "Store the previous pitchnames alist, and set a new one.")
 491   (set! previous-pitchnames pitchnames)
 492   (note-names-language parser language))
 493
 494 languageRestore =
 495 #(define-void-function (parser location) ()
 496    (_i "Restore a previously-saved pitchnames alist.")
 497    (if previous-pitchnames
 498        (begin
 499         (set! pitchnames previous-pitchnames)
 500         (ly:parser-set-note-names parser pitchnames))
 501       (ly:input-warning location (_ "No other language was defined previously. Ignoring."))))
 502
 503
 504 makeClusters =
 505 #(define-music-function (parser location arg) (ly:music?)
 506    (_i "Display chords in @var{arg} as clusters.")
 507    (music-map note-to-cluster arg))
 508
 509 modalInversion =
 510 #(define-music-function (parser location around to scale music)
 511     (ly:pitch? ly:pitch? ly:music? ly:music?)
 512     (_i "Invert @var{music} about @var{around} using @var{scale} and
 513 transpose from @var{around} to @var{to}.")
 514     (let ((inverter (make-modal-inverter around to scale)))
 515       (change-pitches music inverter)
 516       music))
 517
 518 modalTranspose =
 519 #(define-music-function (parser location from to scale music)
 520     (ly:pitch? ly:pitch? ly:music? ly:music?)
 521     (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}
 522 using @var{scale}.")
 523     (let ((transposer (make-modal-transposer from to scale)))
 524       (change-pitches music transposer)
 525       music))
 526
 527 inversion =
 528 #(define-music-function
 529    (parser location around to music) (ly:pitch? ly:pitch? ly:music?)
 530    (_i "Invert @var{music} about @var{around} and
 531 transpose from @var{around} to @var{to}.")
 532    (music-invert around to music))
 533
 534 mark =
 535 #(define-music-function
 536    (parser location label) ((scheme? '()))
 537   "Make the music for the \\mark command."
 538   (let* ((set (and (integer? label)
 539                    (context-spec-music (make-property-set 'rehearsalMark label)
 540                                       'Score)))
 541          (ev (make-music 'MarkEvent
 542                          'origin location)))
 543
 544     (if set
 545         (make-sequential-music (list set ev))
 546         (begin
 547           (set! (ly:music-property ev 'label) label)
 548           ev))))
 549
 550 musicMap =
 551 #(define-music-function (parser location proc mus) (procedure? ly:music?)
 552    (_i "Apply @var{proc} to @var{mus} and all of the music it contains.")
 553    (music-map proc mus))
 554
 555 %% noPageBreak and noPageTurn are music functions (not music indentifiers),
 556 %% because music identifiers are not allowed at top-level.
 557 noPageBreak =
 558 #(define-music-function (location parser) ()
 559    (_i "Forbid a page break.  May be used at toplevel (i.e., between scores or
 560 markups), or inside a score.")
 561    (make-music 'EventChord
 562                'page-marker #t
 563                'page-break-permission 'forbid
 564                'elements (list (make-music 'PageBreakEvent
 565                                            'break-permission '()))))
 566
 567 noPageTurn =
 568 #(define-music-function (location parser) ()
 569    (_i "Forbid a page turn.  May be used at toplevel (i.e., between scores or
 570 markups), or inside a score.")
 571    (make-music 'EventChord
 572                'page-marker #t
 573                'page-turn-permission 'forbid
 574                'elements (list (make-music 'PageTurnEvent
 575                                            'break-permission '()))))
 576
 577
 578
 579 octaveCheck =
 580 #(define-music-function (parser location pitch) (ly:pitch?)
 581    (_i "Octave check.")
 582    (make-music 'RelativeOctaveCheck
 583                'pitch pitch))
 584
 585 once =
 586 #(define-music-function (parser location music) (ly:music?)
 587    (_i "Set @code{once} to @code{#t} on all layout instruction events in @var{music}.")
 588    (music-map
 589     (lambda (m)
 590       (cond ((music-is-of-type? m 'layout-instruction-event)
 591              (set! (ly:music-property m 'once) #t))
 592             ((ly:duration? (ly:music-property m 'duration))
 593              (ly:music-warning m (_ "Cannot apply \\once to timed music"))))
 594       m)
 595     music))
 596
 597 ottava =
 598 #(define-music-function (parser location octave) (integer?)
 599    (_i "Set the octavation.")
 600    (make-music 'OttavaMusic
 601                'ottava-number octave))
 602
 603 overrideTimeSignatureSettings =
 604 #(define-music-function
 605    (parser location time-signature base-moment beat-structure beam-exceptions)
 606    (pair? pair? cheap-list? cheap-list?)
 607
 608    (_i "Override @code{timeSignatureSettings}
 609 for time signatures of @var{time-signature} to have settings
 610 of @var{base-moment}, @var{beat-structure}, and @var{beam-exceptions}.")
 611
 612    ;; TODO -- add warning if largest value of grouping is
 613    ;;       greater than time-signature.
 614   (let ((setting (make-setting base-moment beat-structure beam-exceptions)))
 615     (override-time-signature-setting time-signature setting)))
 616
 617 overrideProperty =
 618 #(define-music-function (parser location name property value)
 619    (string? symbol? scheme?)
 620
 621    (_i "Set @var{property} to @var{value} in all grobs named @var{name}.
 622 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
 623 or @code{\"GrobName\"}.")
 624
 625    (let ((name-components (string-split name #\.))
 626          (context-name 'Bottom)
 627          (grob-name #f))
 628
 629      (if (> 2 (length name-components))
 630          (set! grob-name (string->symbol (car name-components)))
 631          (begin
 632            (set! grob-name (string->symbol (list-ref name-components 1)))
 633            (set! context-name (string->symbol (list-ref name-components 0)))))
 634
 635      (make-music 'ApplyOutputEvent
 636                  'context-type context-name
 637                  'procedure
 638                  (lambda (grob orig-context context)
 639                    (if (equal?
 640                         (cdr (assoc 'name (ly:grob-property grob 'meta)))
 641                         grob-name)
 642                        (set! (ly:grob-property grob property) value))))))
 643
 644
 645
 646 %% pageBreak and pageTurn are music functions (iso music indentifiers),
 647 %% because music identifiers are not allowed at top-level.
 648 pageBreak =
 649 #(define-music-function (location parser) ()
 650    (_i "Force a page break.  May be used at toplevel (i.e., between scores or
 651 markups), or inside a score.")
 652    (make-music 'EventChord
 653                'page-marker #t
 654                'line-break-permission 'force
 655                'page-break-permission 'force
 656                'elements (list (make-music 'LineBreakEvent
 657                                            'break-permission 'force)
 658                                (make-music 'PageBreakEvent
 659                                            'break-permission 'force))))
 660
 661 pageTurn =
 662 #(define-music-function (location parser) ()
 663    (_i "Force a page turn between two scores or top-level markups.")
 664    (make-music 'EventChord
 665                'page-marker #t
 666                'line-break-permission 'force
 667                'page-break-permission 'force
 668                'page-turn-permission 'force
 669                'elements (list (make-music 'LineBreakEvent
 670                                            'break-permission 'force)
 671                                (make-music 'PageBreakEvent
 672                                            'break-permission 'force)
 673                                (make-music 'PageTurnEvent
 674                                            'break-permission 'force))))
 675
 676 parallelMusic =
 677 #(define-void-function (parser location voice-ids music) (list? ly:music?)
 678    (_i "Define parallel music sequences, separated by '|' (bar check signs),
 679 and assign them to the identifiers provided in @var{voice-ids}.
 680
 681 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
 682
 683 @var{music}: a music sequence, containing BarChecks as limiting expressions.
 684
 685 Example:
 686
 687 @verbatim
 688   \\parallelMusic #'(A B C) {
 689     c c | d d | e e |
 690     d d | e e | f f |
 691   }
 692 <==>
 693   A = { c c | d d | }
 694   B = { d d | e e | }
 695   C = { e e | f f | }
 696 @end verbatim
 697 ")
 698    (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
 699           (current-voices voices)
 700           (current-sequence (list))
 701           (original music)
 702           (wrapper #f))
 703      ;;
 704      ;; utilities
 705      (define (push-music m)
 706        "Push the music expression into the current sequence"
 707        (set! current-sequence (cons m current-sequence)))
 708      (define (change-voice)
 709        "Stores the previously built sequence into the current voice and
 710        change to the following voice."
 711        (list-set! current-voices 0 (cons (make-music 'SequentialMusic
 712                                                      'elements (reverse! current-sequence))
 713                                          (car current-voices)))
 714        (set! current-sequence (list))
 715        (set! current-voices (cdr current-voices)))
 716      (define (bar-check? m)
 717        "Checks whether m is a bar check."
 718        (eq? (ly:music-property m 'name) 'BarCheck))
 719      (define (music-origin music)
 720        "Recursively search an origin location stored in music."
 721        (cond ((null? music) #f)
 722              ((not (null? (ly:music-property music 'origin)))
 723               (ly:music-property music 'origin))
 724              (else (or (music-origin (ly:music-property music 'element))
 725                        (let ((origins (remove not (map music-origin
 726                                                        (ly:music-property music 'elements)))))
 727                          (and (not (null? origins)) (car origins)))))))
 728      (while (music-is-of-type? music 'music-wrapper-music)
 729             (set! wrapper music)
 730             (set! music (ly:music-property wrapper 'element)))
 731      (if wrapper
 732          (set! (ly:music-property wrapper 'element)
 733                                   (make-music 'SequentialMusic
 734                                               'origin location))
 735          (set! original
 736                (make-music 'SequentialMusic
 737                            'origin location)))
 738      ;;
 739      ;; first, split the music and fill in voices
 740      ;; We flatten direct layers of SequentialMusic since they are
 741      ;; pretty much impossible to avoid when writing music functions.
 742      (let rec ((music music))
 743        (for-each (lambda (m)
 744                    (if (eq? (ly:music-property m 'name) 'SequentialMusic)
 745                        (rec m)
 746                        (begin
 747                          (push-music m)
 748                          (if (bar-check? m) (change-voice)))))
 749                  (ly:music-property music 'elements)))
 750      (if (not (null? current-sequence)) (change-voice))
 751      ;; un-circularize `voices' and reorder the voices
 752      (set! voices (map-in-order (lambda (dummy seqs)
 753                                   (reverse! seqs))
 754                                 voice-ids voices))
 755      ;;
 756      ;; set origin location of each sequence in each voice
 757      ;; for better type error tracking
 758      (for-each (lambda (voice)
 759                  (for-each (lambda (seq)
 760                              (set! (ly:music-property seq 'origin)
 761                                    (or (music-origin seq) location)))
 762                            voice))
 763                voices)
 764      ;;
 765      ;; check sequence length
 766      (apply for-each (lambda* (#:rest seqs)
 767                               (let ((moment-reference (ly:music-length (car seqs))))
 768                                 (for-each (lambda (seq moment)
 769                                             (if (not (equal? moment moment-reference))
 770                                                 (ly:music-warning seq
 771                                                                   "Bars in parallel music don't have the same length")))
 772                                           seqs (map-in-order ly:music-length seqs))))
 773             voices)
 774      ;;
 775      ;; bind voice identifiers to the voices
 776      (for-each (lambda (voice-id voice)
 777             (ly:parser-define! parser voice-id
 778                                (let ((v (ly:music-deep-copy original)))
 779                                  (set! (ly:music-property
 780                                         (car (extract-named-music
 781                                               v 'SequentialMusic))
 782                                         'elements) voice)
 783                                  v)))
 784           voice-ids voices)))
 785
 786 parenthesize =
 787 #(define-music-function (parser loc arg) (ly:music?)
 788    (_i "Tag @var{arg} to be parenthesized.")
 789
 790    (if (memq 'event-chord (ly:music-property arg 'types))
 791        ;; arg is an EventChord -> set the parenthesize property
 792        ;; on all child notes and rests
 793        (for-each
 794         (lambda (ev)
 795           (if (or (memq 'note-event (ly:music-property ev 'types))
 796                   (memq 'rest-event (ly:music-property ev 'types)))
 797               (set! (ly:music-property ev 'parenthesize) #t)))
 798         (ly:music-property arg 'elements))
 799        ;; No chord, simply set property for this expression:
 800        (set! (ly:music-property arg 'parenthesize) #t))
 801    arg)
 802
 803 partcombine =
 804 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
 805    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 806 that they share a staff.")
 807    (make-part-combine-music parser
 808                             (list part1 part2) #f))
 809
 810 partcombineUp =
 811 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
 812    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 813 that they share a staff with stems directed upward.")
 814    (make-part-combine-music parser
 815                             (list part1 part2) UP))
 816
 817 partcombineDown =
 818 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
 819    (_i "Take the music in @var{part1} and @var{part2} and typeset so
 820 that they share a staff with stems directed downward.")
 821    (make-part-combine-music parser
 822                             (list part1 part2) DOWN))
 823
 824 partcombineForce =
 825 #(define-music-function (location parser type once) (symbol-or-boolean? boolean?)
 826    (_i "Override the part-combiner.")
 827    (make-music 'EventChord
 828                'elements (list (make-music 'PartCombineForceEvent
 829                                            'forced-type type
 830                                            'once once))))
 831 partcombineApart = \partcombineForce #'apart ##f
 832 partcombineApartOnce = \partcombineForce #'apart ##t
 833 partcombineChords = \partcombineForce #'chords ##f
 834 partcombineChordsOnce = \partcombineForce #'chords ##t
 835 partcombineUnisono = \partcombineForce #'unisono ##f
 836 partcombineUnisonoOnce = \partcombineForce #'unisono ##t
 837 partcombineSoloI = \partcombineForce #'solo1 ##f
 838 partcombineSoloIOnce = \partcombineForce #'solo1 ##t
 839 partcombineSoloII = \partcombineForce #'solo2 ##f
 840 partcombineSoloIIOnce = \partcombineForce #'solo2 ##t
 841 partcombineAutomatic = \partcombineForce ##f ##f
 842 partcombineAutomaticOnce = \partcombineForce ##f ##t
 843
 844 partial =
 845 #(define-music-function (parser location dur) (ly:duration?)
 846   (_i "Make a partial measure.")
 847
 848   ;; We use `descend-to-context' here instead of `context-spec-music' to
 849   ;; ensure \partial still works if the Timing_translator is moved
 850     (descend-to-context
 851      (context-spec-music (make-music 'PartialSet
 852                                      'origin location
 853                                      'partial-duration dur)
 854                          'Timing)
 855      'Score))
 856
 857 pitchedTrill =
 858 #(define-music-function
 859    (parser location main-note secondary-note)
 860    (ly:music? ly:music?)
 861    (_i "Print a trill with @var{main-note} as the main note of the trill and
 862 print @var{secondary-note} as a stemless note head in parentheses.")
 863    (let* ((get-notes (lambda (ev-chord)
 864                        (extract-named-music ev-chord 'NoteEvent)))
 865           (sec-note-events (get-notes secondary-note))
 866           (trill-events (extract-named-music main-note 'TrillSpanEvent)))
 867      (if (pair? sec-note-events)
 868          (begin
 869            (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch))
 870                   (forced (ly:music-property (car sec-note-events) 'force-accidental)))
 871
 872              (if (ly:pitch? trill-pitch)
 873                  (for-each (lambda (m)
 874                              (ly:music-set-property! m 'pitch trill-pitch)) trill-events)
 875                  (begin
 876                    (ly:input-warning location (_ "Second argument of \\pitchedTrill should be single note: "))
 877                    (display sec-note-events)))
 878
 879              (if (eq? forced #t)
 880                  (for-each (lambda (m)
 881                              (ly:music-set-property! m 'force-accidental forced))
 882                            trill-events)))))
 883      main-note))
 884
 885 pushToTag =
 886 #(define-music-function (parser location tag more music)
 887    (symbol? ly:music? ly:music?)
 888    (_i "Add @var{more} to the front of @code{elements} of all music
 889 expressions in @var{music} that are tagged with @var{tag}.")
 890    (music-map (lambda (m)
 891                 (if (memq tag (ly:music-property m 'tags))
 892                     (set! (ly:music-property m 'elements)
 893                           (cons more (ly:music-property m 'elements))))
 894                 m)
 895               music))
 896
 897 quoteDuring =
 898 #(define-music-function (parser location what main-music) (string? ly:music?)
 899    (_i "Indicate a section of music to be quoted.  @var{what} indicates the name
 900 of the quoted voice, as specified in an @code{\\addQuote} command.
 901 @var{main-music} is used to indicate the length of music to be quoted;
 902 usually contains spacers or multi-measure rests.")
 903    (make-music 'QuoteMusic
 904                'element main-music
 905                'quoted-music-name what))
 906
 907 relative =
 908 #(define-music-function (parser location pitch music)
 909    ((ly:pitch? (ly:make-pitch 0 0 0)) ly:music?)
 910    (_i "Make @var{music} relative to @var{pitch} (default @code{c'}).")
 911    (ly:make-music-relative! music pitch)
 912    (make-music 'RelativeOctaveMusic
 913                'element music))
 914
 915 removeWithTag =
 916 #(define-music-function (parser location tag music) (symbol? ly:music?)
 917    (_i "Remove elements of @var{music} that are tagged with @var{tag}.")
 918    (music-filter
 919     (lambda (m)
 920       (let* ((tags (ly:music-property m 'tags))
 921              (res (memq tag tags)))
 922         (not res)))
 923     music))
 924
 925 resetRelativeOctave =
 926 #(define-music-function (parser location pitch) (ly:pitch?)
 927    (_i "Set the octave inside a \\relative section.")
 928
 929    (make-music 'SequentialMusic
 930                'to-relative-callback
 931                (lambda (music last-pitch) pitch)))
 932
 933 retrograde =
 934 #(define-music-function (parser location music)
 935     (ly:music?)
 936     (_i "Return @var{music} in reverse order.")
 937     (retrograde-music music))
 938
 939 revertTimeSignatureSettings =
 940 #(define-music-function
 941    (parser location time-signature)
 942    (pair?)
 943
 944    (_i "Revert @code{timeSignatureSettings}
 945 for time signatures of @var{time-signature}.")
 946    (revert-time-signature-setting time-signature))
 947
 948 rightHandFinger =
 949 #(define-music-function (parser location finger) (number-or-string?)
 950    (_i "Apply @var{finger} as a fingering indication.")
 951
 952    (make-music
 953             'StrokeFingerEvent
 954             'origin location
 955             (if (string? finger) 'text 'digit)
 956             finger))
 957
 958 scaleDurations =
 959 #(define-music-function (parser location fraction music)
 960    (fraction? ly:music?)
 961    (_i "Multiply the duration of events in @var{music} by @var{fraction}.")
 962    (ly:music-compress music
 963                       (ly:make-moment (car fraction) (cdr fraction))))
 964
 965 settingsFrom =
 966 #(define-scheme-function (parser location ctx music)
 967    ((symbol?) ly:music?)
 968    (_i "Take the layout instruction events from @var{music}, optionally
 969 restricted to those applying to context type @var{ctx}, and return
 970 a context modification duplicating their effect.")
 971    (let ((mods (ly:make-context-mod)))
 972      (define (musicop m)
 973        (if (music-is-of-type? m 'layout-instruction-event)
 974            (ly:add-context-mod
 975             mods
 976             (case (ly:music-property m 'name)
 977               ((PropertySet)
 978                (list 'assign
 979                      (ly:music-property m 'symbol)
 980                      (ly:music-property m 'value)))
 981               ((PropertyUnset)
 982                (list 'unset
 983                      (ly:music-property m 'symbol)))
 984               ((OverrideProperty)
 985                (list 'push
 986                      (ly:music-property m 'symbol)
 987                      (ly:music-property m 'grob-value)
 988                      (ly:music-property m 'grob-property-path)))
 989               ((RevertProperty)
 990                (list 'pop
 991                      (ly:music-property m 'symbol)
 992                      (ly:music-property m 'grob-property-path)))))
 993            (case (ly:music-property m 'name)
 994              ((SequentialMusic SimultaneousMusic)
 995               (for-each musicop (ly:music-property m 'elements)))
 996              ((ContextSpeccedMusic)
 997               (if (or (not ctx)
 998                       (eq? ctx (ly:music-property m 'context-type)))
 999                   (musicop (ly:music-property m 'element)))))))
1000      (musicop music)
1001      mods))
1002
1003 shiftDurations =
1004 #(define-music-function (parser location dur dots arg)
1005    (integer? integer? ly:music?)
1006    (_i "Change the duration of @var{arg} by adding @var{dur} to the
1007 @code{durlog} of @var{arg} and @var{dots} to the @code{dots} of @var{arg}.")
1008
1009    (music-map
1010     (lambda (x)
1011       (shift-one-duration-log x dur dots)) arg))
1012
1013 skip =
1014 #(define-music-function (parser location dur) (ly:duration?)
1015   (_i "Skip forward by @var{dur}.")
1016   (make-music 'SkipMusic
1017               'duration dur))
1018
1019
1020 slashedGrace =
1021 #(def-grace-function startSlashedGraceMusic stopSlashedGraceMusic
1022    (_i "Create slashed graces (slashes through stems, but no slur) from
1023 the following music expression"))
1024
1025 spacingTweaks =
1026 #(define-music-function (parser location parameters) (list?)
1027    (_i "Set the system stretch, by reading the 'system-stretch property of
1028 the `parameters' assoc list.")
1029    #{
1030      \overrideProperty #"Score.NonMusicalPaperColumn"
1031      #'line-break-system-details
1032      #(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters)))
1033              (cons 'system-Y-extent (cdr (assoc 'system-Y-extent parameters))))
1034    #})
1035
1036 styledNoteHeads =
1037 #(define-music-function (parser location style heads music)
1038    (symbol? list-or-symbol? ly:music?)
1039    (_i "Set @var{heads} in @var{music} to @var{style}.")
1040    (style-note-heads heads style music))
1041
1042 tag =
1043 #(define-music-function (parser location tag arg) (symbol? ly:music?)
1044
1045    (_i "Add @var{tag} to the @code{tags} property of @var{arg}.")
1046
1047    (set!
1048     (ly:music-property arg 'tags)
1049     (cons tag
1050           (ly:music-property arg 'tags)))
1051    arg)
1052
1053 time =
1054 #(define-music-function (parser location beat-structure fraction)
1055    ((number-list? '()) fraction?)
1056    (_i "Set @var{fraction} as time signature, with optional
1057 number list @var{beat-structure} before it.")
1058   (make-music 'TimeSignatureMusic
1059               'numerator (car fraction)
1060               'denominator (cdr fraction)
1061               'beat-structure beat-structure))
1062
1063 times =
1064 #(define-music-function (parser location fraction music)
1065    (fraction? ly:music?)
1066    (_i "Scale @var{music} in time by @var{fraction}.")
1067   (make-music 'TimeScaledMusic
1068               'element (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction)))
1069               'numerator (car fraction)
1070               'denominator (cdr fraction)))
1071
1072 transpose =
1073 #(define-music-function
1074    (parser location from to music)
1075    (ly:pitch? ly:pitch? ly:music?)
1076
1077    (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}.")
1078    (make-music 'TransposedMusic
1079                'element (ly:music-transpose music (ly:pitch-diff to from))))
1080
1081 transposedCueDuring =
1082 #(define-music-function
1083    (parser location what dir pitch main-music)
1084    (string? ly:dir? ly:pitch? ly:music?)
1085
1086    (_i "Insert notes from the part @var{what} into a voice called @code{cue},
1087 using the transposition defined by @var{pitch}.  This happens
1088 simultaneously with @var{main-music}, which is usually a rest.  The
1089 argument @var{dir} determines whether the cue notes should be notated
1090 as a first or second voice.")
1091
1092    (make-music 'QuoteMusic
1093                'element main-music
1094                'quoted-context-type 'Voice
1095                'quoted-context-id "cue"
1096                'quoted-music-name what
1097                'quoted-voice-direction dir
1098                'quoted-transposition pitch))
1099
1100 transposition =
1101 #(define-music-function (parser location pitch) (ly:pitch?)
1102    (_i "Set instrument transposition")
1103
1104    (context-spec-music
1105     (make-property-set 'instrumentTransposition
1106                        (ly:pitch-negate pitch))
1107     'Staff))
1108
1109 tweak =
1110 #(define-music-function (parser location sym val arg)
1111    (symbol? scheme? ly:music?)
1112    (_i "Add @code{sym . val} to the @code{tweaks} property of @var{arg}.")
1113
1114    (if (equal? (object-property sym 'backend-type?) #f)
1115        (begin
1116          (ly:input-warning location (_ "cannot find property type-check for ~a") sym)
1117          (ly:warning (_ "doing assignment anyway"))))
1118    (set!
1119     (ly:music-property arg 'tweaks)
1120     (acons sym val
1121            (ly:music-property arg 'tweaks)))
1122    arg)
1123
1124
1125
1126 unfoldRepeats =
1127 #(define-music-function (parser location music) (ly:music?)
1128    (_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or
1129 @code{\\repeat percent} commands in @var{music} to be interpreted
1130 as @code{\\repeat unfold}.")
1131    (unfold-repeats music))
1132
1133 void =
1134 #(define-void-function (parser location arg) (scheme?)
1135    (_i "Accept a scheme argument, return a void expression.
1136 Use this if you want to have a scheme expression evaluated
1137 because of its side-effects, but its value ignored."))
1138
1139 withMusicProperty =
1140 #(define-music-function (parser location sym val music)
1141    (symbol? scheme? ly:music?)
1142    (_i "Set @var{sym} to @var{val} in @var{music}.")
1143
1144    (set! (ly:music-property music sym) val)
1145    music)