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