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